diff --git a/lisp/llvm-lib/llvm-act-on-file/act-on-c-file.el b/lisp/llvm-lib/llvm-act-on-file/act-on-c-file.el index f4ffd92..45ae3ee 100644 --- a/lisp/llvm-lib/llvm-act-on-file/act-on-c-file.el +++ b/lisp/llvm-lib/llvm-act-on-file/act-on-c-file.el @@ -47,9 +47,9 @@ (let ((compiler (lls/prompt-tool "clang$" (lls/get-llvm-bin-dir))) (tmp-file (make-temp-file (file-name-sans-extension (file-name-nondirectory file))))) (string-join - (list (funcall lls/get-clang-command-fun compiler file 'compile - :output tmp-file) - (funcall lls/get-dis-command-fun tmp-file nil)) + (list (lls/get-clang-command-fun compiler file 'compile + :output tmp-file) + (lls/get-dis-command-fun tmp-file nil)) " && "))) (defun ll/build-clang-command (file action) @@ -58,7 +58,7 @@ (let ((compiler-action (aml/get-map-prop ll/c-file-action-map action :compiler-action)) (compiler (lls/prompt-tool "clang$"))) (string-join - (list (funcall lls/get-clang-command-fun compiler file compiler-action) + (list (lls/get-clang-command-fun compiler file compiler-action) (pcase action ('debug (format "-mllvm -debug-only=%s" (read-string "Which pass? "))) ('before-after (let ((pass (read-string "Which pass? "))) diff --git a/lisp/llvm-lib/llvm-act-on-file/act-on-ll-file.el b/lisp/llvm-lib/llvm-act-on-file/act-on-ll-file.el index 828ccaa..1540278 100644 --- a/lisp/llvm-lib/llvm-act-on-file/act-on-ll-file.el +++ b/lisp/llvm-lib/llvm-act-on-file/act-on-ll-file.el @@ -32,7 +32,7 @@ (stop-before :key ?S :major-mode llvm-mode :buffer-string "before-%s" :description "[S]top-before"))) (defun ll/build-llc-command (file action) - (funcall lls/get-llc-command-fun file action)) + (lls/get-llc-command-fun file action)) (defun ll/act-on-ll-file (file) (let* ((action (aml/read-action-map ll/ll-file-action-map)) diff --git a/lisp/llvm-lib/llvm-act-on-file/act-on-obj-file.el b/lisp/llvm-lib/llvm-act-on-file/act-on-obj-file.el index 4d058c4..376b576 100644 --- a/lisp/llvm-lib/llvm-act-on-file/act-on-obj-file.el +++ b/lisp/llvm-lib/llvm-act-on-file/act-on-obj-file.el @@ -31,7 +31,7 @@ '((disassemble :key ?d :major-mode asm-mode :buffer-string "asm" :description "[d]isassemble"))) (defun ll/build-obj-command (file action) - (funcall lls/get-dis-command-fun file action)) + (lls/get-dis-command-fun file action)) (defun ll/act-on-obj-file (file) (let* ((action (aml/read-action-map ll/obj-file-action-map)) diff --git a/lisp/llvm-lib/llvm-gdb-command.el b/lisp/llvm-lib/llvm-gdb-command.el index 32d5bd0..f1138b8 100644 --- a/lisp/llvm-lib/llvm-gdb-command.el +++ b/lisp/llvm-lib/llvm-gdb-command.el @@ -45,8 +45,7 @@ (defun ll/get-clang-command-for-file (clang file) (string-join - (list (funcall - lls/get-clang-command-fun + (list (lls/get-clang-command-fun clang file 'compile :output (make-temp-file nil nil ".o")) "-v") diff --git a/lisp/llvm-lib/llvm-lib.el b/lisp/llvm-lib/llvm-lib.el index 7498d7d..cf918cc 100644 --- a/lisp/llvm-lib/llvm-lib.el +++ b/lisp/llvm-lib/llvm-lib.el @@ -30,7 +30,7 @@ (require 'llvm-jump-to-tablegen) (define-prefix-command '*llvm-map*) -;; (define-key *root-map* (kbd "C-w") '*llvm-map*) +(define-key *root-map* (kbd "C-w") '*llvm-map*) (define-key *llvm-map* (kbd "a") #'ll/act-on-file) (define-key *llvm-map* (kbd "c") #'ll/llvm-build-tool) diff --git a/lisp/llvm-lib/llvm-shared.el b/lisp/llvm-lib/llvm-shared.el index 407059f..53b66d6 100644 --- a/lisp/llvm-lib/llvm-shared.el +++ b/lisp/llvm-lib/llvm-shared.el @@ -25,6 +25,7 @@ ;;; Code: (require 'magit) +(require 'eieio) ;; =========================== LLVM Rebuild ========================== @@ -38,49 +39,75 @@ ;; =============================== Init ============================== -(defvar lls/llvm-root-dir nil) -(defvar lls/llvm-build-dirs nil) -(defvar lls/llvm-bin-dirs nil) +(defclass llvm-config () + ((root-dir :initarg :root-dir :type string) + (build-dirs :initarg :build-dirs :type list) + (target :initarg :target :type string) + (bin-dirs :initarg :bin-dirs :type list :initform nil) + (compile-command-fun :initarg :cc :type function :initform (lambda ())) + (dis-command-fun :initarg :dc :type function :initform (lambda ())) + (llc-command-fun :initarg :llc :type function :initform (lambda ())))) + +(defvar lls/llvm-config nil) +;; (defvar lls/llvm-root-dir nil) +;; (defvar lls/llvm-build-dirs nil) +;; (defvar lls/llvm-bin-dirs nil) (defvar lls/target-init-fun nil) -(defun lls/init-llvm-shared (root-dir build-dirs &optional bindirs) - ;; TODO: make interactive - (let ((r (rx (or "RelWithAsserts" "Release")))) - (setq lls/llvm-root-dir (or root-dir - (read-file-name "llvm-project directory? ")) - lls/llvm-build-dirs - (sort build-dirs +;; (defun lls/init-llvm-shared (root-dir build-dirs &optional bindirs) +;; ;; TODO: make interactive +;; (let ((r (rx (or "RelWithAsserts" "Release")))) +;; (setq lls/llvm-root-dir (or root-dir +;; (read-file-name "llvm-project directory? ")) +;; lls/llvm-build-dirs +;; (sort build-dirs +;; #'(lambda (x y) +;; (cond ((string-match-p r y) nil) +;; ((string-match-p r x) t) +;; (t (string< x y))))) +;; lls/llvm-bin-dirs bindirs))) + +(defun lls/conf-get (sym) + (slot-value lls/llvm-config sym)) + +(defun lls/initialize () + (interactive) + (setq lls/llvm-config + (funcall lls/target-init-fun)) + (setf (slot-value lls/llvm-config + 'build-dirs) + (let ((r (rx (or "RelWithAsserts" "Release")))) + (sort (lls/conf-get 'build-dirs) #'(lambda (x y) (cond ((string-match-p r y) nil) ((string-match-p r x) t) - (t (string< x y))))) - lls/llvm-bin-dirs bindirs))) + (t (string< x y)))))))) -(defun lls/uninitialized? () - (not (and lls/llvm-root-dir - lls/llvm-build-dirs))) +(defun lls/ensure-initialized () + (when (or (not lls/llvm-config) + (not (llvm-config-p lls/llvm-config))) + (if (not (functionp lls/target-init-fun)) + (error "Please register an init function for llvm") + (lls/initialize)))) (defun lls/get-llvm-root-dir () - (when (lls/uninitialized?) - (funcall lls/target-init-fun #'lls/init-llvm-shared)) - lls/llvm-root-dir) + (lls/ensure-initialized) + (lls/conf-get 'root-dir)) (defun lls/get-llvm-build-dirs () - (when (lls/uninitialized?) - (funcall lls/target-init-fun #'lls/init-llvm-shared)) - lls/llvm-build-dirs) + (lls/ensure-initialized) + (lls/conf-get 'build-dirs)) (defun lls/get-llvm-bin-dir () (car (lls/get-llvm-bin-dirs))) (defun lls/get-llvm-bin-dirs () - (when (lls/uninitialized?) - (funcall lls/target-init-fun #'lls/init-llvm-shared)) + (lls/ensure-initialized) (append (mapcar #'(lambda (x) (expand-file-name "bin" x)) (lls/get-llvm-build-dirs)) - lls/llvm-bin-dirs)) + (lls/conf-get 'bin-dirs))) (defun lls/get-llvm-build-dir () (car (lls/get-llvm-build-dirs))) @@ -88,8 +115,10 @@ (defun lls/add-llvm-build-dir (dir) (interactive (list (read-file-name "Where? "))) - (add-to-list 'lls/llvm-build-dirs - dir)) + (lls/ensure-initialized) + (setf (slot-value lls/llvm-config 'build-dirs) + (cons dir + (lls/conf-get 'build-dirs)))) ;; =============================== Misc ============================== @@ -115,42 +144,54 @@ (or directories (lls/get-llvm-bin-dirs)))) -(defvar lls/get-clang-command-fun - (cl-function - (lambda (compiler file action &key output rest) - (string-join (list compiler - (string-join rest " ") - file - (pcase action - ('compile "-c") - ('assemble "-S") - ('preprocess "-E") - ('llvm-ir "-S -emit-llvm") - ('executable "")) - (format "-o %s" - (or output - (and (eq action 'executable) "a.out") - "-"))) - " ")))) +(defun lls/get-clang-command-fun (&rest args) + (apply (lls/conf-get 'compile-command-fun) + args)) -(defvar lls/get-llc-command-fun - (lambda (file _action) - (concat "llc -o - " - file " "))) +(defun lls/get-llc-command-fun (&rest args) + (apply (lls/conf-get 'llc-command-fun) args)) -(defvar lls/get-dis-command-fun - (lambda (file _action) - (concat "llvm-objdump --disassemble " - file " "))) +(defun lls/get-dis-command-fun (&rest args) + (apply (lls/conf-get 'dis-command-fun) args)) ;; ========================= LLVM Build Dirs ========================= +(cl-defun lls/default-comp-fun (compiler file action &key output rest) + (string-join + (list compiler + (string-join rest " ") + file + (pcase action + ('compile "-c") + ('assemble "-S") + ('preprocess "-E") + ('llvm-ir "-S -emit-llvm") + ('executable "")) + (format "-o %s" + (or output + (and (eq action 'executable) "a.out") + "-"))) + " ")) + +(defun lls/default-llc-comm (file _action) + (concat "llc -o - " + file " ")) + +(defun lls/default-dis-comm (file _action) + (concat "llvm-objdump --disassemble " + file " ")) (setq lls/target-init-fun ;; TODO: load llvm-mode - (lambda (callback) - (funcall callback - (lls/guess-root-dir-fun) - (lls/guess-build-dirs-fun)))) + (lambda () + (make-instance + 'llvm-config + :root-dir (lls/guess-root-dir-fun) + :build-dirs (lls/guess-build-dirs-fun) + :bin-dirs '("/usr/bin/") + :target "X86" + :cc #'lls/default-comp-fun + :dc #'lls/default-dis-comm + :llc #'lls/default-llc-comm))) (defun lls/guess-root-dir-fun () ;; TODO: constant diff --git a/lisp/ti-config/libraries b/lisp/ti-config/libraries index fc24334..d8233fa 160000 --- a/lisp/ti-config/libraries +++ b/lisp/ti-config/libraries @@ -1 +1 @@ -Subproject commit fc243348839084a0c650df8dcb65e22cb6c369cc +Subproject commit d8233fa707392cd171c76fca00c1a9f8f49446b0