mirror of
https://github.com/pestctrl/emacs-config.git
synced 2026-06-14 04:11:18 +00:00
llvm-lib 3.0!
This commit is contained in:
Benson Chu
parent
e8fc49a0e3
commit
e4b4c9f8b4
13 changed files with 237 additions and 232 deletions
|
|
@ -23,7 +23,10 @@
|
|||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
(require 'clang-option-sets)
|
||||
(require 'compiler-option-sets)
|
||||
|
||||
(defclass clang-option-config (compiler-option-config)
|
||||
nil)
|
||||
|
||||
(defvar clang-subtargets
|
||||
(make-hash-table :test #'equal))
|
||||
|
|
@ -31,23 +34,23 @@
|
|||
(defvar clang-options-extensions
|
||||
(make-hash-table :test #'equal))
|
||||
|
||||
(defvar cc/all-target-options
|
||||
(defvar clang/all-target-options
|
||||
(make-hash-table))
|
||||
|
||||
(defvar cc/current-target-optionset
|
||||
(defvar clang/current-target-optionset
|
||||
(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
|
||||
(cons (cons name option-set)
|
||||
(gethash target cc/all-target-options))
|
||||
cc/all-target-options))
|
||||
(gethash target clang/all-target-options))
|
||||
clang/all-target-options))
|
||||
|
||||
(defun cc/add-and-set-target-option (target name option-set)
|
||||
(puthash target name cc/current-target-optionset)
|
||||
(cc/push-new-target-option target name option-set))
|
||||
(defun clang/add-and-set-target-option (target name option-set)
|
||||
(puthash target name clang/current-target-optionset)
|
||||
(clang/push-new-target-option target name option-set))
|
||||
|
||||
(defvar cc/file-specific-options
|
||||
(defvar clang/file-specific-options
|
||||
(make-hash-table :test #'equal))
|
||||
|
||||
(defun my/completing-read-formatter (formatter prompt list)
|
||||
|
|
@ -60,12 +63,12 @@
|
|||
alist
|
||||
nil nil #'equal)))
|
||||
|
||||
(defun cc/make-clang-option-set (target)
|
||||
(defun clang/make-clang-option-set (target)
|
||||
(let ((subtargets (hash-table-values clang-subtargets))
|
||||
primary extensions)
|
||||
(setq primary
|
||||
(my/completing-read-formatter
|
||||
#'cos/clang-options->string
|
||||
#'clang/clang-options->string
|
||||
"Primary Subtarget? "
|
||||
(remove-if-not (lambda (x)
|
||||
(string= target
|
||||
|
|
@ -73,121 +76,146 @@
|
|||
subtargets)))
|
||||
(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
|
||||
(gethash target cc/all-target-options)))
|
||||
(gethash target clang/all-target-options)))
|
||||
(and target-options
|
||||
(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))))
|
||||
(let ((option-name (or (gethash target cc/current-target-optionset)
|
||||
(puthash target "default" cc/current-target-optionset))))
|
||||
(aprog1 (cc/make-clang-option-set target)
|
||||
(cc/push-new-target-option target option-name it))))
|
||||
(let ((option-name (or (gethash target clang/current-target-optionset)
|
||||
(puthash target "default" clang/current-target-optionset))))
|
||||
(aprog1 (clang/make-clang-option-set target)
|
||||
(clang/push-new-target-option target option-name it))))
|
||||
|
||||
;;; 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
|
||||
(gethash target cc/current-target-optionset)
|
||||
(puthash target "default" cc/current-target-optionset))))
|
||||
(or (gethash (buffer-file-name) cc/file-specific-options)
|
||||
(cc/get-named-target-clang-optionset target option-name)
|
||||
(aprog1 (cc/make-clang-option-set target)
|
||||
(cc/push-new-target-option target option-name it)))))
|
||||
(gethash target clang/current-target-optionset)
|
||||
(puthash target "default" clang/current-target-optionset))))
|
||||
(or (gethash (buffer-file-name) clang/file-specific-options)
|
||||
(clang/get-named-target-clang-optionset target option-name)
|
||||
(aprog1 (clang/make-clang-option-set target)
|
||||
(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
|
||||
(list (intern (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)))
|
||||
(let ((target lls/conf-get 'target))
|
||||
(list target
|
||||
(--> (intern target)
|
||||
(gethash it cc/all-target-options)
|
||||
(gethash it clang/all-target-options)
|
||||
(mapcar #'car it)
|
||||
(completing-read "Optionset? " it)))))
|
||||
(remhash (buffer-file-name)
|
||||
cc/file-specific-options)
|
||||
(cc/get-clang-options-for-target target name)
|
||||
(puthash (intern target) name cc/current-target-optionset))
|
||||
clang/file-specific-options)
|
||||
(clang/get-clang-options-for-target target name)
|
||||
(puthash (intern target) name clang/current-target-optionset))
|
||||
|
||||
(defun cc/edit-clang-options (prefix)
|
||||
(defun clang/edit-clang-options (prefix)
|
||||
(interactive "P")
|
||||
(let* ((target (intern (lls/conf-get 'target)))
|
||||
(options-config
|
||||
(->>
|
||||
target
|
||||
(cc/get-clang-options-for-target)
|
||||
(clang/get-clang-options-for-target)
|
||||
(car)))
|
||||
(current-name
|
||||
(or (and (gethash (buffer-file-name) cc/file-specific-options )
|
||||
(or (and (gethash (buffer-file-name) clang/file-specific-options )
|
||||
"file-specific")
|
||||
(gethash target cc/current-target-optionset))))
|
||||
(dolist (slot (cddr (eieio-class-slots 'clang-option-config)))
|
||||
(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))))))))))
|
||||
(gethash target clang/current-target-optionset))))
|
||||
(cos/edit-compiler-options options-config current-name)))
|
||||
|
||||
(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)
|
||||
(let* ((filename (or filename (buffer-file-name)))
|
||||
(target-str (lls/conf-get 'target))
|
||||
(target (intern target-str))
|
||||
(options-config
|
||||
(cc/get-clang-options-for-target target))
|
||||
(clang/get-clang-options-for-target target))
|
||||
(detected-extensions
|
||||
(awhen cc/detect-extensions-function
|
||||
(awhen clang/detect-extensions-function
|
||||
(funcall it compiler action filename target-str))))
|
||||
(cos/clang-options->string
|
||||
(cos/clang-options-merge
|
||||
(clang/clang-options->string
|
||||
(clang/clang-options-merge
|
||||
(car options-config)
|
||||
(append detected-extensions (cdr options-config))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; clang-option-sets.el --- -*- lexical-binding: t -*-
|
||||
;;; compiler-option-sets.el --- -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2024 Benson Chu
|
||||
|
||||
|
|
@ -24,7 +24,7 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(defclass clang-option-config ()
|
||||
(defclass compiler-option-config ()
|
||||
((target-str :initarg :target-str :type string :initform "")
|
||||
(binary-path :initarg :binary :type string :initform "")
|
||||
(target-options :initarg :target :type string :initform "")
|
||||
|
|
@ -37,57 +37,35 @@
|
|||
(defmacro register-prebaked-optionset (hashmap target-str key &rest options)
|
||||
(declare (indent 3))
|
||||
`(puthash ',key
|
||||
(make-instance 'clang-option-config
|
||||
(make-instance 'compiler-option-config
|
||||
:target-str ,target-str
|
||||
,@options)
|
||||
,hashmap))
|
||||
|
||||
(defun cos/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)))))
|
||||
(defun cos/edit-compiler-options (optionset current-name)
|
||||
(dolist (slot (cddr (eieio-class-slots 'compiler-option-config)))
|
||||
(let* ((slot-sym (eieio-slot-descriptor-name slot))
|
||||
(slot-val (and (slot-boundp optionsset slot-sym)
|
||||
(slot-value optionsset slot-sym))))
|
||||
(when slot-val
|
||||
(pcase (cl--slot-descriptor-type slot)
|
||||
('list
|
||||
(when (or prefix
|
||||
(not (zerop (length slot-val))))
|
||||
(setf (slot-value optionsset 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 optionsset slot-sym)
|
||||
(read-string (format "Edit '%s' for optionset '%s': "
|
||||
(symbol-name slot-sym)
|
||||
current-name)
|
||||
slot-val)))))))))
|
||||
|
||||
(defun cos/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 " "))))
|
||||
|
||||
(provide 'clang-option-sets)
|
||||
;;; clang-option-sets.el ends here
|
||||
(provide 'compiler-option-sets)
|
||||
;;; compiler-option-sets.el ends here
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; llvm-shared.el --- -*- lexical-binding: t -*-
|
||||
;;; lib-comp-dev.el --- -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2022 Benson Chu
|
||||
|
||||
|
|
@ -50,57 +50,58 @@
|
|||
|
||||
;; =============================== Init ==============================
|
||||
|
||||
(defclass llvm-config ()
|
||||
(defclass comp-dev-config ()
|
||||
((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)
|
||||
(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)
|
||||
;; 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)))
|
||||
|
||||
;; (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)
|
||||
|
||||
(defun lls/get-active-configs ()
|
||||
(hash-table-values lls/llvm-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)))
|
||||
(hash-table-values comp-dev/configs))
|
||||
|
||||
(defun lls/set-llvm-config (conf &optional tab-name)
|
||||
(puthash (or tab-name (alist-get 'name (tab-bar--current-tab)))
|
||||
conf
|
||||
lls/llvm-configs))
|
||||
comp-dev/configs))
|
||||
|
||||
;; (defvar lls/llvm-config nil)
|
||||
|
||||
(defun lls/conf-get (sym)
|
||||
(lls/ensure-initialized)
|
||||
(slot-value (lls/get-llvm-config) sym))
|
||||
(comp-dev/ensure-initialized)
|
||||
(slot-value (comp-dev/get-config) 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)
|
||||
nil))
|
||||
|
||||
(defun lls/conf-aux-get (sym)
|
||||
(lls/ensure-initialized)
|
||||
(comp-dev/ensure-initialized)
|
||||
(-->
|
||||
(lls/conf-get 'aux-props)
|
||||
(alist-get sym it)))
|
||||
|
||||
(defun lls/conf-set (key val)
|
||||
(lls/ensure-initialized)
|
||||
(setf (slot-value (lls/get-llvm-config) key)
|
||||
(comp-dev/ensure-initialized)
|
||||
(setf (slot-value (comp-dev/get-config) key)
|
||||
val))
|
||||
|
||||
(defun lls/tramp-connection ()
|
||||
|
|
@ -120,9 +121,9 @@
|
|||
(defun lls/default-initialize ()
|
||||
(interactive)
|
||||
(let ((lls/target-init-fun #'lls/default-target-init))
|
||||
(lls/initialize)))
|
||||
(comp-dev/initialize)))
|
||||
|
||||
(defun lls/initialize ()
|
||||
(defun comp-dev/initialize ()
|
||||
(interactive)
|
||||
(lls/set-llvm-config
|
||||
(or
|
||||
|
|
@ -134,21 +135,21 @@
|
|||
(->>
|
||||
(tab-bar-tabs)
|
||||
(mapcar #'(lambda (x) (alist-get 'name x)))
|
||||
(remove-if-not #'(lambda (x) (lls/get-llvm-config x)))))))
|
||||
(lls/get-llvm-config tab-name))))
|
||||
(remove-if-not #'(lambda (x) (comp-dev/get-config x)))))))
|
||||
(comp-dev/get-config tab-name))))
|
||||
(funcall lls/target-init-fun)))
|
||||
(load-llvm-mode (lls/conf-get 'root-dir))
|
||||
(message "llvm-lib initialize!"))
|
||||
(message "comp-dev initialize!"))
|
||||
|
||||
(defun lls/initialized? ()
|
||||
(and (lls/get-llvm-config)
|
||||
(llvm-config-p (lls/get-llvm-config))))
|
||||
(defun comp-dev/initialized? ()
|
||||
(and (comp-dev/get-config)
|
||||
(typep (comp-dev/get-config) 'comp-dev-config)))
|
||||
|
||||
(defun lls/ensure-initialized ()
|
||||
(when (not (lls/initialized?))
|
||||
(defun comp-dev/ensure-initialized ()
|
||||
(when (not (comp-dev/initialized?))
|
||||
(if (not (functionp lls/target-init-fun))
|
||||
(error "Please register an init function for llvm")
|
||||
(lls/initialize))))
|
||||
(comp-dev/initialize))))
|
||||
|
||||
(defun lls/get-cached-value (key fun)
|
||||
(or (lls/conf-get key)
|
||||
|
|
@ -180,18 +181,18 @@
|
|||
;;===---------------------------------------------------------------------===;;
|
||||
|
||||
(defun lls/get-llvm-root-dir ()
|
||||
(lls/ensure-initialized)
|
||||
(comp-dev/ensure-initialized)
|
||||
(lls/conf-get 'root-dir))
|
||||
|
||||
(defun lls/get-llvm-build-dirs ()
|
||||
(lls/ensure-initialized)
|
||||
(comp-dev/ensure-initialized)
|
||||
(funcall (lls/conf-get 'build-dirs-fun)))
|
||||
|
||||
(defun lls/get-llvm-bin-dir ()
|
||||
(car (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))
|
||||
(lls/get-llvm-build-dirs))
|
||||
(funcall (lls/conf-get 'bin-dirs-fun))))
|
||||
|
|
@ -205,15 +206,11 @@
|
|||
(defun lls/add-llvm-build-dir (dir)
|
||||
(interactive
|
||||
(list (read-file-name "Where? ")))
|
||||
(lls/ensure-initialized)
|
||||
(comp-dev/ensure-initialized)
|
||||
(lls/conf-set 'build-dirs
|
||||
(cons dir
|
||||
(lls/conf-get 'build-dirs))))
|
||||
|
||||
(defun lls/get-clang-options (&rest args)
|
||||
(apply (lls/conf-get 'target-clang-opts-fun)
|
||||
args))
|
||||
|
||||
;; =============================== Misc ==============================
|
||||
|
||||
(defun my/completing-read (prompt collection &optional initial-input)
|
||||
|
|
@ -244,7 +241,7 @@
|
|||
(message "Checking %s..." dir))
|
||||
(directory-files dir t tool-regexp)))
|
||||
(or directories
|
||||
(lls/get-llvm-bin-dirs))))
|
||||
(comp-dev/get-bin-dirs (comp-dev/get-config)))))
|
||||
|
||||
(defun lls/get-clang-command-fun (&rest args)
|
||||
(apply (lls/conf-get 'compile-command-fun)
|
||||
|
|
@ -389,5 +386,5 @@
|
|||
(format comm-temp directory build-type target))))
|
||||
(compile command)))
|
||||
|
||||
(provide 'llvm-shared)
|
||||
;;; llvm-shared.el ends here
|
||||
(provide 'lib-comp-dev)
|
||||
;;; lib-comp-dev.el ends here
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@
|
|||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
(require 'llvm-shared)
|
||||
(require 'lib-comp-dev)
|
||||
(require 'action-map-lib)
|
||||
|
||||
(defvar ll/asm-file-action-map
|
||||
|
|
|
|||
|
|
@ -24,27 +24,28 @@
|
|||
|
||||
;;; Code:
|
||||
(require 'llvm-ir-mode)
|
||||
(require 'llvm-shared)
|
||||
(require 'lib-comp-dev)
|
||||
(require 'action-map-lib)
|
||||
(require 'anaphora)
|
||||
(require 'make-tmp-output-file)
|
||||
|
||||
(defvar ll/c-file-action-map
|
||||
'((debug :key ?d :major-mode llvm-mode :buffer-string "debug" :description "[d]ebug pass" :compiler-action assemble)
|
||||
(assembly :key ?a :major-mode asm-mode :buffer-string "assembly" :description "[a]ssembly" :compiler-action assemble)
|
||||
(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)
|
||||
(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)))
|
||||
'((preprocess :key ?e :major-mode c-mode :buffer-string "preprocess" :description "pr[e]process" :end-state pp-c)
|
||||
(diff :key ?D :major-mode nil :buffer-string "diff" :description "[D]iff" :end-state asm)))
|
||||
|
||||
;; (executable :key ?\^M :major-mode nil :buffer-string "executable" :description "[RET]Executable" :compiler-action executable)
|
||||
|
||||
(defun ll/ensure-clang-binary-built (dir)
|
||||
;; TODO: assumed build-dir constant, should take as argument and prompt
|
||||
;; further up
|
||||
(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)
|
||||
(let ((compiler (lls/prompt-tool "clang$"))
|
||||
(tmp-file (make-temp-file (file-name-sans-extension (file-name-nondirectory file)))))
|
||||
|
|
@ -72,25 +73,25 @@
|
|||
(defun ll/build-clang-command (file action &optional output)
|
||||
(if (eq action 'output-dis)
|
||||
(ll/clang-output-disassemble-command file)
|
||||
(let ((compiler-action (aml/get-map-prop ll/c-file-action-map action :compiler-action))
|
||||
(compiler (lls/prompt-tool "clang$")))
|
||||
(let ((end (aml/get-map-prop
|
||||
(ll/get-c-action-map)
|
||||
action :end-state))
|
||||
(compiler (lls/prompt-tool (comp-dev/tool-name (comp-dev/get-config) 'compiler))))
|
||||
(string-join
|
||||
(list
|
||||
(when (y-or-n-p "Would you like to `rr record`? ")
|
||||
"rr record ")
|
||||
(lls/get-clang-command-fun
|
||||
:compiler compiler
|
||||
:file file
|
||||
:action compiler-action
|
||||
:output output
|
||||
:flags
|
||||
(list
|
||||
(pcase action
|
||||
('debug (format "-mllvm -debug-only=%s" (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)))
|
||||
('changed "-mllvm -print-before-all"))))
|
||||
" ")
|
||||
(-->
|
||||
(comp-dev/get-config)
|
||||
(comp-dev/process-file
|
||||
it 'c end compiler file output
|
||||
(list
|
||||
(pcase action
|
||||
('debug (format "-mllvm -debug-only=%s" (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)))
|
||||
('changed "-mllvm -print-before-all")))))
|
||||
" ")
|
||||
" "))))
|
||||
|
||||
(defun ll/buffer-has-include-error (buffer)
|
||||
|
|
@ -152,13 +153,14 @@
|
|||
(_ (error "Invalid choice")))))
|
||||
|
||||
(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
|
||||
file
|
||||
(cond
|
||||
((eq 'assemble
|
||||
(aml/get-map-prop ll/c-file-action-map action
|
||||
:compiler-action))
|
||||
((eq 'asm
|
||||
(aml/get-map-prop action-map action
|
||||
:end-state))
|
||||
".S")
|
||||
(t ".ll")))))
|
||||
(if (eq action 'diff)
|
||||
|
|
@ -167,11 +169,11 @@
|
|||
(aprog1
|
||||
(compilation-start
|
||||
comm
|
||||
(aml/get-map-prop ll/c-file-action-map action :major-mode)
|
||||
(aml/get-map-prop action-map action :major-mode)
|
||||
(lambda (x)
|
||||
(format "*%s-%s*"
|
||||
(file-name-nondirectory file)
|
||||
(aml/get-map-prop ll/c-file-action-map action
|
||||
(aml/get-map-prop action-map action
|
||||
:buffer-string))))
|
||||
(with-current-buffer it
|
||||
(setq ll/act-on-file-output output)))))))
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@
|
|||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
(require 'llvm-shared)
|
||||
(require 'lib-comp-dev)
|
||||
(require 'action-map-lib)
|
||||
(require 'make-tmp-output-file)
|
||||
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@
|
|||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
(require 'llvm-shared)
|
||||
(require 'lib-comp-dev)
|
||||
(require 'action-map-lib)
|
||||
(require 'anaphora)
|
||||
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@
|
|||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
(require 'llvm-shared)
|
||||
(require 'lib-comp-dev)
|
||||
(require 'action-map-lib)
|
||||
(require 'dash)
|
||||
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@
|
|||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
(require 'llvm-shared)
|
||||
(require 'lib-comp-dev)
|
||||
(require 'my-comp-minor-mode)
|
||||
(require 'act-on-test-file)
|
||||
(require 'act-on-c-file)
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@
|
|||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
(require 'llvm-shared)
|
||||
(require 'lib-comp-dev)
|
||||
|
||||
(defun ll/get-llvm-source-build-command (file)
|
||||
(interactive
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@
|
|||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
(require 'llvm-shared)
|
||||
(require 'lib-comp-dev)
|
||||
(require 'tmux-cmd)
|
||||
|
||||
(defvar lls/name-llvm-build-buffer
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'act-on-c-file)
|
||||
(require 'llvm-shared)
|
||||
(require 'lib-comp-dev)
|
||||
(require 'anaphora)
|
||||
|
||||
(defun ll/get-cc1-command (clang command)
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@
|
|||
(require 'llvm-gdb-command)
|
||||
(require 'llvm-show-instr-info)
|
||||
(require 'llvm-jump-to-tablegen)
|
||||
(require 'llvm-shared)
|
||||
(require 'lib-comp-dev)
|
||||
|
||||
(define-prefix-command '*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 "M-w") #'ll/kill-gdb-command)
|
||||
(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)
|
||||
|
||||
(provide 'llvm-lib)
|
||||
|
|
|
|||
Loading…
Reference in a new issue