rework lap spilling

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 77cd408ce978eb448b96315f3d048c31ee80f317..1666dff711759db42b24e92f72d55be1dd19d868 100644 (file)
--- 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)
 
 \f
@@ -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 1ca086659aa33589839ec02bfe467f57d1c20d2e..e1e0858985be1684bb65f4e89f0c479e6de77167 100644 (file)
--- 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)))