feature/native-comp f8b254d 1/2: Rework spill LAP mechanism in preparation of compiling lambdas.

[Andrea Corallo]

branch: feature/native-comp
commit f8b254d1957a86645bfcc6ce452d97b9286910a2
Author: Andrea Corallo <address@hidden>
Commit: Andrea Corallo <address@hidden>

    Rework spill LAP mechanism in preparation of compiling lambdas.
    
        * lisp/emacs-lisp/comp.el (comp-spill-lap-function): No need anymore
        to have `byte-native-compiling' bound to free-func.
        (comp-spill-lap-function): Make use of `byte-to-native-lap-h' and
        clean-up.
        (comp-spill-lap-function): Likewise.
    
        * lisp/emacs-lisp/bytecomp.el (byte-to-native-function): Add lap slot.
        (byte-to-native-lap): Rename into byte-to-native-lap-h.
        (byte-compile-lapcode): Spill lap after having int assembled and
        store it into `byte-to-native-lap-h'.
        (byte-compile-not-top-level): Remove.
        (byte-compile-file-form-defmumble): Fill directly lap slot.
        (byte-compile-lambda): Remove `byte-compile-not-top-level'.
        (byte-compile-out-toplevel): Restore original code.
        (byte-compile-form): Remove `byte-compile-not-top-level'.
        (byte-compile-function-form): Likewise.
        (byte-compile-flush-pending): No need anymore to set
        `byte-compile-current-form' so restore orignal code.
---
 lisp/emacs-lisp/bytecomp.el | 43 ++++++++++++++++++-------------------------
 lisp/emacs-lisp/comp.el     | 19 ++++++-------------
 2 files changed, 24 insertions(+), 38 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 9a5491b..8f85c92 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -565,7 +565,7 @@ Each element is (INDEX . VALUE)")
 ;; These are use by comp.el to spill data out of here
 (cl-defstruct byte-to-native-function
   "Named or anonymous function defined a top level."
-              name c-name data)
+              name c-name data lap)
 (cl-defstruct byte-to-native-top-level
   "All other top level forms."
               form)
@@ -577,9 +577,8 @@ Each element is (INDEX . VALUE)")
   ;; Because the make target is the later this has to be produced as
   ;; last to be resilient against build interruptions.
 )
-(defvar byte-to-native-lap nil
-  "A-list to accumulate LAP.
-Each pair is (NAME . LAP)")
+(defvar byte-to-native-lap-h nil
+  "Hash byte-code -> LAP.")
 (defvar byte-to-native-top-level-forms nil
   "List of top level forms.")
 (defvar byte-to-native-output-file nil
@@ -977,7 +976,11 @@ CONST2 may be evaluated multiple times."
                    ;; it within 2 bytes in the byte string).
                    (puthash value pc hash-table))
                hash-table))
-    (apply 'unibyte-string (nreverse bytes))))
+    (let ((bytecode (apply 'unibyte-string (nreverse bytes))))
+      (when byte-native-compiling
+        ;; Spill LAP for the native compiler here
+        (puthash bytecode lap byte-to-native-lap-h))
+      bytecode)))
 
 
 ;;; compile-time evaluation
@@ -1094,8 +1097,6 @@ message buffer `default-directory'."
 (defvar byte-compile-current-file nil)
 (defvar byte-compile-current-group nil)
 (defvar byte-compile-current-buffer nil)
-(defvar byte-compile-not-top-level nil ; We'll evolve this for naming lambdas
-  "Non nil if compiling something that is not top-level.")
 
 ;; Log something that isn't a warning.
 (defmacro byte-compile-log (format-string &rest args)
@@ -2363,8 +2364,7 @@ list that represents a doc string reference.
 
 (defun byte-compile-flush-pending ()
   (if byte-compile-output
-      (let* ((byte-compile-current-form nil)
-             (form (byte-compile-out-toplevel t 'file)))
+      (let ((form (byte-compile-out-toplevel t 'file)))
        (cond ((eq (car-safe form) 'progn)
               (mapc 'byte-compile-output-file-form (cdr form)))
              (form
@@ -2689,7 +2689,10 @@ not to take responsibility for the actual compilation of 
the code."
               (push (if macro
                         (make-byte-to-native-top-level
                          :form `(defalias ',name '(macro . ,code) nil))
-                      (make-byte-to-native-function :name name :data code))
+                      (make-byte-to-native-function :name name
+                                                    :data code
+                                                    :lap (gethash (aref code 1)
+                                                                  
byte-to-native-lap-h)))
                     byte-to-native-top-level-forms))
             ;; Output the form by hand, that's much simpler than having
             ;; b-c-output-file-form analyze the defalias.
@@ -2918,7 +2921,6 @@ for symbols generated by the byte compiler itself."
             ;; args of `list'.  Actually, compile it to get warnings,
             ;; but don't use the result.
             (let* ((form (nth 1 int))
-                    (byte-compile-not-top-level t)
                     (newform (byte-compile-top-level form)))
               (while (memq (car-safe form) '(let let* progn save-excursion))
                 (while (consp (cdr form))
@@ -3116,16 +3118,9 @@ for symbols generated by the byte compiler itself."
                       (not (delq nil (mapcar 'consp (cdr (car body))))))))
              (setq rest (cdr rest)))
            rest))
-      (let* ((byte-compile-vector (byte-compile-constants-vector))
-             (out (list 'byte-code (byte-compile-lapcode byte-compile-output)
-                       byte-compile-vector byte-compile-maxdepth)))
-        (when (and byte-native-compiling
-                   (or (null byte-compile-not-top-level)
-                       (eq byte-native-compiling 'free-func)))
-          ;; Spill LAP for the native compiler here
-          (push (cons byte-compile-current-form byte-compile-output)
-                byte-to-native-lap))
-        out))
+      (let ((byte-compile-vector (byte-compile-constants-vector)))
+       (list 'byte-code (byte-compile-lapcode byte-compile-output)
+             byte-compile-vector byte-compile-maxdepth)))
      ;; it's a trivial function
      ((cdr body) (cons 'progn (nreverse body)))
      ((car body)))))
@@ -3175,8 +3170,7 @@ for symbols generated by the byte compiler itself."
 ;; byte-compile--for-effect flag too.)
 ;;
 (defun byte-compile-form (form &optional for-effect)
-  (let ((byte-compile--for-effect for-effect)
-        (byte-compile-not-top-level t))
+  (let ((byte-compile--for-effect for-effect))
     (cond
      ((not (consp form))
       (cond ((or (not (symbolp form)) (macroexp--const-symbol-p form))
@@ -3950,8 +3944,7 @@ discarding."
 ;; and (funcall (function foo)) will lose with autoloads.
 
 (defun byte-compile-function-form (form)
-  (let ((f (nth 1 form))
-        (byte-compile-not-top-level t))
+  (let ((f (nth 1 form)))
     (when (and (symbolp f)
                (byte-compile-warning-enabled-p 'callargs f))
       (byte-compile-function-warn f t (byte-compile-fdefinition f nil)))
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index f8e30f0..1dbafbe 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -523,8 +523,7 @@ Put PREFIX in front of it."
 
 (cl-defgeneric comp-spill-lap-function ((function-name symbol))
   "Byte compile FUNCTION-NAME spilling data from the byte compiler."
-  (let* ((byte-native-compiling 'free-func)
-         (f (symbol-function function-name))
+  (let* ((f (symbol-function function-name))
          (c-name (comp-c-func-name function-name "F"))
          (func (make-comp-func :name function-name
                                :c-name c-name
@@ -535,7 +534,8 @@ Put PREFIX in front of it."
                 "can't native compile an already bytecompiled function"))
       (setf (comp-func-byte-func func)
             (byte-compile (comp-func-name func)))
-      (let ((lap (alist-get nil byte-to-native-lap)))
+      (let ((lap (gethash (aref (comp-func-byte-func func) 1)
+                          byte-to-native-lap-h)))
         (cl-assert lap)
         (comp-log lap 2)
         (let ((arg-list (aref (comp-func-byte-func func) 0)))
@@ -559,9 +559,7 @@ Put PREFIX in front of it."
     (signal 'native-compiler-error-empty-byte filename))
   (setf (comp-ctxt-top-level-forms comp-ctxt)
         (reverse byte-to-native-top-level-forms))
-  (comp-log byte-to-native-lap 3)
   (cl-loop
-   with lap-forms = (reverse byte-to-native-lap)
    ;; All non anonymous functions.
    for f in (cl-loop for x in (comp-ctxt-top-level-forms comp-ctxt)
                      when (and (byte-to-native-function-p x)
@@ -569,8 +567,6 @@ Put PREFIX in front of it."
                        collect x)
    for name = (byte-to-native-function-name f)
    for c-name = (comp-c-func-name name "F")
-   for lap-entry = (assoc name lap-forms)
-   for lap = (cdr lap-entry)
    for data = (byte-to-native-function-data f)
    for func = (make-comp-func :name name
                               :byte-func data
@@ -578,12 +574,9 @@ Put PREFIX in front of it."
                               :int-spec (interactive-form data)
                               :c-name c-name
                               :args (comp-decrypt-arg-list (aref data 0) name)
-                              :lap lap
+                              :lap (byte-to-native-function-lap f)
                               :frame-size (comp-byte-frame-size data))
    do
-   ;; Remove it form the original lap list to avoid multiple function
-   ;; definition with the same name shadowing each other.
-   (setf lap-forms (delete lap-entry lap-forms))
    ;; Store the c-name to have it retrivable from
    ;; comp-ctxt-top-level-forms.
    (setf (byte-to-native-function-c-name f) c-name)
@@ -591,14 +584,14 @@ Put PREFIX in front of it."
    (puthash 0 (comp-func-frame-size func) (comp-func-array-h func))
    (comp-add-func-to-ctxt func)
    (comp-log (format "Function %s:\n" name) 1)
-   (comp-log lap 1)))
+   (comp-log (byte-to-native-function-lap f) 1)))
 
 (defun comp-spill-lap (input)
   "Byte compile and spill the LAP representation for INPUT.
 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-lap ())
+        (byte-to-native-lap-h (make-hash-table :test #'eq))
         (byte-to-native-top-level-forms ()))
     (comp-spill-lap-function input)))