mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-20 18:17:20 +00:00
Code Issues Releases Activity

rework lap spilling

Browse Source
This commit is contained in:
Andrea Corallo 2019-09-21 17:18:57 +02:00
parent 82778374fe
commit 0a014a3862
2 changed files with 31 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lisp/emacs-lisp/bytecomp.el
View File

@ -565,8 +565,12 @@ Each element is (INDEX . VALUE)")
;; These are use by comp.el to spill data out of here
(defvar byte-native-compiling nil)
(defvar byte-to-native-last-lap nil)
(defvar byte-to-native-output nil)
(defvar byte-to-native-lap nil
"Alist to accumulate lap.
Each element is (NAME . LAP)")
(defvar byte-to-native-bytecode nil
"Alist to accumulate bytecode.
Each element is (NAME . BYTECODE)")
(defvar byte-to-native-top-level-forms nil)
@ -2273,8 +2277,9 @@ QUOTED says that we have to put a quote before the
list that represents a doc string reference.
`defvaralias', `autoload' and `custom-declare-variable' need that."
(when byte-native-compiling
;; Spill output for the native compiler here
(push (list name byte-to-native-last-lap (apply #'vector form)) byte-to-native-output))
;; Spill bytecode output for the native compiler here
(push (cons name (apply #'vector form))
byte-to-native-bytecode))
;; We need to examine byte-compile-dynamic-docstrings
;; in the input buffer (now current), not in the output buffer.
(let ((dynamic-docstrings byte-compile-dynamic-docstrings))
@ -2377,7 +2382,8 @@ list that represents a doc string reference.
(defun byte-compile-flush-pending ()
(if byte-compile-output
(let ((form (byte-compile-out-toplevel t 'file)))
(let* ((byte-compile-current-form nil)
(form (byte-compile-out-toplevel t 'file)))
(cond ((eq (car-safe form) 'progn)
(mapc 'byte-compile-output-file-form (cdr form)))
(form
@ -3128,8 +3134,10 @@ for symbols generated by the byte compiler itself."
(out (list 'byte-code (byte-compile-lapcode byte-compile-output)
byte-compile-vector byte-compile-maxdepth)))
(when byte-native-compiling
;; Spill output for the native compiler here
(setq byte-to-native-last-lap byte-compile-output))
;; Spill LAP for the native compiler here
(when byte-compile-current-form
(push (cons byte-compile-current-form byte-compile-output)
byte-to-native-lap)))
out))
;; it's a trivial function
((cdr body) (cons 'progn (nreverse body)))

26
lisp/emacs-lisp/comp.el
View File

@ -351,13 +351,15 @@ Put PREFIX in front of it."
(error "Can't native compile an already bytecompiled function"))
(setf (comp-func-byte-func func)
(byte-compile (comp-func-symbol-name func)))
(comp-log byte-to-native-last-lap)
(let ((lambda-list (aref (comp-func-byte-func func) 0)))
(setf (comp-func-args func)
(comp-decrypt-lambda-list lambda-list)))
(setf (comp-func-lap func) byte-to-native-last-lap)
(setf (comp-func-frame-size func) (aref (comp-func-byte-func func) 3))
func))
(let ((lap (cdr (assoc function-name (reverse byte-to-native-bytecode)))))
(cl-assert lap)
(comp-log lap)
(let ((lambda-list (aref (comp-func-byte-func func) 0)))
(setf (comp-func-args func)
(comp-decrypt-lambda-list lambda-list)))
(setf (comp-func-lap func) lap)
(setf (comp-func-frame-size func) (aref (comp-func-byte-func func) 3))
func)))
(defun comp-spill-lap-functions-file (filename)
"Byte compile FILENAME spilling data from the byte compiler."
@ -368,7 +370,11 @@ Put PREFIX in front of it."
('defvar (cdr x))
('defconst (cdr x))))
byte-to-native-top-level-forms)))
(cl-loop for (name lap bytecode) in byte-to-native-output
;; Hacky! We need to reverse `byte-to-native-lap' to have the compiled top
;; level form that matters (ex exclude lambdas)...
(cl-loop with lap-funcs = byte-to-native-lap
for (name . bytecode) in byte-to-native-bytecode
for lap = (cdr (assoc name lap-funcs))
for lambda-list = (aref bytecode 0)
for func = (make-comp-func :symbol-name name
:byte-func bytecode
@ -386,8 +392,8 @@ Put PREFIX in front of it."
If INPUT is a symbol this is the function-name to be compiled.
If INPUT is a string this is the file path to be compiled."
(let ((byte-native-compiling t)
(byte-to-native-last-lap nil)
(byte-to-native-output ())
(byte-to-native-lap ())
(byte-to-native-bytecode ())
(byte-to-native-top-level-forms ()))
(cl-typecase input
(symbol (list (comp-spill-lap-function input)))