emit function relocation into structure

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 972c118587138f1684f9689a3e4b4513b1e52f9e..a14438e250c57337bda8ea1b107145191203ee18 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -80,8 +80,7 @@
   "This structure is to serve al relocation creation for the current compiler
  context."
   (funcs () :type list
-         :documentation "Alist lisp-func-name -> c-func-name.
-This is build before entering into `comp--compile-ctxt-to-file name'.")
+         :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.")
@@ -180,6 +179,14 @@ The corresponding index is returned."
       (push obj (comp-ctxt-data-relocs-l comp-ctxt))
       (puthash obj (hash-table-count data-relocs-idx) data-relocs-idx))))
 
+(defun comp-add-subr-to-relocs (subr-name)
+  "Keep track of SUBR-NAME into the ctxt relocations.
+The corresponding index is returned."
+  (let ((func-relocs-idx (comp-ctxt-func-relocs-idx comp-ctxt)))
+    (unless (gethash subr-name func-relocs-idx)
+      (push subr-name (comp-ctxt-func-relocs-l comp-ctxt))
+      (puthash subr-name (hash-table-count func-relocs-idx) func-relocs-idx))))
+
 (defmacro comp-within-log-buff (&rest body)
   "Execute BODY while at the end the log-buffer.
 BODY is evaluate only if `comp-debug' is non nil."
@@ -276,10 +283,12 @@ Put PREFIX in front of it."
 
 (defun comp-call (func &rest args)
   "Emit a call for function FUNC with ARGS."
+  (comp-add-subr-to-relocs func)
   `(call ,func ,@args))
 
 (defun comp-callref (func &rest args)
   "Emit a call usign narg abi for FUNC with ARGS."
+  (comp-add-subr-to-relocs func)
   `(callref ,func ,@args))
 
 (defun comp-new-frame (size)

diff --git a/src/comp.c b/src/comp.c
index 5c8106a78e4ea0207e8ab8fb84f4748ea5810d1b..1a2984bb72e82aa6ee2414126f3fb373a5e8098d 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -150,6 +150,7 @@ typedef struct {
   Lisp_Object func_hash; /* c_f_name -> (gcc_func . subr_name).        */
   Lisp_Object emitter_dispatcher;
   gcc_jit_rvalue *data_relocs;
+  gcc_jit_lvalue *func_relocs;
 } comp_t;
 
 static comp_t comp;
@@ -283,7 +284,7 @@ fill_declaration_types (gcc_jit_type **type, gcc_jit_rvalue **args,
       type[i] = comp.lisp_obj_type;
 }
 
-static void
+static gcc_jit_field *
 declare_imported_func (Lisp_Object subr_sym, gcc_jit_type *ret_type,
                       unsigned nargs, gcc_jit_rvalue **args)
 {
@@ -305,14 +306,15 @@ declare_imported_func (Lisp_Object subr_sym, gcc_jit_type *ret_type,
                                             nargs,
                                             type,
                                             0);
-  gcc_jit_lvalue *f_ptr
-    = gcc_jit_context_new_global (comp.ctxt,
-                                 NULL,
-                                 GCC_JIT_GLOBAL_EXPORTED,
-                                 f_ptr_type,
-                                 SSDATA (f_ptr_name));
-  Lisp_Object value = Fcons (make_mint_ptr (f_ptr), subr_sym);
+  gcc_jit_field *field
+    = gcc_jit_context_new_field (comp.ctxt,
+                                NULL,
+                                f_ptr_type,
+                                SSDATA (f_ptr_name));
+
+  Lisp_Object value = Fcons (make_mint_ptr (field), subr_sym);
   Fputhash (subr_sym, value, comp.func_hash);
+  return field;
 }
 
 static gcc_jit_function *
@@ -343,14 +345,12 @@ emit_call (Lisp_Object subr_sym, gcc_jit_type *ret_type, unsigned nargs,
           gcc_jit_rvalue **args)
 {
   Lisp_Object value = Fgethash (subr_sym, comp.func_hash, Qnil);
+  eassert (!NILP (value));
 
-  if (NILP (value))
-    {
-      declare_imported_func (subr_sym, ret_type, nargs, args);
-      value = Fgethash (subr_sym, comp.func_hash, Qnil);
-      eassert (!NILP (value));
-    }
-  gcc_jit_lvalue *f_ptr = (gcc_jit_lvalue *) xmint_pointer (XCAR (value));
+  gcc_jit_lvalue *f_ptr =
+    gcc_jit_lvalue_access_field (comp.func_relocs,
+                                NULL,
+                                (gcc_jit_field *) xmint_pointer (XCAR (value)));
   emit_comment (format_string ("calling subr: %s",
                               SSDATA (SYMBOL_NAME (subr_sym))));
   return gcc_jit_context_new_call_through_ptr(comp.ctxt,
@@ -1529,6 +1529,8 @@ This emit the code needed by every compilation unit to be loaded.
 static void
 emit_ctxt_code (void)
 {
+  /* Imported objects.  */
+
   const char *d_reloc = SSDATA (FUNCALL1 (comp-ctxt-data-relocs, Vcomp_ctxt));
   EMACS_UINT d_reloc_len =
     XFIXNUM (FUNCALL1 (hash-table-count,
@@ -1548,6 +1550,37 @@ emit_ctxt_code (void)
 
   emit_litteral_string_func ("text_data_relocs", d_reloc);
 
+  /* Imported functions. */
+  Lisp_Object f_reloc = FUNCALL1 (comp-ctxt-func-relocs-l, Vcomp_ctxt);
+  EMACS_UINT f_reloc_len = XFIXNUM (Flength (f_reloc));
+  gcc_jit_field *fields[f_reloc_len];
+  int i = 0;
+  FOR_EACH_TAIL (f_reloc)
+    {
+      Lisp_Object subr_sym = XCAR (f_reloc);
+      Lisp_Object subr = Fsymbol_function (subr_sym);
+      gcc_jit_field *field
+       = declare_imported_func (subr_sym, comp.lisp_obj_type,
+                                XFIXNUM (XCDR (Fsubr_arity (subr))), NULL);
+      fields [i++] = field;
+    }
+  eassert (f_reloc_len == i);
+
+  gcc_jit_struct *f_reloc_struct
+    = gcc_jit_context_new_struct_type (comp.ctxt,
+                                      NULL,
+                                      "function_reloc_struct",
+                                      f_reloc_len,
+                                      fields);
+  comp.func_relocs
+    = gcc_jit_context_new_global (
+       comp.ctxt,
+       NULL,
+       GCC_JIT_GLOBAL_EXPORTED,
+       gcc_jit_struct_as_type (f_reloc_struct),
+       "f_reloc");
+
+  /* Exported functions info.  */
   const char *func_list = SSDATA (FUNCALL1 (comp-ctxt-funcs, Vcomp_ctxt));
   emit_litteral_string_func ("text_exported_funcs", func_list);
 }
@@ -2658,17 +2691,6 @@ DEFUN ("comp--init-ctxt", Fcomp__init_ctxt, Scomp__init_ctxt,
                                         comp.void_ptr_type,
                                         pure);
 
-  /* Define inline functions.  */
-
-  define_CAR_CDR();
-  define_PSEUDOVECTORP ();
-  define_CHECK_TYPE ();
-  define_CHECK_IMPURE ();
-  define_bool_to_lisp_obj ();
-  define_setcar_setcdr ();
-  define_add1_sub1 ();
-  define_negate ();
-
   return Qt;
 }
 
@@ -2709,6 +2731,16 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
 
   emit_ctxt_code ();
 
+  /* /\* Define inline functions.  *\/ */
+  /* define_CAR_CDR(); */
+  /* define_PSEUDOVECTORP (); */
+  /* define_CHECK_TYPE (); */
+  /* define_CHECK_IMPURE (); */
+  /* define_bool_to_lisp_obj (); */
+  /* define_setcar_setcdr (); */
+  /* define_add1_sub1 (); */
+  /* define_negate (); */
+
   /* Compile all functions. Can't be done before because the
      relocation vectore has to be already compiled.  */
   struct Lisp_Hash_Table *func_h