Split relocated data into two separate arrays

Rework the functionality of the previous commit to be more efficient.

4 files changed, 106 insertions, 53 deletions

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 0f71746407a..69141f657a6 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -157,6 +157,13 @@ Can be used by code that wants to expand differently in this case.")
              finally return h)
     "Hash table lap-op -> stack adjustment."))
 
+(cl-defstruct comp-data-container
+  "Data relocation container structure."
+  (l () :type list
+     :documentation "Constant objects used by functions.")
+  (idx (make-hash-table :test #'equal) :type hash-table
+       :documentation "Obj -> position into the previous field."))
+
 (cl-defstruct comp-ctxt
   "Lisp side of the compiler context."
   (output nil :type string
@@ -166,10 +173,11 @@ Can be used by code that wants to expand differently in this case.")
   (funcs-h (make-hash-table) :type hash-table
            :documentation "lisp-func-name -> comp-func.
 This is to build the prev field.")
-  (data-relocs-l () :type list
-                 :documentation "List of pairs (impure . obj-to-reloc).")
-  (data-relocs-idx (make-hash-table :test #'equal) :type hash-table
-                   :documentation "Obj -> position into data-relocs."))
+  (d-base (make-comp-data-container) :type comp-data-container
+          :documentation "Standard data relocated in use by functions.")
+  (d-impure (make-comp-data-container) :type comp-data-container
+          :documentation "Data relocated that cannot be moved into pure space.
+This is tipically for top-level forms other than defun."))
 
 (cl-defstruct comp-args-base
   (min nil :type number
@@ -314,16 +322,28 @@ structure.")
   "Type hint predicate for function name FUNC."
   (when (member func comp-type-hints) t))
 
+(defun comp-data-container-check (cont)
+  "Sanity check CONT coherency."
+  (cl-assert (= (length (comp-data-container-l cont))
+                (hash-table-count (comp-data-container-idx cont)))))
+
+(defun comp-add-const-to-relocs-to-cont (obj cont)
+  "Keep track of OBJ into the CONT relocation container.
+The corresponding index is returned."
+  (let ((h (comp-data-container-idx cont)))
+    (if-let ((idx (gethash obj h)))
+        idx
+      (push obj (comp-data-container-l cont))
+      (puthash obj (hash-table-count h) h))))
+
 (defun comp-add-const-to-relocs (obj &optional impure)
   "Keep track of OBJ into the ctxt relocations.
 When IMPURE is non nil OBJ cannot be copied into pure space.
 The corresponding index is returned."
-  (let ((data-relocs-idx (comp-ctxt-data-relocs-idx comp-ctxt))
-        (packed-obj (cons impure obj)))
-    (if-let ((idx (gethash packed-obj data-relocs-idx)))
-        idx
-      (push packed-obj (comp-ctxt-data-relocs-l comp-ctxt))
-      (puthash packed-obj (hash-table-count data-relocs-idx) data-relocs-idx))))
+  (comp-add-const-to-relocs-to-cont obj
+                                    (if impure
+                                        (comp-ctxt-d-impure comp-ctxt)
+                                        (comp-ctxt-d-base comp-ctxt))))
 
 (defmacro comp-within-log-buff (&rest body)
   "Execute BODY while at the end the log-buffer.
@@ -1810,8 +1830,8 @@ These are substituted with a normal 'set' op."
 (defun comp-compile-ctxt-to-file (name)
   "Compile as native code the current context naming it NAME.
 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))))
+  (comp-data-container-check (comp-ctxt-d-base comp-ctxt))
+  (comp-data-container-check (comp-ctxt-d-impure comp-ctxt))
   (comp--compile-ctxt-to-file name))
 
 (defun comp-final (_)
diff --git a/src/comp.c b/src/comp.c
index 0d1f83eb8ff..290fc3a9c45 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -39,9 +39,11 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #define CURRENT_THREAD_RELOC_SYM "current_thread_reloc"
 #define PURE_RELOC_SYM "pure_reloc"
 #define DATA_RELOC_SYM "d_reloc"
+#define DATA_RELOC_IMPURE_SYM "d_reloc_imp"
 #define FUNC_LINK_TABLE_SYM "freloc_link_table"
 #define LINK_TABLE_HASH_SYM "freloc_hash"
 #define TEXT_DATA_RELOC_SYM "text_data_reloc"
+#define TEXT_DATA_RELOC_IMPURE_SYM "text_data_reloc_imp"
 
 #define SPEED XFIXNUM (Fsymbol_value (Qcomp_speed))
 #define COMP_DEBUG XFIXNUM (Fsymbol_value (Qcomp_debug))
@@ -171,8 +173,12 @@ typedef struct {
   Lisp_Object exported_funcs_h; /* subr_name -> gcc_jit_function *.  */
   Lisp_Object imported_funcs_h; /* subr_name -> gcc_jit_field *reloc_field.  */
   Lisp_Object emitter_dispatcher;
-  gcc_jit_rvalue *data_relocs; /* Synthesized struct holding data relocs.  */
-  gcc_jit_lvalue *func_relocs; /* Synthesized struct holding func relocs.  */
+  /* Synthesized struct holding data relocs.  */
+  gcc_jit_rvalue *data_relocs;
+  /* Same as before but can't go in pure space. */
+  gcc_jit_rvalue *data_relocs_impure;
+  /* Synthesized struct holding func relocs.  */
+  gcc_jit_lvalue *func_relocs;
 } comp_t;
 
 static comp_t comp;
@@ -894,9 +900,10 @@ emit_const_lisp_obj (Lisp_Object obj, Lisp_Object impure)
                                                            comp.void_ptr_type,
                                                            NULL));
 
-  Lisp_Object d_reloc_idx = CALL1I (comp-ctxt-data-relocs-idx, Vcomp_ctxt);
-  Lisp_Object packed_obj = Fcons (impure, obj);
-  Lisp_Object reloc_idx = Fgethash (packed_obj, d_reloc_idx, Qnil);
+  Lisp_Object container = impure ? CALL1I (comp-ctxt-d-impure, Vcomp_ctxt)
+                                 : CALL1I (comp-ctxt-d-base, Vcomp_ctxt);
+  Lisp_Object reloc_idx =
+    Fgethash (obj, CALL1I (comp-data-container-idx, container), Qnil);
   eassert (!NILP (reloc_idx));
   gcc_jit_rvalue *reloc_n =
     gcc_jit_context_new_rvalue_from_int (comp.ctxt,
@@ -906,7 +913,8 @@ emit_const_lisp_obj (Lisp_Object obj, Lisp_Object impure)
     gcc_jit_lvalue_as_rvalue (
       gcc_jit_context_new_array_access (comp.ctxt,
                                         NULL,
-                                        comp.data_relocs,
+                                        impure ? comp.data_relocs_impure
+                                               : comp.data_relocs,
                                         reloc_n));
 }
 
@@ -1749,14 +1757,52 @@ emit_static_object (const char *name, Lisp_Object obj)
   gcc_jit_block_end_with_return (block, NULL, res);
 }
 
+static gcc_jit_rvalue *
+declare_imported_data_relocs (Lisp_Object container, const char *code_symbol,
+                              const char *text_symbol)
+{
+  /* Imported objects.  */
+  EMACS_INT d_reloc_len =
+    XFIXNUM (CALL1I (hash-table-count,
+                     CALL1I (comp-data-container-idx, container)));
+  Lisp_Object d_reloc = Fnreverse (CALL1I (comp-data-container-l, container));
+  d_reloc = Fvconcat (1, &d_reloc);
+
+  gcc_jit_rvalue *reloc_struct =
+    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),
+        code_symbol));
+
+  emit_static_object (text_symbol, d_reloc);
+
+  return reloc_struct;
+}
+
 static void
-declare_runtime_imported_data (void)
+declare_imported_data (void)
 {
   /* Imported symbols by inliner functions.  */
   CALL1I (comp-add-const-to-relocs, Qnil);
   CALL1I (comp-add-const-to-relocs, Qt);
   CALL1I (comp-add-const-to-relocs, Qconsp);
   CALL1I (comp-add-const-to-relocs, Qlistp);
+
+  /* Imported objects.  */
+  comp.data_relocs =
+    declare_imported_data_relocs (CALL1I (comp-ctxt-d-base, Vcomp_ctxt),
+                                  DATA_RELOC_SYM,
+                                  TEXT_DATA_RELOC_SYM);
+  comp.data_relocs_impure =
+    declare_imported_data_relocs (CALL1I (comp-ctxt-d-impure, Vcomp_ctxt),
+                                  DATA_RELOC_IMPURE_SYM,
+                                  TEXT_DATA_RELOC_IMPURE_SYM);
 }
 
 /*
@@ -1842,27 +1888,7 @@ emit_ctxt_code (void)
         gcc_jit_type_get_pointer (comp.void_ptr_type),
         PURE_RELOC_SYM));
 
-  declare_runtime_imported_data ();
-  /* Imported objects.  */
-  EMACS_INT d_reloc_len =
-    XFIXNUM (CALL1I (hash-table-count,
-                       CALL1I (comp-ctxt-data-relocs-idx, Vcomp_ctxt)));
-  Lisp_Object d_reloc = Fnreverse (CALL1I (comp-ctxt-data-relocs-l, Vcomp_ctxt));
-  d_reloc = Fvconcat (1, &d_reloc);
-
-  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_RELOC_SYM));
-
-  emit_static_object (TEXT_DATA_RELOC_SYM, d_reloc);
+  declare_imported_data ();
 
   /* Functions imported from Lisp code.  */
   freloc_check_fill ();
@@ -3263,12 +3289,14 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump)
     dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM);
   EMACS_INT ***pure_reloc = dynlib_sym (handle, PURE_RELOC_SYM);
   Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM);
+  Lisp_Object *data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM);
   void **freloc_link_table = dynlib_sym (handle, FUNC_LINK_TABLE_SYM);
   void (*top_level_run)(Lisp_Object) = dynlib_sym (handle, "top_level_run");
 
   if (!(current_thread_reloc
         && pure_reloc
         && data_relocs
+        && data_imp_relocs
         && freloc_link_table
         && top_level_run)
       || NILP (Fstring_equal (load_static_obj (comp_u, LINK_TABLE_HASH_SYM),
@@ -3283,21 +3311,23 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump)
 
   /* Imported data.  */
   if (!loading_dump)
-    comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM);
+    {
+      comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM);
+      comp_u->data_impure_vec =
+        load_static_obj (comp_u, TEXT_DATA_RELOC_IMPURE_SYM);
 
-  EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec));
+      if (!NILP (Vpurify_flag))
+        /* Non impure can be copied into pure space.  */
+        comp_u->data_vec = Fpurecopy (comp_u->data_vec);
+    }
 
-  if (!loading_dump && !NILP (Vpurify_flag))
-    for (EMACS_INT i = 0; i < d_vec_len; i++)
-      {
-        Lisp_Object packed_obj = AREF (comp_u->data_vec, i);
-        if (NILP (XCAR (packed_obj)))
-          /* If is not impure can be copied into pure space.  */
-          XSETCDR (packed_obj, Fpurecopy (XCDR (packed_obj)));
-      }
+  EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec));
+  for (EMACS_INT i = 0; i < d_vec_len; i++)
+    data_relocs[i] = AREF (comp_u->data_vec, i);
 
+  d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec));
   for (EMACS_INT i = 0; i < d_vec_len; i++)
-    data_relocs[i] = XCDR (AREF (comp_u->data_vec, i));
+    data_imp_relocs[i] = AREF (comp_u->data_impure_vec, i);
 
   if (!loading_dump)
     {
diff --git a/src/comp.h b/src/comp.h
index 86fa54f5158..ddebbbcccf0 100644
--- a/src/comp.h
+++ b/src/comp.h
@@ -38,6 +38,9 @@ struct Lisp_Native_Comp_Unit
   Lisp_Object file;
   /* Analogous to the constant vector but per compilation unit.  */
   Lisp_Object data_vec;
+  /* Same but for data that cannot be moved to pure space.
+     Must be the last lisp object here.   */
+  Lisp_Object data_impure_vec;
   dynlib_handle_ptr handle;
 };
 
diff --git a/src/lisp.h b/src/lisp.h
index 2d083dc4582..04489959ed8 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4767,8 +4767,8 @@ SUBR_NATIVE_COMPILEDP (Lisp_Object a)
 INLINE struct Lisp_Native_Comp_Unit *
 allocate_native_comp_unit (void)
 {
-  return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit, data_vec,
-                                       PVEC_NATIVE_COMP_UNIT);
+  return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit,
+                                       data_impure_vec, PVEC_NATIVE_COMP_UNIT);
 }
 #else
 INLINE bool