basic reload almost working

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 486a7068be5f44ce7ed0f916dbe7cb949a3f13c4..a453acc329ce3c2bb7b017cdc1420c12e4f8a7f7 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -253,7 +253,7 @@ BODY is evaluate only if `comp-debug' is non nil."
     (let ((lambda-list (aref (comp-func-byte-func func) 0)))
       (if (fixnump lambda-list)
           (setf (comp-func-args func)
-                (comp-decrypt-lambda-list (aref (comp-func-byte-func func) 0)))
+                (comp-decrypt-lambda-list lambda-list))
         (error "Can't native compile a non lexical scoped function")))
     (setf (comp-func-lap func) byte-compile-lap-output)
     (setf (comp-func-frame-size func) (aref (comp-func-byte-func func) 3))
@@ -831,19 +831,26 @@ the annotation emission."
   (cl-assert (= (length (comp-ctxt-data-relocs-l comp-ctxt))
                 (hash-table-count (comp-ctxt-data-relocs-idx comp-ctxt))))
   (setf (comp-ctxt-data-relocs comp-ctxt)
-        (prin1-to-string  (vconcat (reverse (comp-ctxt-data-relocs-l comp-ctxt)))))
+        (prin1-to-string (vconcat (reverse (comp-ctxt-data-relocs-l comp-ctxt)))))
   (setf (comp-ctxt-funcs comp-ctxt)
-        (cl-loop with h = (comp-ctxt-funcs-h comp-ctxt)
-                 for f being each hash-keys of h
-                 using (hash-value c-f)
-                 collect (cons (symbol-name f) c-f)))
+        (prin1-to-string (cl-loop with h = (comp-ctxt-funcs-h comp-ctxt)
+                                  for f being each hash-value of h
+                                  collect f)))
   (comp--compile-ctxt-to-file name))
 
 (defun comp-add-func-to-ctxt (func)
   "Add FUNC to the current compiler contex."
-  (puthash (comp-func-symbol-name func)
-           (comp-func-c-func-name func)
-           (comp-ctxt-funcs-h comp-ctxt))
+  (let ((args (comp-func-args func))
+        (doc (aref (comp-func-byte-func func) 4)))
+    (puthash (comp-func-symbol-name func)
+             (vector (comp-func-symbol-name func)
+                     (comp-func-c-func-name func)
+                     (cons (comp-args-base-min args)
+                           (if (comp-args-p args)
+                               (comp-args-max args)
+                             'many))
+                     doc)
+             (comp-ctxt-funcs-h comp-ctxt)))
   (comp--add-func-to-ctxt func))
 
 \f

diff --git a/src/comp.c b/src/comp.c
index 65bca050b0ed092d5f7e6352cd907ea2f68dd991..953a1dd9d0fa29eb39f05f4006fe4c8a21915d32 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -1473,6 +1473,30 @@ emit_integerp (Lisp_Object insn)
                                   &res);
 }
 
+/*
+  Is not possibile to initilize static data in libgccjit therfore will create
+  the following:
+
+  char *str_name (void)
+  {
+    return "payload here";
+  }
+*/
+
+static void
+emit_litteral_string_func (const char *str_name, const char *str)
+{
+  gcc_jit_function *f =
+    gcc_jit_context_new_function (comp.ctxt, NULL,
+                                 GCC_JIT_FUNCTION_EXPORTED,
+                                 comp.char_ptr_type,
+                                 str_name,
+                                 0, NULL, 0);
+  DECL_BLOCK (block, f);
+  gcc_jit_rvalue *res = gcc_jit_context_new_string_literal (comp.ctxt, str);
+  gcc_jit_block_end_with_return (block, NULL, res);
+}
+
 /*
 This emit the code needed by every compilation unit to be loaded.
 */
@@ -1493,24 +1517,11 @@ emit_ctxt_code (void)
                                    comp.lisp_obj_type,
                                    d_reloc_len),
     "data_relocs");
-  /*
-    Is not possibile to initilize static data in libgccjit therfore will create
-    the following:
 
-    char *text_data_relocs (void)
-    {
-      return "[a b c... etc]";
-    }
-  */
-  gcc_jit_function *f =
-    gcc_jit_context_new_function (comp.ctxt, NULL,
-                                 GCC_JIT_FUNCTION_EXPORTED,
-                                 comp.char_ptr_type,
-                                 "text_data_relocs",
-                                 0, NULL, 0);
-  DECL_BLOCK (block, f);
-  gcc_jit_rvalue *res = gcc_jit_context_new_string_literal (comp.ctxt, d_reloc);
-  gcc_jit_block_end_with_return (block, NULL, res);
+  emit_litteral_string_func ("text_data_relocs", d_reloc);
+
+  const char *func_list = SSDATA (FUNCALL1 (comp-ctxt-funcs, Vcomp_ctxt));
+  emit_litteral_string_func ("text_funcs", func_list);
 }
 
 \f
@@ -2868,7 +2879,6 @@ syms_of_comp (void)
   defsubr (&Scomp__release_ctxt);
   defsubr (&Scomp__add_func_to_ctxt);
   defsubr (&Scomp__compile_ctxt_to_file);
-  defsubr (&Scomp_compile_and_load_ctxt);
 
   staticpro (&comp.func_hash);
   comp.func_hash = Qnil;

diff --git a/src/emacs-module.c b/src/emacs-module.c
index 7b9a5d843d0ebe628370213e4b89acbd9957eecc..e14ef89d8f9ff4fdb535fc0222871c089ba31e3a 100644 (file)
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -944,21 +944,61 @@ module_signal_or_throw (struct emacs_env_private *env)
     }
 }
 
-typedef char *(*f_comp_data_relocs) (void);
+\f
+/*
+  Native compiler load functions.
+  FIXME: Move away from here.
+*/
+
+typedef char *(*comp_litt_str_func) (void);
+
+static Lisp_Object
+comp_retrive_obj (dynlib_handle_ptr handle, const char *str_name)
+{
+  comp_litt_str_func f = dynlib_sym (handle, str_name);
+  char *res = f();
+  return Fread (build_string (res));
+}
 
 static int
-comp_load_unit (dynlib_handle_ptr handle, struct emacs_runtime *rt)
+comp_load_unit (dynlib_handle_ptr handle, emacs_env *env)
 {
   Lisp_Object *data_relocs = dynlib_sym (handle, "data_relocs");
-  f_comp_data_relocs f = dynlib_sym (handle, "text_data_relocs");
-  char *text_data_relocs = f();
 
-  Lisp_Object d_vec = Fread (build_string (text_data_relocs));
+  Lisp_Object d_vec = comp_retrive_obj (handle, "text_data_relocs");
   EMACS_UINT d_vec_len = XFIXNUM (Flength (d_vec));
 
   for (EMACS_UINT i = 0; i < d_vec_len; i++)
     data_relocs[i] = AREF (d_vec, i);
 
+  Lisp_Object func_list = comp_retrive_obj (handle, "text_funcs");
+
+  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);
+      /* Ffset (Qsym, */
+      /*            value_to_lisp (module_make_function (env, minargs, maxargs, func, */
+      /*                                                 doc, NULL))); */
+
+      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));
+      defsubr(x);
+
+      func_list = XCDR (func_list);
+    }
+
   return 0;
 }
 
@@ -1011,7 +1051,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
   ptrdiff_t count = SPECPDL_INDEX ();
   record_unwind_protect_ptr (finalize_runtime_unwind, rt);
 
-  int r = native_comp ? comp_load_unit (handle, rt) : module_init (rt);
+  int r = native_comp ? comp_load_unit (handle, &env_pub) : module_init (rt);
 
   /* Process the quit flag first, so that quitting doesn't get
      overridden by other non-local exits.  */