From c9c1ea908712d9841610719d35f7fd1855fa413c Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 19:09:14 +0000 Subject: [PATCH] Pure storage removal: Adjust nativecomp code * lisp/emacs-lisp/comp.el (comp-curr-allocation-class, comp-ctxt) (comp--emit-for-top-level, comp--emit-lambda-for-top-level) (comp--finalize-relocs): Remove 'd-impure' allocation class. * src/comp.c (PURE_RELOC_SYM, DATA_RELOC_IMPURE_SYM) (TEXT_DATA_RELOC_IMPURE_SYM): Remove definitions. (comp_t): Remove 'pure_ptr', 'check_impure', 'data_relocs_impure', 'd_impure_idx'. (helper_link_table): Remove 'pure_write_error'. (obj_to_reloc): Adjust to removal of 'data_relocs_impure'. (emit_PURE_P): Remove function. (declare_imported_data, declare_runtime_imported_funcs) (emit_ctxt_code): Adjust to removed fields. (define_setcar_setcdr): Don't call 'CHECK_IMPURE'. (define_CHECK_IMPURE): Remove function. (Fcomp__compile_ctxt_to_file0, check_comp_unit_relocs, load_comp_unit) (Fcomp__register_lambda): Adjust to removed allocation class 'd-impure'. (syms_of_comp): Don't define 'd-impure'. * src/comp.h (struct Lisp_Native_Comp_Unit): Drop support for allocation class 'd-impure'. * src/lisp.h (allocate_native_comp_unit): * src/pdumper.c (dump_do_dump_relocation): Adjust to struct change. (cherry picked from commit bd2b59f07337c4f5980666875207bf877634b1b3) --- lisp/emacs-lisp/comp.el | 36 +++------- src/comp.c | 147 ++-------------------------------------- src/comp.h | 10 ++- src/lisp.h | 2 +- src/pdumper.c | 4 +- 5 files changed, 23 insertions(+), 176 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 92b06d83f84..71d3eda9096 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -155,7 +155,7 @@ native compilation runs.") (defvar comp-curr-allocation-class 'd-default "Current allocation class. -Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.") +Can be one of: `d-default' or `d-ephemeral'. See `comp-ctxt'.") (defconst comp-passes '(comp--spill-lap comp--limplify @@ -395,9 +395,6 @@ Needed to replace immediate byte-compiled lambdas with the compiled reference.") :documentation "Documentation index -> documentation") (d-default (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 "Relocated data that cannot be moved into pure space. -This is typically for top-level forms other than defun.") (d-ephemeral (make-comp-data-container) :type comp-data-container :documentation "Relocated data not necessary after load.") (with-late-load nil :type boolean @@ -1615,7 +1612,7 @@ and the annotation emission." (unless for-late-load (comp--emit (comp--call 'eval - (let ((comp-curr-allocation-class 'd-impure)) + (let ((comp-curr-allocation-class 'd-default)) (make--comp-mvar :constant (byte-to-native-top-level-form form))) (make--comp-mvar :constant @@ -1625,7 +1622,7 @@ and the annotation emission." "Emit the creation of subrs for lambda FUNC. These are stored in the reloc data array." (let ((args (comp--prepare-args-for-top-level func))) - (let ((comp-curr-allocation-class 'd-impure)) + (let ((comp-curr-allocation-class 'd-default)) (comp--add-const-to-relocs (comp-func-byte-func func))) (comp--emit (comp--call 'comp--register-lambda @@ -3271,28 +3268,15 @@ Update all insn accordingly." (let* ((d-default (comp-ctxt-d-default comp-ctxt)) (d-default-idx (comp-data-container-idx d-default)) - (d-impure (comp-ctxt-d-impure comp-ctxt)) - (d-impure-idx (comp-data-container-idx d-impure)) (d-ephemeral (comp-ctxt-d-ephemeral comp-ctxt)) (d-ephemeral-idx (comp-data-container-idx d-ephemeral))) - ;; We never want compiled lambdas ending up in pure space. A copy must - ;; be already present in impure (see `comp--emit-lambda-for-top-level'). - (cl-loop for obj being each hash-keys of d-default-idx - when (gethash obj (comp-ctxt-lambda-fixups-h comp-ctxt)) - do (cl-assert (gethash obj d-impure-idx)) - (remhash obj d-default-idx)) - ;; Remove entries in d-impure already present in d-default. - (cl-loop for obj being each hash-keys of d-impure-idx - when (gethash obj d-default-idx) - do (remhash obj d-impure-idx)) - ;; Remove entries in d-ephemeral already present in d-default or - ;; d-impure. + ;; Remove entries in d-ephemeral already present in d-default (cl-loop for obj being each hash-keys of d-ephemeral-idx - when (or (gethash obj d-default-idx) (gethash obj d-impure-idx)) + when (gethash obj d-default-idx) do (remhash obj d-ephemeral-idx)) ;; Fix-up indexes in each relocation class and fill corresponding ;; reloc lists. - (mapc #'comp--finalize-container (list d-default d-impure d-ephemeral)) + (mapc #'comp--finalize-container (list d-default d-ephemeral)) ;; Make a vector from the function documentation hash table. (cl-loop with h = (comp-ctxt-function-docs comp-ctxt) with v = (make-vector (hash-table-count h) nil) @@ -3302,13 +3286,13 @@ Update all insn accordingly." finally do (setf (comp-ctxt-function-docs comp-ctxt) v)) ;; And now we conclude with the following: We need to pass to - ;; `comp--register-lambda' the index in the impure relocation - ;; array to store revived lambdas, but given we know it only now - ;; we fix it up as last. + ;; `comp--register-lambda' the index in the relocation array to + ;; store revived lambdas, but given we know it only now we fix it up + ;; as last. (cl-loop for f being each hash-keys of (comp-ctxt-lambda-fixups-h comp-ctxt) using (hash-value mvar) with reverse-h = (make-hash-table) ;; Make sure idx is unique. - for idx = (gethash f d-impure-idx) + for idx = (gethash f d-default-idx) do (cl-assert (null (gethash idx reverse-h))) (cl-assert (fixnump idx)) diff --git a/src/comp.c b/src/comp.c index 1631e2b4ce0..f1878a94243 100644 --- a/src/comp.c +++ b/src/comp.c @@ -476,16 +476,13 @@ load_gccjit_if_necessary (bool mandatory) /* C symbols emitted for the load relocation mechanism. */ #define CURRENT_THREAD_RELOC_SYM "current_thread_reloc" #define F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM "f_symbols_with_pos_enabled_reloc" -#define PURE_RELOC_SYM "pure_reloc" #define DATA_RELOC_SYM "d_reloc" -#define DATA_RELOC_IMPURE_SYM "d_reloc_imp" #define DATA_RELOC_EPHEMERAL_SYM "d_reloc_eph" #define FUNC_LINK_TABLE_SYM "freloc_link_table" #define LINK_TABLE_HASH_SYM "freloc_hash" #define COMP_UNIT_SYM "comp_unit" #define TEXT_DATA_RELOC_SYM "text_data_reloc" -#define TEXT_DATA_RELOC_IMPURE_SYM "text_data_reloc_imp" #define TEXT_DATA_RELOC_EPHEMERAL_SYM "text_data_reloc_eph" #define TEXT_OPTIM_QLY_SYM "text_optim_qly" @@ -607,7 +604,6 @@ typedef struct { gcc_jit_type *thread_state_ptr_type; gcc_jit_rvalue *current_thread_ref; /* Other globals. */ - gcc_jit_rvalue *pure_ptr; #ifndef LIBGCCJIT_HAVE_gcc_jit_context_new_bitcast /* This version of libgccjit has really limited support for casting therefore this union will be used for the scope. */ @@ -639,7 +635,6 @@ typedef struct { gcc_jit_function *setcar; gcc_jit_function *setcdr; gcc_jit_function *check_type; - gcc_jit_function *check_impure; gcc_jit_function *maybe_gc_or_quit; Lisp_Object func_blocks_h; /* blk_name -> gcc_block. */ Lisp_Object exported_funcs_h; /* c-func-name -> gcc_jit_function *. */ @@ -647,8 +642,6 @@ typedef struct { Lisp_Object emitter_dispatcher; /* Synthesized struct holding data relocs. */ reloc_array_t data_relocs; - /* Same as before but can't go in pure space. */ - reloc_array_t data_relocs_impure; /* Same as before but content does not survive load phase. */ reloc_array_t data_relocs_ephemeral; /* Global structure holding function relocations. */ @@ -658,7 +651,6 @@ typedef struct { gcc_jit_lvalue *func_relocs_local; gcc_jit_function *memcpy; Lisp_Object d_default_idx; - Lisp_Object d_impure_idx; Lisp_Object d_ephemeral_idx; } comp_t; @@ -696,7 +688,6 @@ helper_sanitizer_assert (Lisp_Object, Lisp_Object); static void *helper_link_table[] = { wrong_type_argument, helper_PSEUDOVECTOR_TYPEP_XUNTAG, - pure_write_error, push_handler, record_unwind_protect_excursion, helper_unbind_n, @@ -923,13 +914,6 @@ obj_to_reloc (Lisp_Object obj) goto found; } - idx = Fgethash (obj, comp.d_impure_idx, Qnil); - if (!NILP (idx)) - { - reloc.array = comp.data_relocs_impure; - goto found; - } - idx = Fgethash (obj, comp.d_ephemeral_idx, Qnil); if (!NILP (idx)) { @@ -1971,28 +1955,6 @@ emit_XSETCDR (gcc_jit_rvalue *c, gcc_jit_rvalue *n) NULL), n); } - -static gcc_jit_rvalue * -emit_PURE_P (gcc_jit_rvalue *ptr) -{ - - emit_comment ("PURE_P"); - - return - gcc_jit_context_new_comparison ( - comp.ctxt, - NULL, - GCC_JIT_COMPARISON_LE, - emit_binary_op ( - GCC_JIT_BINARY_OP_MINUS, - comp.uintptr_type, - ptr, - comp.pure_ptr), - gcc_jit_context_new_rvalue_from_int (comp.ctxt, - comp.uintptr_type, - PURESIZE)); -} - /*************************************/ /* Code emitted by LIMPLE statemes. */ @@ -2909,10 +2871,6 @@ declare_imported_data (void) declare_imported_data_relocs (CALLNI (comp-ctxt-d-default, Vcomp_ctxt), DATA_RELOC_SYM, TEXT_DATA_RELOC_SYM); - comp.data_relocs_impure = - declare_imported_data_relocs (CALLNI (comp-ctxt-d-impure, Vcomp_ctxt), - DATA_RELOC_IMPURE_SYM, - TEXT_DATA_RELOC_IMPURE_SYM); comp.data_relocs_ephemeral = declare_imported_data_relocs (CALLNI (comp-ctxt-d-ephemeral, Vcomp_ctxt), DATA_RELOC_EPHEMERAL_SYM, @@ -2946,8 +2904,6 @@ declare_runtime_imported_funcs (void) args[1] = comp.int_type; ADD_IMPORTED (helper_PSEUDOVECTOR_TYPEP_XUNTAG, comp.bool_type, 2, args); - ADD_IMPORTED (pure_write_error, comp.void_type, 1, NULL); - args[0] = comp.lisp_obj_type; args[1] = comp.int_type; ADD_IMPORTED (push_handler, comp.handler_ptr_type, 2, args); @@ -3023,15 +2979,6 @@ emit_ctxt_code (void) comp.bool_ptr_type, F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM)); - comp.pure_ptr = - gcc_jit_lvalue_as_rvalue ( - gcc_jit_context_new_global ( - comp.ctxt, - NULL, - GCC_JIT_GLOBAL_EXPORTED, - comp.void_ptr_type, - PURE_RELOC_SYM)); - gcc_jit_context_new_global ( comp.ctxt, NULL, @@ -3693,19 +3640,6 @@ define_setcar_setcdr (void) /* CHECK_CONS (cell); */ emit_CHECK_CONS (gcc_jit_param_as_rvalue (cell)); - /* CHECK_IMPURE (cell, XCONS (cell)); */ - gcc_jit_rvalue *args[] = - { gcc_jit_param_as_rvalue (cell), - emit_XCONS (gcc_jit_param_as_rvalue (cell)) }; - - gcc_jit_block_add_eval (entry_block, - NULL, - gcc_jit_context_new_call (comp.ctxt, - NULL, - comp.check_impure, - 2, - args)); - /* XSETCDR (cell, newel); */ if (!i) emit_XSETCAR (gcc_jit_param_as_rvalue (cell), @@ -4009,52 +3943,6 @@ static void define_SYMBOL_WITH_POS_SYM (void) comp.lisp_symbol_with_position_sym)); } -static void -define_CHECK_IMPURE (void) -{ - gcc_jit_param *param[] = - { gcc_jit_context_new_param (comp.ctxt, - NULL, - comp.lisp_obj_type, - "obj"), - gcc_jit_context_new_param (comp.ctxt, - NULL, - comp.void_ptr_type, - "ptr") }; - comp.check_impure = - gcc_jit_context_new_function (comp.ctxt, NULL, - GCC_JIT_FUNCTION_INTERNAL, - comp.void_type, - "CHECK_IMPURE", - 2, - param, - 0); - - DECL_BLOCK (entry_block, comp.check_impure); - DECL_BLOCK (err_block, comp.check_impure); - DECL_BLOCK (ok_block, comp.check_impure); - - comp.block = entry_block; - comp.func = comp.check_impure; - - emit_cond_jump (emit_PURE_P (gcc_jit_param_as_rvalue (param[0])), /* FIXME */ - err_block, - ok_block); - gcc_jit_block_end_with_void_return (ok_block, NULL); - - gcc_jit_rvalue *pure_write_error_arg = - gcc_jit_param_as_rvalue (param[0]); - - comp.block = err_block; - gcc_jit_block_add_eval (comp.block, - NULL, - emit_call (intern_c_string ("pure_write_error"), - comp.void_type, 1,&pure_write_error_arg, - false)); - - gcc_jit_block_end_with_void_return (err_block, NULL); -} - static void define_maybe_gc_or_quit (void) { @@ -4931,9 +4819,7 @@ DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0, #endif comp.d_default_idx = - CALLNI (comp-data-container-idx, CALLNI (comp-ctxt-d-default, Vcomp_ctxt)); - comp.d_impure_idx = - CALLNI (comp-data-container-idx, CALLNI (comp-ctxt-d-impure, Vcomp_ctxt)); + CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-default, Vcomp_ctxt)); comp.d_ephemeral_idx = CALLNI (comp-data-container-idx, CALLNI (comp-ctxt-d-ephemeral, Vcomp_ctxt)); @@ -5265,17 +5151,12 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) { dynlib_handle_ptr handle = comp_u->handle; Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); - Lisp_Object *data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM); EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec)); - for (ptrdiff_t i = 0; i < d_vec_len; i++) - if (!EQ (data_relocs[i], AREF (comp_u->data_vec, i))) - return false; - d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec)); for (ptrdiff_t i = 0; i < d_vec_len; i++) { - Lisp_Object x = data_imp_relocs[i]; + Lisp_Object x = data_relocs[i]; if (EQ (x, Qlambda_fixup)) return false; else if (NATIVE_COMP_FUNCTIONP (x)) @@ -5283,7 +5164,7 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) if (NILP (Fgethash (x, comp_u->lambda_gc_guard_h, Qnil))) return false; } - else if (!EQ (x, AREF (comp_u->data_impure_vec, i))) + else if (!EQ (x, AREF (comp_u->data_vec, i))) return false; } return true; @@ -5347,7 +5228,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, /* Always set data_imp_relocs pointer in the compilation unit (in can be used in 'dump_do_dump_relocation'). */ - comp_u->data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM); + comp_u->data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); if (!comp_u->loaded_once) { @@ -5355,16 +5236,12 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM); bool **f_symbols_with_pos_enabled_reloc = dynlib_sym (handle, F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM); - void **pure_reloc = dynlib_sym (handle, PURE_RELOC_SYM); - Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); - Lisp_Object *data_imp_relocs = comp_u->data_imp_relocs; + Lisp_Object *data_relocs = comp_u->data_relocs; void **freloc_link_table = dynlib_sym (handle, FUNC_LINK_TABLE_SYM); if (!(current_thread_reloc && f_symbols_with_pos_enabled_reloc - && pure_reloc && data_relocs - && data_imp_relocs && data_eph_relocs && freloc_link_table && top_level_run) @@ -5374,7 +5251,6 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, *current_thread_reloc = ¤t_thread; *f_symbols_with_pos_enabled_reloc = &symbols_with_pos_enabled; - *pure_reloc = pure; /* Imported functions. */ *freloc_link_table = freloc.link_table; @@ -5385,21 +5261,11 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, comp_u->optimize_qualities = load_static_obj (comp_u, TEXT_OPTIM_QLY_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); - - if (!NILP (Vpurify_flag)) - /* Non impure can be copied into pure space. */ - comp_u->data_vec = Fpurecopy (comp_u->data_vec); } 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_imp_relocs[i] = AREF (comp_u->data_impure_vec, i); } if (!loading_dump) @@ -5555,7 +5421,7 @@ This gets called by top_level_run during the load phase. */) eassert (NILP (Fgethash (c_name, cu->lambda_c_name_idx_h, Qnil))); Fputhash (c_name, reloc_idx, cu->lambda_c_name_idx_h); /* Do the real relocation fixup. */ - cu->data_imp_relocs[XFIXNUM (reloc_idx)] = tem; + cu->data_relocs[XFIXNUM (reloc_idx)] = tem; return tem; } @@ -5737,7 +5603,6 @@ natively-compiled one. */); /* Allocation classes. */ DEFSYM (Qd_default, "d-default"); - DEFSYM (Qd_impure, "d-impure"); DEFSYM (Qd_ephemeral, "d-ephemeral"); /* Others. */ diff --git a/src/comp.h b/src/comp.h index 8525f8ee44f..b4edc4ad371 100644 --- a/src/comp.h +++ b/src/comp.h @@ -35,17 +35,15 @@ struct Lisp_Native_Comp_Unit /* Guard anonymous lambdas against Garbage Collection and serve sanity checks. */ Lisp_Object lambda_gc_guard_h; - /* Hash c_name -> d_reloc_imp index. */ + /* Hash c_name -> d_reloc index. */ Lisp_Object lambda_c_name_idx_h; /* Hash doc-idx -> function documentation. */ Lisp_Object data_fdoc_v; - /* Analogous to the constant vector but per compilation unit. */ + /* Analogous to the constant vector but per compilation unit. Must be + last. */ Lisp_Object data_vec; - /* 'data_impure_vec' must be last (see allocate_native_comp_unit). - Same as data_vec but for data that cannot be moved to pure space. */ - Lisp_Object data_impure_vec; /* STUFFS WE DO NOT DUMP!! */ - Lisp_Object *data_imp_relocs; + Lisp_Object *data_relocs; bool loaded_once; bool load_ongoing; dynlib_handle_ptr handle; diff --git a/src/lisp.h b/src/lisp.h index 0a44a3c029b..966568e92cf 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5502,7 +5502,7 @@ INLINE struct Lisp_Native_Comp_Unit * allocate_native_comp_unit (void) { return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit, - data_impure_vec, PVEC_NATIVE_COMP_UNIT); + data_vec, PVEC_NATIVE_COMP_UNIT); } #else INLINE bool diff --git a/src/pdumper.c b/src/pdumper.c index 830e3630cdb..ab6524330be 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5457,12 +5457,12 @@ dump_do_dump_relocation (const uintptr_t dump_base, if (!NILP (lambda_data_idx)) { /* This is an anonymous lambda. - We must fixup d_reloc_imp so the lambda can be referenced + We must fixup d_reloc so the lambda can be referenced by code. */ Lisp_Object tem; XSETSUBR (tem, subr); Lisp_Object *fixup = - &(comp_u->data_imp_relocs[XFIXNUM (lambda_data_idx)]); + &(comp_u->data_relocs[XFIXNUM (lambda_data_idx)]); eassert (EQ (*fixup, Qlambda_fixup)); *fixup = tem; Fputhash (tem, Qt, comp_u->lambda_gc_guard_h); -- 2.39.5