make use of data relocations

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 11803a3ea5fd1fa59900961b5ee4b7e38b12e5e0..9026bf7b5327c2142df7faa0679123922cf00ced 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -83,7 +83,7 @@
          :documentation "Alist lisp-func-name -> c-func-name.
 This is build before entering into `comp--compile-ctxt-to-file name'.")
   (funcs-h (make-hash-table) :type hash-table
-           :documentation "lisp-func-name -> c-func-name.
+           :documentation "lisp-func-name -> comp-func.
 This is to build the prev field.")
   (data-relocs () :type string
                :documentation "Final data relocations.
@@ -381,7 +381,7 @@ If DST-N is specified use it otherwise assume it to be the current slot."
   (let ((rel-idx (comp-add-const-to-relocs val)))
     (setf (comp-slot) (make-comp-mvar :slot (comp-sp)
                                       :constant val))
-    (comp-emit `(setimm ,(comp-slot) ,rel-idx . ,val))))
+    (comp-emit `(setimm ,(comp-slot) ,rel-idx ,val))))
 
 (defun comp-mark-block-closed ()
   "Mark current basic block as closed."
@@ -835,23 +835,24 @@ the annotation emission."
   (setf (comp-ctxt-funcs comp-ctxt)
         (prin1-to-string (cl-loop with h = (comp-ctxt-funcs-h comp-ctxt)
                                   for f being each hash-value of h
-                                  collect f)))
+                                  for args = (comp-func-args f)
+                                  for doc = (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-add-func-to-ctxt (func)
   "Add FUNC to the current compiler contex."
-  (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))
+  (puthash (comp-func-symbol-name func)
+           func
+           (comp-ctxt-funcs-h comp-ctxt))
+  ;; (comp--add-func-to-ctxt func)
+  )
 
 \f
 ;;; Entry points.

diff --git a/src/comp.c b/src/comp.c
index 9ccf73ef4bff127cc000a02bf6bd8a0aa0719bdf..acf02e7c7cd03c935d394ff824de8e17ca9f28a9 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -149,6 +149,7 @@ typedef struct {
   Lisp_Object func_blocks; /* blk_name -> gcc_block.  */
   Lisp_Object func_hash; /* f_name -> gcc_func.        */
   Lisp_Object emitter_dispatcher;
+  gcc_jit_rvalue *data_relocs;
 } comp_t;
 
 static comp_t comp;
@@ -1349,13 +1350,22 @@ emit_limple_insn (Lisp_Object insn)
     }
   else if (EQ (op, Qsetimm))
     {
-      /* EX: (=imm #s(comp-mvar 9 1 t 3 nil) 3).  */
-      Lisp_Object arg1 = SECOND (args);
+      /* EX: (=imm #s(comp-mvar 9 1 t 3 nil) 3 a).  */
       EMACS_UINT slot_n = XFIXNUM (FUNCALL1 (comp-mvar-slot, arg0));
+      gcc_jit_rvalue *reloc_n =
+       gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+                                            comp.int_type,
+                                            XFIXNUM (SECOND (args)));
+      emit_comment (SSDATA (Fprin1_to_string (THIRD (args), Qnil)));
       gcc_jit_block_add_assignment (comp.block,
                                    NULL,
                                    comp.frame[slot_n],
-                                   emit_lisp_obj_from_ptr (arg1));
+                                   gcc_jit_lvalue_as_rvalue (
+                                     gcc_jit_context_new_array_access (
+                                       comp.ctxt,
+                                       NULL,
+                                       comp.data_relocs,
+                                       reloc_n)));
     }
   else if (EQ (op, Qcomment))
     {
@@ -1509,15 +1519,17 @@ emit_ctxt_code (void)
     XFIXNUM (FUNCALL1 (hash-table-count,
                       FUNCALL1 (comp-ctxt-data-relocs-idx, Vcomp_ctxt)));
 
-  gcc_jit_context_new_global (
-    comp.ctxt,
-    NULL,
-    GCC_JIT_GLOBAL_EXPORTED,
-    gcc_jit_context_new_array_type (comp.ctxt,
+  comp.data_relocs
+    = gcc_jit_lvalue_as_rvalue(
+       gcc_jit_context_new_global (
+         comp.ctxt,
+         NULL,
+         GCC_JIT_GLOBAL_EXPORTED,
+         gcc_jit_context_new_array_type (comp.ctxt,
                                    NULL,
                                    comp.lisp_obj_type,
                                    d_reloc_len),
-    "data_relocs");
+         "data_relocs"));
 
   emit_litteral_string_func ("text_data_relocs", d_reloc);
 
@@ -2372,6 +2384,93 @@ define_bool_to_lisp_obj (void)
 
 }
 
+static void
+compile_function (Lisp_Object func)
+{
+  char *c_name = (char *) SDATA (FUNCALL1 (comp-func-c-func-name, func));
+  Lisp_Object args = FUNCALL1 (comp-func-args, func);
+  EMACS_INT frame_size = XFIXNUM (FUNCALL1 (comp-func-frame-size, func));
+  bool ncall = (FUNCALL1 (comp-nargs-p, args));
+
+  if (!ncall)
+    {
+      EMACS_INT max_args = XFIXNUM (FUNCALL1 (comp-args-max, args));
+      comp.func =
+       emit_func_declare (c_name, comp.lisp_obj_type, max_args,
+                          NULL, GCC_JIT_FUNCTION_EXPORTED, false);
+    }
+  else
+    {
+      gcc_jit_param *param[] =
+       { gcc_jit_context_new_param (comp.ctxt,
+                                    NULL,
+                                    comp.ptrdiff_type,
+                                    "nargs"),
+         gcc_jit_context_new_param (comp.ctxt,
+                                    NULL,
+                                    comp.lisp_obj_ptr_type,
+                                    "args") };
+      comp.func =
+       gcc_jit_context_new_function (comp.ctxt,
+                                     NULL,
+                                     GCC_JIT_FUNCTION_EXPORTED,
+                                     comp.lisp_obj_type,
+                                     c_name, 2, param, 0);
+    }
+
+  gcc_jit_lvalue *frame_array =
+    gcc_jit_function_new_local (
+      comp.func,
+      NULL,
+      gcc_jit_context_new_array_type (comp.ctxt,
+                                     NULL,
+                                     comp.lisp_obj_type,
+                                     frame_size),
+      "local");
+
+  gcc_jit_lvalue *frame[frame_size];
+  for (int i = 0; i < frame_size; ++i)
+    frame[i] =
+      gcc_jit_context_new_array_access (
+        comp.ctxt,
+       NULL,
+       gcc_jit_lvalue_as_rvalue (frame_array),
+       gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+                                            comp.int_type,
+                                            i));
+  comp.frame = frame;
+
+  comp.func_blocks = CALLN (Fmake_hash_table);
+
+  /* Pre declare all basic blocks to gcc.
+     The "entry" block must be declared as first.  */
+  declare_block (Qentry);
+  Lisp_Object blocks = FUNCALL1 (comp-func-blocks, func);
+  Lisp_Object entry_block = Fgethash (Qentry, blocks, Qnil);
+  struct Lisp_Hash_Table *ht = XHASH_TABLE (blocks);
+  for (ptrdiff_t i = 0; i < ht->count; i++)
+    {
+      Lisp_Object block = HASH_VALUE (ht, i);
+      if (!EQ (block, entry_block))
+       declare_block (HASH_KEY (ht, i));
+    }
+
+  for (ptrdiff_t i = 0; i < ht->count; i++)
+    {
+      Lisp_Object block_name = HASH_KEY (ht, i);
+      Lisp_Object block = HASH_VALUE (ht, i);
+      Lisp_Object insns = FUNCALL1 (comp-block-insns, block);
+
+      comp.block = retrive_block (block_name);
+      while (CONSP (insns))
+       {
+         Lisp_Object insn = XCAR (insns);
+         emit_limple_insn (insn);
+         insns = XCDR (insns);
+       }
+    }
+}
+
 \f
 /**********************************/
 /* Entry points exposed to lisp.  */
@@ -2574,97 +2673,6 @@ DEFUN ("comp--release-ctxt", Fcomp__release_ctxt, Scomp__release_ctxt,
   return Qt;
 }
 
-DEFUN ("comp--add-func-to-ctxt", Fcomp__add_func_to_ctxt,
-       Scomp__add_func_to_ctxt, 1, 1, 0,
-       doc: /* Add limple FUNC to the current compilation context.  */)
-     (Lisp_Object func)
-{
-  char *c_name = (char *) SDATA (FUNCALL1 (comp-func-c-func-name, func));
-  Lisp_Object args = FUNCALL1 (comp-func-args, func);
-  EMACS_INT frame_size = XFIXNUM (FUNCALL1 (comp-func-frame-size, func));
-  bool ncall = (FUNCALL1 (comp-nargs-p, args));
-
-  if (!ncall)
-    {
-      EMACS_INT max_args = XFIXNUM (FUNCALL1 (comp-args-max, args));
-      comp.func =
-       emit_func_declare (c_name, comp.lisp_obj_type, max_args,
-                          NULL, GCC_JIT_FUNCTION_EXPORTED, false);
-    }
-  else
-    {
-      gcc_jit_param *param[] =
-       { gcc_jit_context_new_param (comp.ctxt,
-                                    NULL,
-                                    comp.ptrdiff_type,
-                                    "nargs"),
-         gcc_jit_context_new_param (comp.ctxt,
-                                    NULL,
-                                    comp.lisp_obj_ptr_type,
-                                    "args") };
-      comp.func =
-       gcc_jit_context_new_function (comp.ctxt,
-                                     NULL,
-                                     GCC_JIT_FUNCTION_EXPORTED,
-                                     comp.lisp_obj_type,
-                                     c_name, 2, param, 0);
-    }
-
-  gcc_jit_lvalue *frame_array =
-    gcc_jit_function_new_local (
-      comp.func,
-      NULL,
-      gcc_jit_context_new_array_type (comp.ctxt,
-                                     NULL,
-                                     comp.lisp_obj_type,
-                                     frame_size),
-      "local");
-
-  gcc_jit_lvalue *frame[frame_size];
-  for (int i = 0; i < frame_size; ++i)
-    frame[i] =
-      gcc_jit_context_new_array_access (
-        comp.ctxt,
-       NULL,
-       gcc_jit_lvalue_as_rvalue (frame_array),
-       gcc_jit_context_new_rvalue_from_int (comp.ctxt,
-                                            comp.int_type,
-                                            i));
-  comp.frame = frame;
-
-  comp.func_blocks = CALLN (Fmake_hash_table);
-
-  /* Pre declare all basic blocks to gcc.
-     The "entry" block must be declared as first.  */
-  declare_block (Qentry);
-  Lisp_Object blocks = FUNCALL1 (comp-func-blocks, func);
-  Lisp_Object entry_block = Fgethash (Qentry, blocks, Qnil);
-  struct Lisp_Hash_Table *ht = XHASH_TABLE (blocks);
-  for (ptrdiff_t i = 0; i < ht->count; i++)
-    {
-      Lisp_Object block = HASH_VALUE (ht, i);
-      if (!EQ (block, entry_block))
-       declare_block (HASH_KEY (ht, i));
-    }
-
-  for (ptrdiff_t i = 0; i < ht->count; i++)
-    {
-      Lisp_Object block_name = HASH_KEY (ht, i);
-      Lisp_Object block = HASH_VALUE (ht, i);
-      Lisp_Object insns = FUNCALL1 (comp-block-insns, block);
-
-      comp.block = retrive_block (block_name);
-      while (CONSP (insns))
-       {
-         Lisp_Object insn = XCAR (insns);
-         emit_limple_insn (insn);
-         insns = XCDR (insns);
-       }
-    }
-
-  return Qt;
-}
-
 DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
        Scomp__compile_ctxt_to_file,
        1, 1, 0,
@@ -2687,6 +2695,13 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
 
   emit_ctxt_code ();
 
+  /* Compile all functions. Can't be done before because the
+     relocation vectore has to be already compiled.  */
+  struct Lisp_Hash_Table *func_h
+    = XHASH_TABLE (FUNCALL1 (comp-ctxt-funcs-h, Vcomp_ctxt));
+  for (ptrdiff_t i = 0; i < func_h->count; i++)
+    compile_function (HASH_VALUE (func_h, i));
+
   if (COMP_DEBUG)
     {
       AUTO_STRING (dot_c, ".c");
@@ -2967,7 +2982,6 @@ syms_of_comp (void)
 
   defsubr (&Scomp__init_ctxt);
   defsubr (&Scomp__release_ctxt);
-  defsubr (&Scomp__add_func_to_ctxt);
   defsubr (&Scomp__compile_ctxt_to_file);
   defsubr (&Snative_elisp_load);