procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

review two slot names in comp-func

Browse source
This commit is contained in:
Andrea Corallo 2019-11-24 15:07:54 +01:00
parent c039822082
commit 960aa0c798
2 changed files with 25 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

40
lisp/emacs-lisp/comp.el
View file

@ -223,9 +223,9 @@ Is in use to help the SSA rename pass."))
(cl-defstruct (comp-func (:copier nil)) (cl-defstruct (comp-func (:copier nil))
"LIMPLE representation of a function." "LIMPLE representation of a function."
(symbol-name nil (name nil :type symbol
:documentation "Function's symbol name.") :documentation "Function symbol name.")
(c-func-name nil :type string (c-name nil :type string
:documentation "The function name in the native world.") :documentation "The function name in the native world.")
(byte-func nil (byte-func nil
:documentation "Byte compiled version.") :documentation "Byte compiled version.")
@ -346,7 +346,7 @@ BODY is evaluate only if `comp-verbose' is > 0."
"Log function FUNC. "Log function FUNC.
VERBOSITY is a number between 0 and 3." VERBOSITY is a number between 0 and 3."
(when (>= comp-verbose verbosity) (when (>= comp-verbose verbosity)
(comp-log (format "\nFunction: %s\n" (comp-func-symbol-name func)) verbosity) (comp-log (format "\nFunction: %s\n" (comp-func-name func)) verbosity)
(cl-loop for block-name being each hash-keys of (comp-func-blocks func) (cl-loop for block-name being each hash-keys of (comp-func-blocks func)
using (hash-value bb) using (hash-value bb)
do (comp-log (concat "<" (symbol-name block-name) ">\n") verbosity) do (comp-log (concat "<" (symbol-name block-name) ">\n") verbosity)
@ -357,7 +357,7 @@ VERBOSITY is a number between 0 and 3."
(let ((edges (comp-func-edges func))) (let ((edges (comp-func-edges func)))
(when (> comp-verbose 2) (when (> comp-verbose 2)
(comp-log (format "\nEdges in function: %s\n" (comp-log (format "\nEdges in function: %s\n"
(comp-func-symbol-name func)) (comp-func-name func))
0)) 0))
(mapc (lambda (e) (mapc (lambda (e)
(when (> comp-verbose 2) (when (> comp-verbose 2)
@ -418,15 +418,13 @@ Put PREFIX in front of it."
(cl-defgeneric comp-spill-lap-function ((function-name symbol)) (cl-defgeneric comp-spill-lap-function ((function-name symbol))
"Byte compile FUNCTION-NAME spilling data from the byte compiler." "Byte compile FUNCTION-NAME spilling data from the byte compiler."
(let* ((f (symbol-function function-name)) (let* ((f (symbol-function function-name))
(func (make-comp-func :symbol-name function-name (func (make-comp-func :name function-name
:c-func-name (comp-c-func-name :c-name (comp-c-func-name function-name"F"))))
function-name
"F"))))
(when (byte-code-function-p f) (when (byte-code-function-p f)
(signal 'native-compiler-error (signal 'native-compiler-error
"can't native compile an already bytecompiled function")) "can't native compile an already bytecompiled function"))
(setf (comp-func-byte-func func) (setf (comp-func-byte-func func)
(byte-compile (comp-func-symbol-name func))) (byte-compile (comp-func-name func)))
(let ((lap (alist-get nil byte-to-native-lap))) (let ((lap (alist-get nil byte-to-native-lap)))
(cl-assert lap) (cl-assert lap)
(comp-log lap 1) (comp-log lap 1)
@ -454,12 +452,10 @@ Put PREFIX in front of it."
for doc = (when (>= (length data) 5) (aref data 4)) for doc = (when (>= (length data) 5) (aref data 4))
for lap = (alist-get name byte-to-native-lap) for lap = (alist-get name byte-to-native-lap)
for lambda-list = (aref data 0) for lambda-list = (aref data 0)
for func = (make-comp-func :symbol-name name for func = (make-comp-func :name name
:byte-func data :byte-func data
:doc doc :doc doc
:c-func-name (comp-c-func-name :c-name (comp-c-func-name name "F")
name
"F")
:args (comp-decrypt-lambda-list lambda-list) :args (comp-decrypt-lambda-list lambda-list)
:lap lap :lap lap
:frame-size (comp-byte-frame-size data)) :frame-size (comp-byte-frame-size data))
@ -1078,7 +1074,7 @@ the annotation emission."
(let* ((name (byte-to-native-function-name form)) (let* ((name (byte-to-native-function-name form))
(f (gethash name (comp-ctxt-funcs-h comp-ctxt))) (f (gethash name (comp-ctxt-funcs-h comp-ctxt)))
(args (comp-func-args f)) (args (comp-func-args f))
(c-name (comp-func-c-func-name f)) (c-name (comp-func-c-name f))
(doc (comp-func-doc f))) (doc (comp-func-doc f)))
(cl-assert (and name f)) (cl-assert (and name f))
(comp-emit (comp-call 'comp--register-subr (comp-emit (comp-call 'comp--register-subr
@ -1099,8 +1095,8 @@ the annotation emission."
(defun comp-limplify-top-level () (defun comp-limplify-top-level ()
"Create a limple function doing the business for top level forms. "Create a limple function doing the business for top level forms.
This will be called at load-time." This will be called at load-time."
(let* ((func (make-comp-func :symbol-name 'top-level-run (let* ((func (make-comp-func :name 'top-level-run
:c-func-name "top_level_run" :c-name "top_level_run"
:args (make-comp-args :min 0 :max 0) :args (make-comp-args :min 0 :max 0)
:frame-size 0)) :frame-size 0))
(comp-func func) (comp-func func)
@ -1163,7 +1159,7 @@ This will be called at load-time."
;; Prologue ;; Prologue
(comp-make-curr-block 'entry (comp-sp)) (comp-make-curr-block 'entry (comp-sp))
(comp-emit-annotation (concat "Lisp function: " (comp-emit-annotation (concat "Lisp function: "
(symbol-name (comp-func-symbol-name func)))) (symbol-name (comp-func-name func))))
(if (comp-args-p args) (if (comp-args-p args)
(cl-loop for i below (comp-args-max args) (cl-loop for i below (comp-args-max args)
do (cl-incf (comp-sp)) do (cl-incf (comp-sp))
@ -1188,7 +1184,7 @@ This will be called at load-time."
(defun comp-add-func-to-ctxt (func) (defun comp-add-func-to-ctxt (func)
"Add FUNC to the current compiler contex." "Add FUNC to the current compiler contex."
(puthash (comp-func-symbol-name func) (puthash (comp-func-name func)
func func
(comp-ctxt-funcs-h comp-ctxt))) (comp-ctxt-funcs-h comp-ctxt)))
@ -1243,7 +1239,7 @@ Top level forms for the current context are rendered too."
(signal 'native-ice (signal 'native-ice
(list "block does not end with a branch" (list "block does not end with a branch"
bb bb
(comp-func-symbol-name comp-func))))) (comp-func-name comp-func)))))
finally (setf (comp-func-edges comp-func) finally (setf (comp-func-edges comp-func)
(nreverse (comp-func-edges comp-func))) (nreverse (comp-func-edges comp-func)))
;; Update edge refs into blocks. ;; Update edge refs into blocks.
@ -1657,7 +1653,7 @@ Return t if something was changed."
(defun comp-call-optim-func () (defun comp-call-optim-func ()
"Perform the trampoline call optimization for the current function." "Perform the trampoline call optimization for the current function."
(cl-loop (cl-loop
with self = (comp-func-symbol-name comp-func) with self = (comp-func-name comp-func)
for b being each hash-value of (comp-func-blocks comp-func) for b being each hash-value of (comp-func-blocks comp-func)
do (cl-loop do (cl-loop
for insn-cell on (comp-block-insns b) for insn-cell on (comp-block-insns b)
@ -1717,7 +1713,7 @@ Return the list of m-var ids nuked."
;; exist and gets nuked. ;; exist and gets nuked.
(let ((nuke-list (cl-set-difference l-vals r-vals))) (let ((nuke-list (cl-set-difference l-vals r-vals)))
(comp-log (format "Function %s\nl-vals %s\nr-vals %s\nNuking ids: %s\n" (comp-log (format "Function %s\nl-vals %s\nr-vals %s\nNuking ids: %s\n"
(comp-func-symbol-name comp-func) (comp-func-name comp-func)
l-vals l-vals
r-vals r-vals
nuke-list) nuke-list)

8
src/comp.c
View file

@ -2739,7 +2739,7 @@ static void
declare_function (Lisp_Object func) declare_function (Lisp_Object func)
{ {
gcc_jit_function *gcc_func; gcc_jit_function *gcc_func;
char *c_name = SSDATA (CALL1I (comp-func-c-func-name, func)); char *c_name = SSDATA (CALL1I (comp-func-c-name, func));
Lisp_Object args = CALL1I (comp-func-args, func); Lisp_Object args = CALL1I (comp-func-args, func);
bool nargs = (CALL1I (comp-nargs-p, args)); bool nargs = (CALL1I (comp-nargs-p, args));
USE_SAFE_ALLOCA; USE_SAFE_ALLOCA;
@ -2784,7 +2784,7 @@ declare_function (Lisp_Object func)
c_name, 2, param, 0); c_name, 2, param, 0);
} }
Fputhash (CALL1I (comp-func-symbol-name, func), Fputhash (CALL1I (comp-func-name, func),
make_mint_ptr (gcc_func), make_mint_ptr (gcc_func),
comp.exported_funcs_h); comp.exported_funcs_h);
@ -2797,7 +2797,7 @@ compile_function (Lisp_Object func)
USE_SAFE_ALLOCA; USE_SAFE_ALLOCA;
EMACS_INT frame_size = XFIXNUM (CALL1I (comp-func-frame-size, func)); EMACS_INT frame_size = XFIXNUM (CALL1I (comp-func-frame-size, func));
comp.func = xmint_pointer (Fgethash (CALL1I (comp-func-symbol-name, func), comp.func = xmint_pointer (Fgethash (CALL1I (comp-func-name, func),
comp.exported_funcs_h, Qnil)); comp.exported_funcs_h, Qnil));
gcc_jit_lvalue *frame_array = gcc_jit_lvalue *frame_array =
@ -2883,7 +2883,7 @@ compile_function (Lisp_Object func)
if (err) if (err)
xsignal3 (Qnative_ice, xsignal3 (Qnative_ice,
build_string ("failing to compile function"), build_string ("failing to compile function"),
CALL1I (comp-func-symbol-name, func), CALL1I (comp-func-name, func),
build_string (err)); build_string (err));
SAFE_FREE (); SAFE_FREE ();