feature/native-comp 93ed2c3: Move function reloc data into pure space during bootstrap

[Andrea Corallo]

branch: feature/native-comp
commit 93ed2c32dfd2e385ab0b75e9cbc0768c29b15b50
Author: Andrea Corallo <address@hidden>
Commit: Andrea Corallo <address@hidden>

    Move function reloc data into pure space during bootstrap
---
 lisp/emacs-lisp/comp.el | 29 +++++++++++++++++------------
 src/comp.c              | 37 ++++++++++++++++++++++++-------------
 2 files changed, 41 insertions(+), 25 deletions(-)

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 77d47bd..0f71746 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -167,7 +167,7 @@ Can be used by code that wants to expand differently in 
this case.")
            :documentation "lisp-func-name -> comp-func.
 This is to build the prev field.")
   (data-relocs-l () :type list
-               :documentation "Constant objects used by functions.")
+                 :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."))
 
@@ -288,8 +288,10 @@ structure.")
         :documentation "When non nil indicates the type when known at compile
  time.")
   (ref nil :type boolean
-       :documentation "When t the m-var is involved in a call where is passed 
by
- reference."))
+       :documentation "When non nil the m-var is involved in a
+ call where is passed by reference.")
+  (impure nil :type boolean
+          :documentation "When non nil can't be copied into pure space."))
 
 ;; Special vars used by some passes
 (defvar comp-func)
@@ -312,14 +314,16 @@ structure.")
   "Type hint predicate for function name FUNC."
   (when (member func comp-type-hints) t))
 
-(defun comp-add-const-to-relocs (obj)
+(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)))
-    (if-let ((idx (gethash obj data-relocs-idx)))
+  (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 obj (comp-ctxt-data-relocs-l comp-ctxt))
-      (puthash obj (hash-table-count data-relocs-idx) data-relocs-idx))))
+      (push packed-obj (comp-ctxt-data-relocs-l comp-ctxt))
+      (puthash packed-obj (hash-table-count data-relocs-idx) 
data-relocs-idx))))
 
 (defmacro comp-within-log-buff (&rest body)
   "Execute BODY while at the end the log-buffer.
@@ -584,11 +588,12 @@ STACK-OFF is the index of the first slot frame involved."
                              for sp from stack-off
                              collect (comp-slot-n sp))))
 
-(cl-defun make-comp-mvar (&key slot (constant nil const-vld) type)
+(cl-defun make-comp-mvar (&key slot (constant nil const-vld) type
+                               impure)
   (when const-vld
-    (comp-add-const-to-relocs constant))
+    (comp-add-const-to-relocs constant impure))
   (make--comp-mvar :slot slot :const-vld const-vld :constant constant
-                   :type type))
+                   :type type :impure impure))
 
 (defun comp-new-frame (size &optional ssa)
   "Return a clean frame of meta variables of size SIZE.
@@ -1099,7 +1104,7 @@ the annotation emission."
 (cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level))
   (let ((form (byte-to-native-top-level-form form)))
     (comp-emit (comp-call 'eval
-                          (make-comp-mvar :constant form)
+                          (make-comp-mvar :constant form :impure t)
                           (make-comp-mvar :constant t)))))
 
 (defun comp-limplify-top-level ()
diff --git a/src/comp.c b/src/comp.c
index bb8b952..0d1f83e 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -883,7 +883,7 @@ emit_make_fixnum (gcc_jit_rvalue *obj)
 }
 
 static gcc_jit_rvalue *
-emit_const_lisp_obj (Lisp_Object obj)
+emit_const_lisp_obj (Lisp_Object obj, Lisp_Object impure)
 {
   emit_comment (format_string ("const lisp obj: %s",
                               SSDATA (Fprin1_to_string (obj, Qnil))));
@@ -895,11 +895,13 @@ emit_const_lisp_obj (Lisp_Object obj)
                                                           NULL));
 
   Lisp_Object d_reloc_idx = CALL1I (comp-ctxt-data-relocs-idx, Vcomp_ctxt);
-  ptrdiff_t reloc_fixn = XFIXNUM (Fgethash (obj, d_reloc_idx, Qnil));
+  Lisp_Object packed_obj = Fcons (impure, obj);
+  Lisp_Object reloc_idx = Fgethash (packed_obj, d_reloc_idx, Qnil);
+  eassert (!NILP (reloc_idx));
   gcc_jit_rvalue *reloc_n =
     gcc_jit_context_new_rvalue_from_int (comp.ctxt,
                                         comp.ptrdiff_type,
-                                        reloc_fixn);
+                                        XFIXNUM (reloc_idx));
   return
     gcc_jit_lvalue_as_rvalue (
       gcc_jit_context_new_array_access (comp.ctxt,
@@ -912,7 +914,7 @@ static gcc_jit_rvalue *
 emit_NILP (gcc_jit_rvalue *x)
 {
   emit_comment ("NILP");
-  return emit_EQ (x, emit_const_lisp_obj (Qnil));
+  return emit_EQ (x, emit_const_lisp_obj (Qnil, Qnil));
 }
 
 static gcc_jit_rvalue *
@@ -1015,7 +1017,7 @@ emit_CHECK_CONS (gcc_jit_rvalue *x)
 
   gcc_jit_rvalue *args[] =
     { emit_CONSP (x),
-      emit_const_lisp_obj (Qconsp),
+      emit_const_lisp_obj (Qconsp, Qnil),
       x };
 
   gcc_jit_block_add_eval (
@@ -1126,7 +1128,7 @@ emit_mvar_val (Lisp_Object mvar)
          return emit_cast (comp.lisp_obj_type, word);
        }
       /* Other const objects are fetched from the reloc array.  */
-      return emit_const_lisp_obj (constant);
+      return emit_const_lisp_obj (constant, CALL1I (comp-mvar-impure, mvar));
     }
 
   return gcc_jit_lvalue_as_rvalue (get_slot (mvar));
@@ -1161,7 +1163,7 @@ emit_set_internal (Lisp_Object args)
   gcc_jit_rvalue *gcc_args[4];
   FOR_EACH_TAIL (args)
     gcc_args[i++] = emit_mvar_val (XCAR (args));
-  gcc_args[2] = emit_const_lisp_obj (Qnil);
+  gcc_args[2] = emit_const_lisp_obj (Qnil, Qnil);
   gcc_args[3] = gcc_jit_context_new_rvalue_from_int (comp.ctxt,
                                                     comp.int_type,
                                                     SET_INTERNAL_SET);
@@ -2360,11 +2362,11 @@ define_CAR_CDR (void)
       comp.block = is_nil_b;
       gcc_jit_block_end_with_return (comp.block,
                                     NULL,
-                                    emit_const_lisp_obj (Qnil));
+                                    emit_const_lisp_obj (Qnil, Qnil));
 
       comp.block = not_nil_b;
       gcc_jit_rvalue *wrong_type_args[] =
-       { emit_const_lisp_obj (Qlistp), c };
+       { emit_const_lisp_obj (Qlistp, Qnil), c };
 
       gcc_jit_block_add_eval (comp.block,
                              NULL,
@@ -2373,7 +2375,7 @@ define_CAR_CDR (void)
                                         false));
       gcc_jit_block_end_with_return (comp.block,
                                     NULL,
-                                    emit_const_lisp_obj (Qnil));
+                                    emit_const_lisp_obj (Qnil, Qnil));
     }
   comp.car = func[0];
   comp.cdr = func[1];
@@ -2753,12 +2755,12 @@ define_bool_to_lisp_obj (void)
   comp.block = ret_t_block;
   gcc_jit_block_end_with_return (ret_t_block,
                                 NULL,
-                                emit_const_lisp_obj (Qt));
+                                emit_const_lisp_obj (Qt, Qnil));
 
   comp.block = ret_nil_block;
   gcc_jit_block_end_with_return (ret_nil_block,
                                 NULL,
-                                emit_const_lisp_obj (Qnil));
+                                emit_const_lisp_obj (Qnil, Qnil));
 
 }
 
@@ -3285,8 +3287,17 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, 
bool loading_dump)
 
   EMACS_INT d_vec_len = XFIXNUM (Flength (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)));
+      }
+
   for (EMACS_INT i = 0; i < d_vec_len; i++)
-    data_relocs[i] = AREF (comp_u->data_vec, i);
+    data_relocs[i] = XCDR (AREF (comp_u->data_vec, i));
 
   if (!loading_dump)
     {