From: Andrea Corallo Date: Sat, 11 Jan 2020 08:50:34 +0000 (+0100) Subject: Move function reloc data into pure space during bootstrap X-Git-Tag: emacs-28.0.90~2727^2~847 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=93ed2c32dfd2e385ab0b75e9cbc0768c29b15b50;p=emacs.git Move function reloc data into pure space during bootstrap --- diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 77d47bde8a8..0f71746407a 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 bb8b952cf52..0d1f83eb8ff 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) {