initial top level support (defvar working)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index ec7b036a67714bc69e3066f4abe86d7bf3b1b521..3d4b76b988b5887c0d526b9266232cfc5b364f97 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -568,6 +568,7 @@ Each element is (INDEX . VALUE)")
 (defvar byte-to-native-names nil)
 (defvar byte-to-native-lap-output nil)
 (defvar byte-to-native-bytecode-output nil)
+(defvar byte-to-native-top-level-forms nil)
 
 \f
 ;;; The byte codes; this information is duplicated in bytecomp.c
@@ -2491,6 +2492,9 @@ list that represents a doc string reference.
            (setq form (copy-sequence form))
            (setcar (cdr (cdr form))
                    (byte-compile-top-level (nth 2 form) nil 'file))))
+    (when byte-native-compiling
+      ;; Spill output for the native compiler here
+      (push form byte-to-native-top-level-forms))
     form))
 
 (put 'define-abbrev-table 'byte-hunk-handler

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 1a426560ba56998f4a28383a901b06a5e5c98a96..3ea500416de0587f761045313c9afad34cede832 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -80,8 +80,10 @@
 
 (cl-defstruct comp-ctxt
   "Lisp side of the compiler context."
-  (output nil :'string
+  (output nil :type 'string
           :documentation "Target output filename for the compilation.")
+  (top-level-defvars nil :type list
+                   :documentation "List of top level form to be compiled.")
   (funcs () :type list
          :documentation "Exported functions list.")
   (funcs-h (make-hash-table) :type hash-table
@@ -160,7 +162,7 @@ LIMPLE basic block.")
         :documentation "When non nil is used for type propagation."))
 
 (cl-defstruct (comp-limplify (:copier nil))
-  "Support structure used during limplification."
+  "Support structure used during function limplification."
   (sp 0 :type fixnum
       :documentation "Current stack pointer while walking LAP.")
   (frame nil :type vector
@@ -282,6 +284,12 @@ Put PREFIX in front of it."
   (cl-assert (= (length byte-to-native-names)
                 (length byte-to-native-lap-output)
                 (length byte-to-native-bytecode-output)))
+  (setf (comp-ctxt-top-level-defvars comp-ctxt)
+        (mapcar (lambda (x)
+                  (if (eq (car x) 'defvar)
+                      (cdr x)
+                    (cl-assert nil)))
+                byte-to-native-top-level-forms))
   (cl-loop for function-name in byte-to-native-names
            for lap in byte-to-native-lap-output
            for bytecode in byte-to-native-bytecode-output
@@ -305,7 +313,8 @@ If INPUT is a string this is the file path to be compiled."
   (let ((byte-native-compiling t)
         (byte-to-native-names ())
         (byte-to-native-lap-output ())
-        (byte-to-native-bytecode-output ()))
+        (byte-to-native-bytecode-output ())
+        (byte-to-native-top-level-forms ()))
     (cl-typecase input
       (symbol (list (comp-spill-lap-function input)))
       (string (comp-spill-lap-functions-file input)))))
@@ -848,38 +857,64 @@ the annotation emission."
   (comp-emit-block 'entry_rest_args)
   (comp-emit `(set-rest-args-to-local ,nonrest)))
 
+(defun comp-limplify-finalize-function (func)
+  "Reverse insns into all basic blocks of FUNC."
+  (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-top-level ()
+  "Create a limple function doing the business for top level forms.
+This will be called at runtime."
+  (let* ((func (make-comp-func :symbol-name 'top-level-run
+                  :c-func-name "top_level_run"
+                  :args (make-comp-args :min 0 :max 0)
+                  :frame-size 0))
+         (comp-func func)
+         (comp-pass (make-comp-limplify
+                     :sp -1
+                     :frame (comp-new-frame 0)))
+         (comp-block ()))
+    (comp-emit-block 'entry)
+    (comp-emit-annotation "Top level")
+    (cl-loop for args in (comp-ctxt-top-level-defvars comp-ctxt)
+             do (comp-emit (comp-call 'defvar (make-comp-mvar :constant args))))
+    (comp-emit `(return ,(make-comp-mvar :constant nil)))
+    (comp-limplify-finalize-function func)))
+
+(defun comp-limplify-function (func)
+  "Limplify a single function 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))
+    (comp-limplify-finalize-function 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))
+  "Compute the LIMPLE ir for FUNCS.
+Top level forms for the current context are rendered too."
+  (cons (comp-limplify-top-level)
+        (mapcar #'comp-limplify-function funcs)))
 
 \f
 ;;; Final pass specific code.

diff --git a/src/comp.c b/src/comp.c
index 07c779369c80d0d6448235ef61433ddc72343168..00e156019989a6c9d3e2cba9e1cf0558e4a5dc11 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -304,6 +304,12 @@ declare_imported_func (Lisp_Object subr_sym, gcc_jit_type *ret_type,
       types[0] = comp.ptrdiff_type;
       types[1] = comp.lisp_obj_ptr_type;
     }
+  if (nargs == UNEVALLED)
+    {
+      nargs = 1;
+      types = alloca (nargs * sizeof (* types));
+      types[0] = comp.lisp_obj_type;
+    }
   else if (!types)
     {
       types = alloca (nargs * sizeof (* types));
@@ -1718,7 +1724,7 @@ emit_ctxt_code (void)
   FOR_EACH_TAIL (f_runtime)
     {
       Lisp_Object el = XCAR (f_runtime);
-      fields[n_frelocs++] = xmint_pointer( XCDR (el));
+      fields[n_frelocs++] = xmint_pointer (XCDR (el));
       f_reloc_list = Fcons (XCAR (el), f_reloc_list);
     }
 
@@ -1732,10 +1738,12 @@ emit_ctxt_code (void)
          Lisp_Object maxarg = XCDR (Fsubr_arity (subr));
          gcc_jit_field *field =
            declare_imported_func (subr_sym, comp.lisp_obj_type,
-                                  FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY, NULL);
+                                  FIXNUMP (maxarg) ? XFIXNUM (maxarg) :
+                                  EQ (maxarg, Qmany) ? MANY : UNEVALLED,
+                                  NULL);
          fields [n_frelocs++] = field;
          f_reloc_list = Fcons (subr_sym, f_reloc_list);
-      }
+       }
     }
 
   Lisp_Object f_reloc_vec = make_vector (n_frelocs, Qnil);
@@ -3173,6 +3181,10 @@ load_comp_unit (dynlib_handle_ptr handle)
       func_list = XCDR (func_list);
     }
 
+  /* Finally execute top level forms.  */
+  void (*top_level_run)(void) = dynlib_sym (handle, "top_level_run");
+  top_level_run ();
+
   return 0;
 }