diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 77cd408ce97..1666dff7117 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -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))) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 1ca086659aa..e1e0858985b 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -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)))