pestctrl/emacs-config
1
0
Fork 0
mirror of https://github.com/pestctrl/emacs-config.git synced 2026-06-14 12:21:20 +00:00
Code Issues Projects Releases Packages Wiki Activity

llvm-lib 3.0!

Browse source
This commit is contained in:
Benson Chu 2026-04-01 17:17:08 -05:00
parent e8fc49a0e3
commit e4b4c9f8b4
13 changed files with 237 additions and 232 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

214
lisp/llvm-lib/clang-command.el
View file

@ -23,7 +23,10 @@
;;; Commentary: ;;; Commentary:
;;; Code: ;;; Code:
(require 'clang-option-sets) (require 'compiler-option-sets)
(defclass clang-option-config (compiler-option-config)
nil)
(defvar clang-subtargets (defvar clang-subtargets
(make-hash-table :test #'equal)) (make-hash-table :test #'equal))
@ -31,23 +34,23 @@
(defvar clang-options-extensions (defvar clang-options-extensions
(make-hash-table :test #'equal)) (make-hash-table :test #'equal))
(defvar cc/all-target-options (defvar clang/all-target-options
(make-hash-table)) (make-hash-table))
(defvar cc/current-target-optionset (defvar clang/current-target-optionset
(make-hash-table)) (make-hash-table))
(defun cc/push-new-target-option (target name option-set) (defun clang/push-new-target-option (target name option-set)
(puthash target (puthash target
(cons (cons name option-set) (cons (cons name option-set)
(gethash target cc/all-target-options)) (gethash target clang/all-target-options))
cc/all-target-options)) clang/all-target-options))
(defun cc/add-and-set-target-option (target name option-set) (defun clang/add-and-set-target-option (target name option-set)
(puthash target name cc/current-target-optionset) (puthash target name clang/current-target-optionset)
(cc/push-new-target-option target name option-set)) (clang/push-new-target-option target name option-set))
(defvar cc/file-specific-options (defvar clang/file-specific-options
(make-hash-table :test #'equal)) (make-hash-table :test #'equal))
(defun my/completing-read-formatter (formatter prompt list) (defun my/completing-read-formatter (formatter prompt list)
@ -60,12 +63,12 @@
alist alist
nil nil #'equal))) nil nil #'equal)))
(defun cc/make-clang-option-set (target) (defun clang/make-clang-option-set (target)
(let ((subtargets (hash-table-values clang-subtargets)) (let ((subtargets (hash-table-values clang-subtargets))
primary extensions) primary extensions)
(setq primary (setq primary
(my/completing-read-formatter (my/completing-read-formatter
#'cos/clang-options->string #'clang/clang-options->string
"Primary Subtarget? " "Primary Subtarget? "
(remove-if-not (lambda (x) (remove-if-not (lambda (x)
(string= target (string= target
@ -73,121 +76,146 @@
subtargets))) subtargets)))
(cons primary extensions))) (cons primary extensions)))
(defun cc/get-named-target-clang-optionset (target option-name) (defun clang/get-named-target-clang-optionset (target option-name)
(when-let ((target-options (when-let ((target-options
(gethash target cc/all-target-options))) (gethash target clang/all-target-options)))
(and target-options (and target-options
(alist-get option-name target-options nil nil #'equal)))) (alist-get option-name target-options nil nil #'equal))))
(defun cc/reinitialize-clang-options (target) (defun clang/reinitialize-clang-options (target)
(interactive (list (intern (lls/conf-get 'target)))) (interactive (list (intern (lls/conf-get 'target))))
(let ((option-name (or (gethash target cc/current-target-optionset) (let ((option-name (or (gethash target clang/current-target-optionset)
(puthash target "default" cc/current-target-optionset)))) (puthash target "default" clang/current-target-optionset))))
(aprog1 (cc/make-clang-option-set target) (aprog1 (clang/make-clang-option-set target)
(cc/push-new-target-option target option-name it)))) (clang/push-new-target-option target option-name it))))
;;; THE function ;;; THE function
(defun cc/get-clang-options-for-target (target &optional option-name) (defun clang/get-clang-options-for-target (target &optional option-name)
(let ((option-name (or option-name (let ((option-name (or option-name
(gethash target cc/current-target-optionset) (gethash target clang/current-target-optionset)
(puthash target "default" cc/current-target-optionset)))) (puthash target "default" clang/current-target-optionset))))
(or (gethash (buffer-file-name) cc/file-specific-options) (or (gethash (buffer-file-name) clang/file-specific-options)
(cc/get-named-target-clang-optionset target option-name) (clang/get-named-target-clang-optionset target option-name)
(aprog1 (cc/make-clang-option-set target) (aprog1 (clang/make-clang-option-set target)
(cc/push-new-target-option target option-name it))))) (clang/push-new-target-option target option-name it)))))
;; (cc/get-clang-options-for-target "c29") ;; (clang/get-clang-options-for-target "c29")
(defun cc/new-clang-option-set (target name &optional optionset) ;; (defun clang/new-clang-option-set (target name &optional optionset)
;; (interactive
;; (list (intern (lls/conf-get 'target))
;; (read-string "Name for new optionset? ")))
;; (let ((optionset (or optionset (clang/make-clang-option-set target))))
;; (clang/add-and-set-target-option target name optionset)))
;; (defun clang/copy-clang-option-set (target name &optional optionset)
;; (interactive
;; (list (intern (lls/conf-get 'target))
;; (read-string "Name for new optionset? ")))
;; (let ((optionset (clang/get-clang-options-for-target target)))
;; (clang/add-and-set-target-option target name optionset)))
;; (defun clang/file-specific-option-set (target &optional optionset)
;; (interactive
;; (list (intern (lls/conf-get 'target))))
;; ;; TODO: might need to garbage collect these
;; (or (gethash (buffer-file-name)
;; clang/file-specific-options)
;; (let ((optionset (clang/get-clang-options-for-target target)))
;; (puthash (buffer-file-name)
;; optionset
;; clang/file-specific-options))))
;; (clang/new-clang-option-set "c29" "toyota")
(defun clang/switch-clang-option-set (target name)
(interactive (interactive
(list (intern (lls/conf-get 'target)) (let ((target lls/conf-get 'target))
(read-string "Name for new optionset? ")))
(let ((optionset (or optionset (cc/make-clang-option-set target))))
(cc/add-and-set-target-option target name optionset)))
(defun cc/copy-clang-option-set (target name &optional optionset)
(interactive
(list (intern (lls/conf-get 'target))
(read-string "Name for new optionset? ")))
(let ((optionset (cc/get-clang-options-for-target target)))
(cc/add-and-set-target-option target name optionset)))
(defun cc/file-specific-option-set (target &optional optionset)
(interactive
(list (intern (lls/conf-get 'target))))
;; TODO: might need to garbage collect these
(or (gethash (buffer-file-name)
cc/file-specific-options)
(let ((optionset (cc/get-clang-options-for-target target)))
(puthash (buffer-file-name)
optionset
cc/file-specific-options))))
;; (cc/new-clang-option-set "c29" "toyota")
(defun cc/switch-clang-option-set (target name)
(interactive
(let ((target (lls/conf-get 'target)))
(list target (list target
(--> (intern target) (--> (intern target)
(gethash it cc/all-target-options) (gethash it clang/all-target-options)
(mapcar #'car it) (mapcar #'car it)
(completing-read "Optionset? " it))))) (completing-read "Optionset? " it)))))
(remhash (buffer-file-name) (remhash (buffer-file-name)
cc/file-specific-options) clang/file-specific-options)
(cc/get-clang-options-for-target target name) (clang/get-clang-options-for-target target name)
(puthash (intern target) name cc/current-target-optionset)) (puthash (intern target) name clang/current-target-optionset))
(defun cc/edit-clang-options (prefix) (defun clang/edit-clang-options (prefix)
(interactive "P") (interactive "P")
(let* ((target (intern (lls/conf-get 'target))) (let* ((target (intern (lls/conf-get 'target)))
(options-config (options-config
(->> (->>
target target
(cc/get-clang-options-for-target) (clang/get-clang-options-for-target)
(car))) (car)))
(current-name (current-name
(or (and (gethash (buffer-file-name) cc/file-specific-options ) (or (and (gethash (buffer-file-name) clang/file-specific-options )
"file-specific") "file-specific")
(gethash target cc/current-target-optionset)))) (gethash target clang/current-target-optionset))))
(dolist (slot (cddr (eieio-class-slots 'clang-option-config))) (cos/edit-compiler-options options-config current-name)))
(let* ((slot-sym (eieio-slot-descriptor-name slot))
(slot-val (and (slot-boundp options-config slot-sym)
(slot-value options-config slot-sym))))
(when slot-val
(pcase (cl--slot-descriptor-type slot)
('list
(when (or prefix
(not (zerop (length slot-val))))
(setf (slot-value options-config slot-sym)
(read
(read-string (format "Edit '%s' for optionset '%s': "
(symbol-name slot-sym)
current-name)
(prin1-to-string slot-val))))))
('string
(when (or prefix
(not (string= slot-val "")))
(setf (slot-value options-config slot-sym)
(read-string (format "Edit '%s' for optionset '%s': "
(symbol-name slot-sym)
current-name)
slot-val))))))))))
(defvar cc/detect-extensions-function nil) (defun clang/clang-options-merge (primary secondary)
(make-instance
'clang-option-config
:target-str (slot-value primary 'target-str)
:binary (or (slot-value primary 'binary-path)
(car (mapcar #'(lambda (x) (slot-value x 'binary-path))) ))
:target (slot-value primary 'target-options)
:lang (slot-value primary 'lang-options)
:optimization (slot-value primary 'optimization-level)
:other (-->
(cons primary secondary)
(mapconcat
(lambda (x)
(when (slot-boundp x 'other-options)
(slot-value x 'other-options)))
it
" "))
:include-dirs (-->
(cons primary secondary)
(apply #'append
(mapcar
(lambda (x)
(when (slot-boundp x 'include-dirs)
(slot-value x 'include-dirs)))
it)))))
(cl-defun cc/get-clang-options (&key filename compiler action) (defun clang/clang-options->string (opts)
(with-slots
(binary-path
target-options lang-options
other-options optimization-level
include-dirs)
opts
(-->
(list
(or binary-path "")
target-options
lang-options
optimization-level
other-options
(mapconcat (lambda (x)
(format "-I\"%s\"" x))
include-dirs
" "))
(remove-if #'string-empty-p it)
(string-join it " "))))
(defvar clang/detect-extensions-function nil)
(cl-defun clang/get-clang-options (&key filename compiler action)
(interactive) (interactive)
(let* ((filename (or filename (buffer-file-name))) (let* ((filename (or filename (buffer-file-name)))
(target-str (lls/conf-get 'target)) (target-str (lls/conf-get 'target))
(target (intern target-str)) (target (intern target-str))
(options-config (options-config
(cc/get-clang-options-for-target target)) (clang/get-clang-options-for-target target))
(detected-extensions (detected-extensions
(awhen cc/detect-extensions-function (awhen clang/detect-extensions-function
(funcall it compiler action filename target-str)))) (funcall it compiler action filename target-str))))
(cos/clang-options->string (clang/clang-options->string
(cos/clang-options-merge (clang/clang-options-merge
(car options-config) (car options-config)
(append detected-extensions (cdr options-config)))))) (append detected-extensions (cdr options-config))))))

80
lisp/llvm-lib/compiler-option-sets.el
View file

@ -1,4 +1,4 @@
;;; clang-option-sets.el --- -*- lexical-binding: t -*- ;;; compiler-option-sets.el --- -*- lexical-binding: t -*-
;; Copyright (C) 2024 Benson Chu ;; Copyright (C) 2024 Benson Chu
@ -24,7 +24,7 @@
;;; Code: ;;; Code:
(defclass clang-option-config () (defclass compiler-option-config ()
((target-str :initarg :target-str :type string :initform "") ((target-str :initarg :target-str :type string :initform "")
(binary-path :initarg :binary :type string :initform "") (binary-path :initarg :binary :type string :initform "")
(target-options :initarg :target :type string :initform "") (target-options :initarg :target :type string :initform "")
@ -37,57 +37,35 @@
(defmacro register-prebaked-optionset (hashmap target-str key &rest options) (defmacro register-prebaked-optionset (hashmap target-str key &rest options)
(declare (indent 3)) (declare (indent 3))
`(puthash ',key `(puthash ',key
(make-instance 'clang-option-config (make-instance 'compiler-option-config
:target-str ,target-str :target-str ,target-str
,@options) ,@options)
,hashmap)) ,hashmap))
(defun cos/clang-options-merge (primary secondary) (defun cos/edit-compiler-options (optionset current-name)
(make-instance (dolist (slot (cddr (eieio-class-slots 'compiler-option-config)))
'clang-option-config (let* ((slot-sym (eieio-slot-descriptor-name slot))
:target-str (slot-value primary 'target-str) (slot-val (and (slot-boundp optionsset slot-sym)
:binary (or (slot-value primary 'binary-path) (slot-value optionsset slot-sym))))
(car (mapcar #'(lambda (x) (slot-value x 'binary-path))) )) (when slot-val
:target (slot-value primary 'target-options) (pcase (cl--slot-descriptor-type slot)
:lang (slot-value primary 'lang-options) ('list
:optimization (slot-value primary 'optimization-level) (when (or prefix
:other (--> (not (zerop (length slot-val))))
(cons primary secondary) (setf (slot-value optionsset slot-sym)
(mapconcat (read
(lambda (x) (read-string (format "Edit '%s' for optionset '%s': "
(when (slot-boundp x 'other-options) (symbol-name slot-sym)
(slot-value x 'other-options))) current-name)
it (prin1-to-string slot-val))))))
" ")) ('string
:include-dirs (--> (when (or prefix
(cons primary secondary) (not (string= slot-val "")))
(apply #'append (setf (slot-value optionsset slot-sym)
(mapcar (read-string (format "Edit '%s' for optionset '%s': "
(lambda (x) (symbol-name slot-sym)
(when (slot-boundp x 'include-dirs) current-name)
(slot-value x 'include-dirs))) slot-val)))))))))
it)))))
(defun cos/clang-options->string (opts) (provide 'compiler-option-sets)
(with-slots ;;; compiler-option-sets.el ends here
(binary-path
target-options lang-options
other-options optimization-level
include-dirs)
opts
(-->
(list
(or binary-path "")
target-options
lang-options
optimization-level
other-options
(mapconcat (lambda (x)
(format "-I\"%s\"" x))
include-dirs
" "))
(remove-if #'string-empty-p it)
(string-join it " "))))
(provide 'clang-option-sets)
;;; clang-option-sets.el ends here

91
lisp/llvm-lib/lib-comp-dev.el
View file

@ -1,4 +1,4 @@
;;; llvm-shared.el --- -*- lexical-binding: t -*- ;;; lib-comp-dev.el --- -*- lexical-binding: t -*-
;; Copyright (C) 2022 Benson Chu ;; Copyright (C) 2022 Benson Chu
@ -50,57 +50,58 @@
;; =============================== Init ============================== ;; =============================== Init ==============================
(defclass llvm-config () (defclass comp-dev-config ()
((root-dir :initarg :root-dir :type string) ((root-dir :initarg :root-dir :type string)
(bin-dirs-fun :initarg :bin-dirs-fun :type function)
(build-dirs-fun :initarg :build-dirs-fun :type function)
(build-release-dir :initarg :build-release-dir :type string)
(build-debug-dir :initarg :build-debug-dir :type string)
(target :initarg :target :type string) (target :initarg :target :type string)
(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 ()))
(tramp-connection :initarg :tramp :type list :initform nil) (tramp-connection :initarg :tramp :type list :initform nil)
;; Target + CPU -> compilation command options
(target-clang-opts-fun :initarg :clang-opts-fun :type function :initform (lambda ()))
(aux-props :initarg :aux-props :type list :initform nil))) (aux-props :initarg :aux-props :type list :initform nil)))
;; (defvar lls/llvm-config nil) (cl-defgeneric comp-dev/get-bin-dirs (config))
(cl-defgeneric comp-dev/get-build-dirs (config))
(cl-defgeneric comp-dev/get-file-types (config))
(cl-defgeneric comp-dev/get-c-action-table (config))
(cl-defmethod comp-dev/get-c-action-table (config)
nil)
(cl-defgeneric comp-dev/process-file (config start-type end-type compiler file output flags))
(cl-defgeneric comp-dev/tool-name (config tool))
(defvar lls/llvm-configs (make-hash-table :test #'equal)) (defun comp-dev/get-config (&optional tab-name)
(let ((tab-name (or tab-name (alist-get 'name (tab-bar--current-tab)))))
(gethash tab-name comp-dev/configs)))
(defvar comp-dev/configs (make-hash-table :test #'equal))
(defvar lls/target-init-fun nil) (defvar lls/target-init-fun nil)
(defun lls/get-active-configs () (defun lls/get-active-configs ()
(hash-table-values lls/llvm-configs)) (hash-table-values comp-dev/configs))
(defun lls/get-llvm-config (&optional tab-name)
(let ((tab-name (or tab-name (alist-get 'name (tab-bar--current-tab)))))
(gethash tab-name lls/llvm-configs)))
(defun lls/set-llvm-config (conf &optional tab-name) (defun lls/set-llvm-config (conf &optional tab-name)
(puthash (or tab-name (alist-get 'name (tab-bar--current-tab))) (puthash (or tab-name (alist-get 'name (tab-bar--current-tab)))
conf conf
lls/llvm-configs)) comp-dev/configs))
;; (defvar lls/llvm-config nil)
(defun lls/conf-get (sym) (defun lls/conf-get (sym)
(lls/ensure-initialized) (comp-dev/ensure-initialized)
(slot-value (lls/get-llvm-config) sym)) (slot-value (comp-dev/get-config) sym))
(defun lls/conf-get-safe (sym) (defun lls/conf-get-safe (sym)
(if-let ((conf (lls/get-llvm-config))) (if-let ((conf (comp-dev/get-config)))
(slot-value conf sym) (slot-value conf sym)
nil)) nil))
(defun lls/conf-aux-get (sym) (defun lls/conf-aux-get (sym)
(lls/ensure-initialized) (comp-dev/ensure-initialized)
(--> (-->
(lls/conf-get 'aux-props) (lls/conf-get 'aux-props)
(alist-get sym it))) (alist-get sym it)))
(defun lls/conf-set (key val) (defun lls/conf-set (key val)
(lls/ensure-initialized) (comp-dev/ensure-initialized)
(setf (slot-value (lls/get-llvm-config) key) (setf (slot-value (comp-dev/get-config) key)
val)) val))
(defun lls/tramp-connection () (defun lls/tramp-connection ()
@ -120,9 +121,9 @@
(defun lls/default-initialize () (defun lls/default-initialize ()
(interactive) (interactive)
(let ((lls/target-init-fun #'lls/default-target-init)) (let ((lls/target-init-fun #'lls/default-target-init))
(lls/initialize))) (comp-dev/initialize)))
(defun lls/initialize () (defun comp-dev/initialize ()
(interactive) (interactive)
(lls/set-llvm-config (lls/set-llvm-config
(or (or
@ -134,21 +135,21 @@
(->> (->>
(tab-bar-tabs) (tab-bar-tabs)
(mapcar #'(lambda (x) (alist-get 'name x))) (mapcar #'(lambda (x) (alist-get 'name x)))
(remove-if-not #'(lambda (x) (lls/get-llvm-config x))))))) (remove-if-not #'(lambda (x) (comp-dev/get-config x)))))))
(lls/get-llvm-config tab-name)))) (comp-dev/get-config tab-name))))
(funcall lls/target-init-fun))) (funcall lls/target-init-fun)))
(load-llvm-mode (lls/conf-get 'root-dir)) (load-llvm-mode (lls/conf-get 'root-dir))
(message "llvm-lib initialize!")) (message "comp-dev initialize!"))
(defun lls/initialized? () (defun comp-dev/initialized? ()
(and (lls/get-llvm-config) (and (comp-dev/get-config)
(llvm-config-p (lls/get-llvm-config)))) (typep (comp-dev/get-config) 'comp-dev-config)))
(defun lls/ensure-initialized () (defun comp-dev/ensure-initialized ()
(when (not (lls/initialized?)) (when (not (comp-dev/initialized?))
(if (not (functionp lls/target-init-fun)) (if (not (functionp lls/target-init-fun))
(error "Please register an init function for llvm") (error "Please register an init function for llvm")
(lls/initialize)))) (comp-dev/initialize))))
(defun lls/get-cached-value (key fun) (defun lls/get-cached-value (key fun)
(or (lls/conf-get key) (or (lls/conf-get key)
@ -180,18 +181,18 @@
;;===---------------------------------------------------------------------===;; ;;===---------------------------------------------------------------------===;;
(defun lls/get-llvm-root-dir () (defun lls/get-llvm-root-dir ()
(lls/ensure-initialized) (comp-dev/ensure-initialized)
(lls/conf-get 'root-dir)) (lls/conf-get 'root-dir))
(defun lls/get-llvm-build-dirs () (defun lls/get-llvm-build-dirs ()
(lls/ensure-initialized) (comp-dev/ensure-initialized)
(funcall (lls/conf-get 'build-dirs-fun))) (funcall (lls/conf-get 'build-dirs-fun)))
(defun lls/get-llvm-bin-dir () (defun lls/get-llvm-bin-dir ()
(car (lls/get-llvm-bin-dirs))) (car (lls/get-llvm-bin-dirs)))
(defun lls/get-llvm-bin-dirs () (defun lls/get-llvm-bin-dirs ()
(lls/ensure-initialized) (comp-dev/ensure-initialized)
(append (mapcar #'(lambda (x) (expand-file-name "bin" x)) (append (mapcar #'(lambda (x) (expand-file-name "bin" x))
(lls/get-llvm-build-dirs)) (lls/get-llvm-build-dirs))
(funcall (lls/conf-get 'bin-dirs-fun)))) (funcall (lls/conf-get 'bin-dirs-fun))))
@ -205,15 +206,11 @@
(defun lls/add-llvm-build-dir (dir) (defun lls/add-llvm-build-dir (dir)
(interactive (interactive
(list (read-file-name "Where? "))) (list (read-file-name "Where? ")))
(lls/ensure-initialized) (comp-dev/ensure-initialized)
(lls/conf-set 'build-dirs (lls/conf-set 'build-dirs
(cons dir (cons dir
(lls/conf-get 'build-dirs)))) (lls/conf-get 'build-dirs))))
(defun lls/get-clang-options (&rest args)
(apply (lls/conf-get 'target-clang-opts-fun)
args))
;; =============================== Misc ============================== ;; =============================== Misc ==============================
(defun my/completing-read (prompt collection &optional initial-input) (defun my/completing-read (prompt collection &optional initial-input)
@ -244,7 +241,7 @@
(message "Checking %s..." dir)) (message "Checking %s..." dir))
(directory-files dir t tool-regexp))) (directory-files dir t tool-regexp)))
(or directories (or directories
(lls/get-llvm-bin-dirs)))) (comp-dev/get-bin-dirs (comp-dev/get-config)))))
(defun lls/get-clang-command-fun (&rest args) (defun lls/get-clang-command-fun (&rest args)
(apply (lls/conf-get 'compile-command-fun) (apply (lls/conf-get 'compile-command-fun)
@ -389,5 +386,5 @@
(format comm-temp directory build-type target)))) (format comm-temp directory build-type target))))
(compile command))) (compile command)))
(provide 'llvm-shared) (provide 'lib-comp-dev)
;;; llvm-shared.el ends here ;;; lib-comp-dev.el ends here

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

@ -23,7 +23,7 @@
;;; Commentary: ;;; Commentary:
;;; Code: ;;; Code:
(require 'llvm-shared) (require 'lib-comp-dev)
(require 'action-map-lib) (require 'action-map-lib)
(defvar ll/asm-file-action-map (defvar ll/asm-file-action-map

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

@ -24,27 +24,28 @@
;;; Code: ;;; Code:
(require 'llvm-ir-mode) (require 'llvm-ir-mode)
(require 'llvm-shared) (require 'lib-comp-dev)
(require 'action-map-lib) (require 'action-map-lib)
(require 'anaphora) (require 'anaphora)
(require 'make-tmp-output-file) (require 'make-tmp-output-file)
(defvar ll/c-file-action-map (defvar ll/c-file-action-map
'((debug :key ?d :major-mode llvm-mode :buffer-string "debug" :description "[d]ebug pass" :compiler-action assemble) '((preprocess :key ?e :major-mode c-mode :buffer-string "preprocess" :description "pr[e]process" :end-state pp-c)
(assembly :key ?a :major-mode asm-mode :buffer-string "assembly" :description "[a]ssembly" :compiler-action assemble) (diff :key ?D :major-mode nil :buffer-string "diff" :description "[D]iff" :end-state asm)))
(output-dis :key ?A :major-mode asm-mode :buffer-string "dissasembly" :description "output-dis[A]ssemble" :compiler-action nil)
(preprocess :key ?e :major-mode c-mode :buffer-string "preprocess" :description "pr[e]process" :compiler-action preprocess) ;; (executable :key ?\^M :major-mode nil :buffer-string "executable" :description "[RET]Executable" :compiler-action executable)
(LLVMIR :key ?l :major-mode llvm-mode :buffer-string "llvm-ir" :description "[l]lvm-ir" :compiler-action llvm-ir)
(before-after :key ?p :major-mode llvm-mode :buffer-string "print-before-after" :description "[p]rint before/after" :compiler-action assemble)
(changed :key ?P :major-mode llvm-mode :buffer-string "print-changed" :description "[P]rint before/after all" :compiler-action assemble)
(executable :key ?\^M :major-mode nil :buffer-string "executable" :description "[RET]Executable" :compiler-action executable)
(diff :key ?D :major-mode nil :buffer-string "diff" :description "[D]iff" :compiler-action assemble)))
(defun ll/ensure-clang-binary-built (dir) (defun ll/ensure-clang-binary-built (dir)
;; TODO: assumed build-dir constant, should take as argument and prompt ;; TODO: assumed build-dir constant, should take as argument and prompt
;; further up ;; further up
(lls/run-build-command dir '("clang"))) (lls/run-build-command dir '("clang")))
(defun ll/get-c-action-map ()
(append
(comp-dev/get-c-action-table
(comp-dev/get-config))
ll/c-file-action-map))
(defun ll/clang-output-disassemble-command (file) (defun ll/clang-output-disassemble-command (file)
(let ((compiler (lls/prompt-tool "clang$")) (let ((compiler (lls/prompt-tool "clang$"))
(tmp-file (make-temp-file (file-name-sans-extension (file-name-nondirectory file))))) (tmp-file (make-temp-file (file-name-sans-extension (file-name-nondirectory file)))))
@ -72,24 +73,24 @@
(defun ll/build-clang-command (file action &optional output) (defun ll/build-clang-command (file action &optional output)
(if (eq action 'output-dis) (if (eq action 'output-dis)
(ll/clang-output-disassemble-command file) (ll/clang-output-disassemble-command file)
(let ((compiler-action (aml/get-map-prop ll/c-file-action-map action :compiler-action)) (let ((end (aml/get-map-prop
(compiler (lls/prompt-tool "clang$"))) (ll/get-c-action-map)
action :end-state))
(compiler (lls/prompt-tool (comp-dev/tool-name (comp-dev/get-config) 'compiler))))
(string-join (string-join
(list (list
(when (y-or-n-p "Would you like to `rr record`? ") (when (y-or-n-p "Would you like to `rr record`? ")
"rr record ") "rr record ")
(lls/get-clang-command-fun (-->
:compiler compiler (comp-dev/get-config)
:file file (comp-dev/process-file
:action compiler-action it 'c end compiler file output
:output output
:flags
(list (list
(pcase action (pcase action
('debug (format "-mllvm -debug-only=%s" (ll/read-pass-name "Which pass? "))) ('debug (format "-mllvm -debug-only=%s" (ll/read-pass-name "Which pass? ")))
('before-after (let ((pass (ll/read-pass-name "Which pass? "))) ('before-after (let ((pass (ll/read-pass-name "Which pass? ")))
(format "-mllvm -print-before=%s -mllvm -print-after=%s" pass pass))) (format "-mllvm -print-before=%s -mllvm -print-after=%s" pass pass)))
('changed "-mllvm -print-before-all")))) ('changed "-mllvm -print-before-all")))))
" ") " ")
" ")))) " "))))
@ -152,13 +153,14 @@
(_ (error "Invalid choice"))))) (_ (error "Invalid choice")))))
(defun ll/act-on-c-file (file) (defun ll/act-on-c-file (file)
(let* ((action (aml/read-action-map ll/c-file-action-map)) (let* ((action-map (ll/get-c-action-map))
(action (aml/read-action-map action-map))
(output (ll/make-tmp-file (output (ll/make-tmp-file
file file
(cond (cond
((eq 'assemble ((eq 'asm
(aml/get-map-prop ll/c-file-action-map action (aml/get-map-prop action-map action
:compiler-action)) :end-state))
".S") ".S")
(t ".ll"))))) (t ".ll")))))
(if (eq action 'diff) (if (eq action 'diff)
@ -167,11 +169,11 @@
(aprog1 (aprog1
(compilation-start (compilation-start
comm comm
(aml/get-map-prop ll/c-file-action-map action :major-mode) (aml/get-map-prop action-map action :major-mode)
(lambda (x) (lambda (x)
(format "*%s-%s*" (format "*%s-%s*"
(file-name-nondirectory file) (file-name-nondirectory file)
(aml/get-map-prop ll/c-file-action-map action (aml/get-map-prop action-map action
:buffer-string)))) :buffer-string))))
(with-current-buffer it (with-current-buffer it
(setq ll/act-on-file-output output))))))) (setq ll/act-on-file-output output)))))))

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

@ -23,7 +23,7 @@
;;; Commentary: ;;; Commentary:
;;; Code: ;;; Code:
(require 'llvm-shared) (require 'lib-comp-dev)
(require 'action-map-lib) (require 'action-map-lib)
(require 'make-tmp-output-file) (require 'make-tmp-output-file)

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

@ -23,7 +23,7 @@
;;; Commentary: ;;; Commentary:
;;; Code: ;;; Code:
(require 'llvm-shared) (require 'lib-comp-dev)
(require 'action-map-lib) (require 'action-map-lib)
(require 'anaphora) (require 'anaphora)

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

@ -23,7 +23,7 @@
;;; Commentary: ;;; Commentary:
;;; Code: ;;; Code:
(require 'llvm-shared) (require 'lib-comp-dev)
(require 'action-map-lib) (require 'action-map-lib)
(require 'dash) (require 'dash)

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

@ -23,7 +23,7 @@
;;; Commentary: ;;; Commentary:
;;; Code: ;;; Code:
(require 'llvm-shared) (require 'lib-comp-dev)
(require 'my-comp-minor-mode) (require 'my-comp-minor-mode)
(require 'act-on-test-file) (require 'act-on-test-file)
(require 'act-on-c-file) (require 'act-on-c-file)

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

@ -23,7 +23,7 @@
;;; Commentary: ;;; Commentary:
;;; Code: ;;; Code:
(require 'llvm-shared) (require 'lib-comp-dev)
(defun ll/get-llvm-source-build-command (file) (defun ll/get-llvm-source-build-command (file)
(interactive (interactive

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

@ -23,7 +23,7 @@
;;; Commentary: ;;; Commentary:
;;; Code: ;;; Code:
(require 'llvm-shared) (require 'lib-comp-dev)
(require 'tmux-cmd) (require 'tmux-cmd)
(defvar lls/name-llvm-build-buffer (defvar lls/name-llvm-build-buffer

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

@ -25,7 +25,7 @@
;;; Code: ;;; Code:
(require 'act-on-c-file) (require 'act-on-c-file)
(require 'llvm-shared) (require 'lib-comp-dev)
(require 'anaphora) (require 'anaphora)
(defun ll/get-cc1-command (clang command) (defun ll/get-cc1-command (clang command)

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

@ -28,7 +28,7 @@
(require 'llvm-gdb-command) (require 'llvm-gdb-command)
(require 'llvm-show-instr-info) (require 'llvm-show-instr-info)
(require 'llvm-jump-to-tablegen) (require 'llvm-jump-to-tablegen)
(require 'llvm-shared) (require 'lib-comp-dev)
(define-prefix-command '*llvm-map*) (define-prefix-command '*llvm-map*)
(define-key *root-map* (kbd "C-w") '*llvm-map*) (define-key *root-map* (kbd "C-w") '*llvm-map*)
@ -37,7 +37,7 @@
(define-key *llvm-map* (kbd "c") #'ll/llvm-build-tool) (define-key *llvm-map* (kbd "c") #'ll/llvm-build-tool)
(define-key *llvm-map* (kbd "M-w") #'ll/kill-gdb-command) (define-key *llvm-map* (kbd "M-w") #'ll/kill-gdb-command)
(define-key *llvm-map* (kbd "i") #'ll/prompt-for-instr-info) (define-key *llvm-map* (kbd "i") #'ll/prompt-for-instr-info)
(define-key *llvm-map* (kbd "I") #'lls/initialize) (define-key *llvm-map* (kbd "I") #'comp-dev/initialize)
(define-key *llvm-map* (kbd "t") #'ll/jump-to-tablegen) (define-key *llvm-map* (kbd "t") #'ll/jump-to-tablegen)
(provide 'llvm-lib) (provide 'llvm-lib)