generalize code into comp.el for compile multiple funcitons

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 04f19426f1b69da220e9a52042c5688ce82cca32..736f4f62235e5419c644f5ddc4de14e0ff7f2cda 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -3117,12 +3117,14 @@ for symbols generated by the byte compiler itself."
                       (not (delq nil (mapcar 'consp (cdr (car body))))))))
              (setq rest (cdr rest)))
            rest))
-      ;; Spill lap output here
-      (when byte-native-compiling
-        (push byte-compile-output byte-to-native-lap-output))
-      (let ((byte-compile-vector (byte-compile-constants-vector)))
-       (list 'byte-code (byte-compile-lapcode byte-compile-output)
-             byte-compile-vector byte-compile-maxdepth)))
+      (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 byte-native-compiling
+            ;; Spill output for the native compiler here
+          (push byte-compile-output byte-to-native-lap-output)
+          (push out byte-to-native-bytecode-output))
+        out))
      ;; it's a trivial function
      ((cdr body) (cons 'progn (nreverse body)))
      ((car body)))))

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 2e35cd31d66f893b8affe6a42e317ea23a9ebb0d..d7f6f606e885261d572fc474ab510c26ccae2ef9 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -251,22 +251,39 @@ Put PREFIX in front of it."
       (make-comp-nargs :min mandatory
                        :nonrest nonrest))))
 
-(defun comp-spill-lap (func)
-  "Byte compile and spill the LAP rapresentation for FUNC."
+(defun comp-spill-lap-function (function-name)
+  "Spill LAP for FUNCTION-NAME."
+  (let* ((f (symbol-function function-name))
+         (func (make-comp-func :symbol-name function-name
+                               :func f
+                               :c-func-name (comp-c-func-name
+                                             function-name
+                                             "F"))))
+      (when (byte-code-function-p f)
+        (error "Can't native compile an already bytecompiled function"))
+      (setf (comp-func-byte-func func)
+            (byte-compile (comp-func-symbol-name func)))
+      (comp-within-log-buff
+        (cl-prettyprint byte-to-native-lap-output))
+      (let ((lambda-list (aref (comp-func-byte-func func) 0)))
+        (if (fixnump lambda-list)
+            (setf (comp-func-args func)
+                  (comp-decrypt-lambda-list lambda-list))
+          (error "Can't native compile a non lexical scoped function")))
+      (setf (comp-func-lap func) (car byte-to-native-lap-output))
+      (setf (comp-func-frame-size func) (aref (comp-func-byte-func func) 3))
+      func))
+
+(defun comp-spill-lap (input)
+  "Byte compile and spill the LAP rapresentation 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-output ()))
-    (setf (comp-func-byte-func func)
-          (byte-compile (comp-func-symbol-name func)))
-    (comp-within-log-buff
-      (cl-prettyprint byte-to-native-lap-output))
-    (let ((lambda-list (aref (comp-func-byte-func func) 0)))
-      (if (fixnump lambda-list)
-          (setf (comp-func-args func)
-                (comp-decrypt-lambda-list lambda-list))
-        (error "Can't native compile a non lexical scoped function")))
-    (setf (comp-func-lap func) (car byte-to-native-lap-output))
-    (setf (comp-func-frame-size func) (aref (comp-func-byte-func func) 3))
-    func))
+    (cl-typecase input
+      (symbol (list (comp-spill-lap-function input)))
+      (string (error "To be implemented"))
+      (otherwise (error "Trying to native compile something not a function or file")))))
 
 \f
 ;;; Limplification pass specific code.
@@ -806,36 +823,38 @@ the annotation emission."
   (comp-emit-block 'entry_rest_args)
   (comp-emit `(set-rest-args-to-local ,nonrest)))
 
-(defun comp-limplify (func)
-  "Given FUNC compute its LIMPLE ir."
-  (let* ((frame-size (comp-func-frame-size func))
-         (comp-func func)
-         (comp-pass (make-comp-limplify
-                     :sp -1
-                     :frame (comp-new-frame frame-size)))
-         (args (comp-func-args func))
-         (args-min (comp-args-base-min args))
-         (comp-block ()))
-    ;; Prologue
-    (comp-emit-block 'entry)
-    (comp-emit-annotation (concat "Lisp function: "
-                                  (symbol-name (comp-func-symbol-name func))))
-    (if (comp-args-p args)
-      (cl-loop for i below (comp-args-max args)
-               do (cl-incf (comp-sp))
-               do (comp-emit `(set-par-to-local ,(comp-slot) ,i)))
-      (let ((nonrest (comp-nargs-nonrest args)))
-        (comp-emit-narg-prologue args-min nonrest)
-        (cl-incf (comp-sp) (1+ nonrest))))
-    ;; Body
-    (comp-emit-block 'bb_1)
-    (mapc #'comp-limplify-lap-inst (comp-func-lap func))
-    ;; Reverse insns into all basic blocks.
-    (cl-loop for bb being the hash-value in (comp-func-blocks func)
-             do (setf (comp-block-insns bb)
-                      (nreverse (comp-block-insns bb))))
-    (comp-log-func func)
-    func))
+(defun comp-limplify (funcs)
+  "Given FUNCS compute their LIMPLE ir."
+  (mapcar (lambda (func)
+            (let* ((frame-size (comp-func-frame-size func))
+                   (comp-func func)
+                   (comp-pass (make-comp-limplify
+                               :sp -1
+                               :frame (comp-new-frame frame-size)))
+                   (args (comp-func-args func))
+                   (args-min (comp-args-base-min args))
+                   (comp-block ()))
+              ;; Prologue
+              (comp-emit-block 'entry)
+              (comp-emit-annotation (concat "Lisp function: "
+                                            (symbol-name (comp-func-symbol-name func))))
+              (if (comp-args-p args)
+                  (cl-loop for i below (comp-args-max args)
+                           do (cl-incf (comp-sp))
+                           do (comp-emit `(set-par-to-local ,(comp-slot) ,i)))
+                (let ((nonrest (comp-nargs-nonrest args)))
+                  (comp-emit-narg-prologue args-min nonrest)
+                  (cl-incf (comp-sp) (1+ nonrest))))
+              ;; Body
+              (comp-emit-block 'bb_1)
+              (mapc #'comp-limplify-lap-inst (comp-func-lap func))
+              ;; Reverse insns into all basic blocks.
+              (cl-loop for bb being the hash-value in (comp-func-blocks func)
+                       do (setf (comp-block-insns bb)
+                                (nreverse (comp-block-insns bb))))
+              (comp-log-func func)
+              func))
+          funcs))
 
 \f
 ;;; C function wrappers
@@ -871,29 +890,25 @@ the annotation emission."
 \f
 ;;; Entry points.
 
-(defun native-compile (func-symbol-name)
-  "FUNC-SYMBOL-NAME is the function name to be compiled into native code."
-  (if-let ((f (symbol-function func-symbol-name)))
-      (progn
-        (when (byte-code-function-p f)
-          (error "Can't native compile an already bytecompiled function"))
-        (let ((func (make-comp-func :symbol-name func-symbol-name
-                                    :func f
-                                    :c-func-name (comp-c-func-name
-                                                  func-symbol-name
-                                                  "F")))
-              (comp-ctxt (make-comp-ctxt)))
-          (mapc (lambda (pass)
-                  (funcall pass func))
-                comp-passes)
-          ;; Once we have the final LIMPLE we jump into C.
-          (comp--init-ctxt)
-          (unwind-protect
-              (progn
-                (comp-add-func-to-ctxt func)
-                (comp-compile-ctxt-to-file (symbol-name func-symbol-name)))
-            (comp--release-ctxt))))
-    (error "Trying to native compile something not a function")))
+(defun native-compile (input)
+  "Compile INPUT into native code.
+This is the entrypoint for the Emacs Lisp native compiler.
+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 ((data input)
+        (comp-ctxt (make-comp-ctxt)))
+    (mapc (lambda (pass)
+            (setq data (funcall pass data)))
+          comp-passes)
+    ;; Once we have the final LIMPLE we jump into C.
+    (comp--init-ctxt)
+    (unwind-protect
+        (progn
+          (mapc #'comp-add-func-to-ctxt data)
+          (comp-compile-ctxt-to-file (if (symbolp input)
+                                         (symbol-name input)
+                                       (file-name-sans-extension input))))
+      (comp--release-ctxt))))
 
 (provide 'comp)