pestctrl/emacs-config
1
0
Fork 0
mirror of https://github.com/pestctrl/emacs-config.git synced 2026-02-16 08:14:15 +00:00
Code Issues Projects Releases Packages Wiki Activity

API changes for llvm-lib

Browse source
This commit is contained in:
Benson Chu 2023-03-18 23:33:40 -05:00
parent 73aa23fedd
commit 413995cb85
7 changed files with 105 additions and 65 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lisp/llvm-lib/llvm-act-on-file/act-on-c-file.el
View file

@ -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
(list (lls/get-clang-command-fun compiler file 'compile
:output tmp-file)
(funcall lls/get-dis-command-fun tmp-file nil))
(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? ")))

2
lisp/llvm-lib/llvm-act-on-file/act-on-ll-file.el
View file

@ -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))

2
lisp/llvm-lib/llvm-act-on-file/act-on-obj-file.el
View file

@ -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))

3
lisp/llvm-lib/llvm-gdb-command.el
View file

@ -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")

2
lisp/llvm-lib/llvm-lib.el
View file

@ -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)

125
lisp/llvm-lib/llvm-shared.el
View file

@ -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
;; (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"))))
(setq lls/llvm-root-dir (or root-dir
(read-file-name "llvm-project directory? "))
lls/llvm-build-dirs
(sort build-dirs
(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,10 +144,20 @@
(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
(defun lls/get-clang-command-fun (&rest args)
(apply (lls/conf-get 'compile-command-fun)
args))
(defun lls/get-llc-command-fun (&rest args)
(apply (lls/conf-get 'llc-command-fun) args))
(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
@ -131,26 +170,28 @@
(or output
(and (eq action 'executable) "a.out")
"-")))
" "))))
" "))
(defvar lls/get-llc-command-fun
(lambda (file _action)
(defun lls/default-llc-comm (file _action)
(concat "llc -o - "
file " ")))
file " "))
(defvar lls/get-dis-command-fun
(lambda (file _action)
(defun lls/default-dis-comm (file _action)
(concat "llvm-objdump --disassemble "
file " ")))
;; ========================= LLVM Build Dirs =========================
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

2
lisp/ti-config/libraries

@ -1 +1 @@
Subproject commit fc243348839084a0c650df8dcb65e22cb6c369cc
Subproject commit d8233fa707392cd171c76fca00c1a9f8f49446b0