Commit 93ed2c32 authored by Andrea Corallo's avatar Andrea Corallo

Move function reloc data into pure space during bootstrap

parent a59cc78f
Pipeline #4536 failed with stage
in 56 minutes and 31 seconds
......@@ -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 ()
......
......@@ -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)
{
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment