rework top level environment modification mechanism

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index a56b22225a6fe1644e6ac86cf68cebfdb377c56f..381d72e3dc388c81126ecb7dc84f9e3592a6aa66 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -118,8 +118,6 @@ Can be used by code that wants to expand differently in this case.")
           :documentation "Target output filename for the compilation.")
   (top-level-forms () :type list
                    :documentation "List of spilled top level forms.")
-  (exp-funcs () :type list
-             :documentation "Exported functions list.")
   (funcs-h (make-hash-table) :type hash-table
            :documentation "lisp-func-name -> comp-func.
 This is to build the prev field.")
@@ -1029,6 +1027,35 @@ the annotation emission."
     (comp-log-func func))
   func)
 
+(cl-defgeneric comp-emit-for-top-level (form)
+  "Emit the limple code for top level FORM.")
+
+(cl-defmethod comp-emit-for-top-level ((form byte-to-native-function))
+  (let* ((name (byte-to-native-function-name form))
+         (f (gethash name (comp-ctxt-funcs-h comp-ctxt)))
+         (args (comp-func-args f))
+         (c-name (comp-func-c-func-name f))
+         (doc (comp-func-doc f)))
+    (cl-assert (and name f))
+    (comp-emit (comp-call 'comp--register-subr
+                          (make-comp-mvar :constant name)
+                          (make-comp-mvar :constant (comp-args-base-min args))
+                          (make-comp-mvar :constant (if (comp-args-p args)
+                                                        (comp-args-max args)
+                                                      'many))
+                          (make-comp-mvar :constant c-name)
+                          (make-comp-mvar :constant doc)))))
+
+(cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level))
+  (let* ((form (byte-to-native-top-level-form form))
+         (func-name (car form))
+         (args (cdr form)))
+    (if (eq 'unevalled (cdr (subr-arity (symbol-function func-name))))
+        (comp-emit (comp-call func-name (make-comp-mvar :constant args)))
+      (comp-emit (apply #'comp-call func-name
+                        (mapcar (lambda (x) (make-comp-mvar :constant x))
+                                args))))))
+
 (defun comp-limplify-top-level ()
   "Create a limple function doing the business for top level forms.
 This will be called at load-time."
@@ -1042,9 +1069,8 @@ This will be called at load-time."
                      :frame (comp-new-frame 0))))
     (comp-make-curr-block 'entry (comp-sp))
     (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)))
+    (mapc #'comp-emit-for-top-level (comp-ctxt-top-level-forms comp-ctxt))
+    (comp-emit `(return ,(make-comp-mvar :constant t)))
     (comp-limplify-finalize-function func)))
 
 (defun comp-addr-to-bb-name (addr)
@@ -1659,19 +1685,6 @@ These are substituted with normals 'set'."
 Prepare every function for final compilation and drive the C back-end."
   (cl-assert (= (length (comp-ctxt-data-relocs-l comp-ctxt))
                 (hash-table-count (comp-ctxt-data-relocs-idx comp-ctxt))))
-  (setf (comp-ctxt-exp-funcs comp-ctxt)
-        (cl-loop with h = (comp-ctxt-funcs-h comp-ctxt)
-                 for f being each hash-value of h
-                 for args = (comp-func-args f)
-                 for doc = (when (> (length (comp-func-byte-func f)) 4)
-                             (aref (comp-func-byte-func f) 4))
-                 collect (vector (comp-func-symbol-name f)
-                                 (comp-func-c-func-name f)
-                                 (cons (comp-args-base-min args)
-                                       (if (comp-args-p args)
-                                           (comp-args-max args)
-                                         'many))
-                                 doc)))
   (comp--compile-ctxt-to-file name))
 
 (defun comp-final (_)

diff --git a/src/comp.c b/src/comp.c
index fed599dc511c148241a3aa089175c08493784dbe..ba56cc1ab1952172fccffac722ff22ea8c7091ac 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -41,7 +41,6 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #define DATA_RELOC_SYM "d_reloc"
 #define IMPORTED_FUNC_RELOC_SYM "f_reloc"
 #define TEXT_DATA_RELOC_SYM "text_data_reloc"
-#define TEXT_EXPORTED_FUNC_RELOC_SYM "text_exported_funcs"
 #define TEXT_IMPORTED_FUNC_RELOC_SYM "text_imported_funcs"
 
 #define STR_VALUE(s) #s
@@ -1802,9 +1801,6 @@ emit_ctxt_code (void)
       gcc_jit_struct_as_type (f_reloc_struct),
       IMPORTED_FUNC_RELOC_SYM);
 
-  /* Exported functions info.  */
-  Lisp_Object func_list = FUNCALL1 (comp-ctxt-exp-funcs, Vcomp_ctxt);
-  emit_static_object (TEXT_EXPORTED_FUNC_RELOC_SYM, func_list);
   SAFE_FREE ();
 }
 
@@ -3127,6 +3123,7 @@ helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code)
 /**************************************/
 
 static Lisp_Object Vnative_elisp_refs_hash;
+dynlib_handle_ptr load_handle;
 
 static void
 prevent_gc (Lisp_Object obj)
@@ -3150,9 +3147,9 @@ static int
 load_comp_unit (dynlib_handle_ptr handle)
 {
   /* Imported data.  */
-  Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM);
+  Lisp_Object *data_relocs = dynlib_sym (load_handle, DATA_RELOC_SYM);
 
-  Lisp_Object d_vec = load_static_obj (handle, TEXT_DATA_RELOC_SYM);
+  Lisp_Object d_vec = load_static_obj (load_handle, TEXT_DATA_RELOC_SYM);
   EMACS_UINT d_vec_len = XFIXNUM (Flength (d_vec));
 
   for (EMACS_UINT i = 0; i < d_vec_len; i++)
@@ -3163,11 +3160,11 @@ load_comp_unit (dynlib_handle_ptr handle)
 
   /* Imported functions.  */
   Lisp_Object (**f_relocs)(void) =
-    dynlib_sym (handle, IMPORTED_FUNC_RELOC_SYM);
+    dynlib_sym (load_handle, IMPORTED_FUNC_RELOC_SYM);
   Lisp_Object f_vec =
-    load_static_obj (handle, TEXT_IMPORTED_FUNC_RELOC_SYM);
+    load_static_obj (load_handle, TEXT_IMPORTED_FUNC_RELOC_SYM);
   EMACS_UINT f_vec_len = XFIXNUM (Flength (f_vec));
-    for (EMACS_UINT i = 0; i < f_vec_len; i++)
+  for (EMACS_UINT i = 0; i < f_vec_len; i++)
     {
       Lisp_Object f_sym = AREF (f_vec, i);
       char *f_str = SSDATA (SYMBOL_NAME (f_sym));
@@ -3215,53 +3212,52 @@ load_comp_unit (dynlib_handle_ptr handle)
        }
     }
 
-  /* Exported functions.  */
-  Lisp_Object func_list = load_static_obj (handle, TEXT_EXPORTED_FUNC_RELOC_SYM);
-
-  while (func_list)
-    {
-      Lisp_Object el = XCAR (func_list);
-      Lisp_Object Qsym = AREF (el, 0);
-      char *c_func_name = SSDATA (AREF (el, 1));
-      Lisp_Object args = AREF (el, 2);
-      ptrdiff_t minargs = XFIXNUM (XCAR (args));
-      ptrdiff_t maxargs = FIXNUMP (XCDR (args)) ? XFIXNUM (XCDR (args)) : MANY;
-      /* char *doc = SSDATA (AREF (el, 3)); */
-      void *func = dynlib_sym (handle, c_func_name);
-      eassert (func);
-
-      union Aligned_Lisp_Subr *x = xmalloc (sizeof (union Aligned_Lisp_Subr));
-      x->s.header.size = PVEC_SUBR << PSEUDOVECTOR_AREA_BITS;
-      x->s.function.a0 = func;
-      x->s.min_args = minargs;
-      x->s.max_args = maxargs;
-      x->s.symbol_name = SSDATA (Fsymbol_name (Qsym));
-      x->s.native_elisp = true;
-      defsubr(x);
-
-      func_list = XCDR (func_list);
-    }
-
-  /* Finally execute top level forms.  */
-  void (*top_level_run)(void) = dynlib_sym (handle, "top_level_run");
+  /* Executing this will perform all the expected environment modification.  */
+  void (*top_level_run)(void) = dynlib_sym (load_handle, "top_level_run");
   top_level_run ();
 
   return 0;
 }
 
+DEFUN ("comp--register-subr", Fcomp__register_subr,
+       Scomp__register_subr,
+       5, 5, 0,
+       doc: /* This gets called by top_level_run during load phase to register
+              each exported subr.  */)
+     (Lisp_Object name, Lisp_Object minarg, Lisp_Object maxarg,
+      Lisp_Object c_name, Lisp_Object doc)
+{
+  if (!load_handle)
+    error ("comp--register-subr can only be called during native code load phase.");
+
+  void *func = dynlib_sym (load_handle, SSDATA (c_name));
+  eassert (func);
+
+  union Aligned_Lisp_Subr *x = xmalloc (sizeof (union Aligned_Lisp_Subr));
+  x->s.header.size = PVEC_SUBR << PSEUDOVECTOR_AREA_BITS;
+  x->s.function.a0 = func;
+  x->s.min_args = XFIXNUM (minarg);
+  x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY;
+  x->s.symbol_name = SSDATA (Fsymbol_name (name));
+  x->s.native_elisp = true;
+  defsubr(x);
+
+  return Qnil;
+}
+
 /* Load related routines. */
 DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 1, 0,
        doc: /* Load native elisp code FILE.  */)
   (Lisp_Object file)
 {
-  dynlib_handle_ptr handle;
-
   CHECK_STRING (file);
-  handle = dynlib_open (SSDATA (file));
-  if (!handle)
+  load_handle = dynlib_open (SSDATA (file));
+  if (!load_handle)
     xsignal2 (Qcomp_unit_open_failed, file, build_string (dynlib_error ()));
 
-  int r = load_comp_unit (handle);
+  int r = load_comp_unit (load_handle);
+
+  load_handle = NULL;
 
   if (r != 0)
     xsignal2 (Qcomp_unit_init_failed, file, INT_TO_INTEGER (r));
@@ -3332,6 +3328,7 @@ syms_of_comp (void)
   defsubr (&Scomp__init_ctxt);
   defsubr (&Scomp__release_ctxt);
   defsubr (&Scomp__compile_ctxt_to_file);
+  defsubr (&Scomp__register_subr);
   defsubr (&Snative_elisp_load);
 
   staticpro (&comp.exported_funcs_h);