From afd61deaaeb5e5e6845bdf995ac5ee9a3479599c Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 19:04:44 +0000 Subject: Pure storage removal: Remove purecopy hash table flag * lisp/emacs-liqsp/comp.el (comp--jump-table-optimizable): Adjust comment. * src/category.c (hash_get_category_set): * src/emacs-module.c (syms_of_module): * src/fns.c (make_hash_table): Remove 'purecopy' flag and update docstring. (Fmake_hash_table): Ignore ':purecopy' argument. * src/frame.c (make_frame): * src/image.c (xpm_make_color_table_h): * src/lisp.h (struct Lisp_Hash_Table): Drop 'purecopy' flag. * src/pdumper.c (dump_hash_table): Don't dump 'purecopy' flag. * src/print.c (print_object): Don't print 'purecopy' flag * src/json.c (json_parse_object): * src/lread.c (readevalloop, read_internal_start): * src/pgtkterm.c (syms_of_pgtkterm): * src/profiler.c (export_log): * src/xfaces.c (syms_of_xfaces): * src/xterm.c (syms_of_xterm): Adjust calls to 'make_hash_table'. --- lisp/emacs-lisp/comp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2966ed255ac..aea38c60d41 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1190,7 +1190,7 @@ Return value is the fall-through block name." (defun comp--jump-table-optimizable (jmp-table) "Return t if JMP-TABLE can be optimized out." ;; Identify LAP sequences like: - ;; (byte-constant #s(hash-table test eq purecopy t data (created 126 deleted 126 changed 126)) . 24) + ;; (byte-constant #s(hash-table test eq data (created 126 deleted 126 changed 126)) . 24) ;; (byte-switch) ;; (TAG 126 . 10) (let ((targets (hash-table-values jmp-table))) -- cgit v1.2.3 From bd2b59f07337c4f5980666875207bf877634b1b3 Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 19:09:14 +0000 Subject: 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. --- lisp/emacs-lisp/comp.el | 36 ++++-------- src/comp.c | 145 ++---------------------------------------------- src/comp.h | 10 ++-- src/lisp.h | 2 +- src/pdumper.c | 4 +- 5 files changed, 22 insertions(+), 175 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index aea38c60d41..dbd14b2740d 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 e43732f369e..5e8b49f7ffc 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" @@ -619,7 +616,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. */ @@ -651,7 +647,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 *. */ @@ -659,8 +654,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. */ @@ -670,7 +663,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; @@ -708,7 +700,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, @@ -939,13 +930,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)) { @@ -1987,28 +1971,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. */ @@ -2925,10 +2887,6 @@ declare_imported_data (void) declare_imported_data_relocs (CALL1I (comp-ctxt-d-default, 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); comp.data_relocs_ephemeral = declare_imported_data_relocs (CALL1I (comp-ctxt-d-ephemeral, Vcomp_ctxt), DATA_RELOC_EPHEMERAL_SYM, @@ -2962,8 +2920,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); @@ -3039,15 +2995,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, @@ -3709,19 +3656,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), @@ -4025,52 +3959,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) { @@ -4948,8 +4836,6 @@ DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0, comp.d_default_idx = CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-default, Vcomp_ctxt)); - comp.d_impure_idx = - CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-impure, Vcomp_ctxt)); comp.d_ephemeral_idx = CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-ephemeral, Vcomp_ctxt)); @@ -5281,17 +5167,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)) @@ -5299,7 +5180,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; @@ -5363,7 +5244,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) { @@ -5371,16 +5252,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) @@ -5390,7 +5267,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; @@ -5401,21 +5277,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) @@ -5567,7 +5433,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; } @@ -5749,7 +5615,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 158ed0b46df..2a60cb38955 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 5ebbe4f9860..695d5f200ea 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5498,7 +5498,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 5bd0d8ca44a..40798ff48e9 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5498,12 +5498,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); -- cgit v1.2.3 From 5b471384d1805bfb9e78314f8cb1f4d09aa378f7 Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Wed, 21 Aug 2024 19:13:23 +0000 Subject: Purecopy removal: Lisp code * lisp/emacs-lisp/bytecomp.el (byte-compile-cond-jump-table): Don't request our hash tables be purecopied. Adjust comment. * lisp/progmodes/elisp-mode.el (elisp--local-variables-completion-table): Use 'defconst' rather than 'defvar' now the purespace problem is gone * lisp/rfn-eshadow.el (file-name-shadow-properties): Remove obsolete comment. --- lisp/emacs-lisp/bytecomp.el | 3 +-- lisp/progmodes/elisp-mode.el | 6 +----- lisp/rfn-eshadow.el | 1 - 3 files changed, 2 insertions(+), 8 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f058fc48cc7..11f2ffa6063 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4640,13 +4640,12 @@ Return (TAIL VAR TEST CASES), where: cases)))) (setq jump-table (make-hash-table :test test - :purecopy t :size nvalues))) (setq default-tag (byte-compile-make-tag)) ;; The structure of byte-switch code: ;; ;; varref var - ;; constant #s(hash-table purecopy t data (val1 (TAG1) val2 (TAG2))) + ;; constant #s(hash-table data (val1 (TAG1) val2 (TAG2))) ;; switch ;; goto DEFAULT-TAG ;; TAG1 diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 2b6d9d2b8bb..c24a1f4672b 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -489,11 +489,7 @@ use of `macroexpand-all' as a way to find the \"underlying raw code\".") var)) vars)))))) -(defvar elisp--local-variables-completion-table - ;; Use `defvar' rather than `defconst' since defconst would purecopy this - ;; value, which would doubly fail: it would fail because purecopy can't - ;; handle the recursive bytecode object, and it would fail because it would - ;; move `lastpos' and `lastvars' to pure space where they'd be immutable! +(defconst elisp--local-variables-completion-table (let ((lastpos nil) (lastvars nil)) (letrec ((hookfun (lambda () (setq lastpos nil) diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el index 5cf483bf0b1..c1e0e3da22b 100644 --- a/lisp/rfn-eshadow.el +++ b/lisp/rfn-eshadow.el @@ -92,7 +92,6 @@ (sexp :tag "Value"))))) (defcustom file-name-shadow-properties - ;; FIXME: should we purecopy this? '(face file-name-shadow field shadow) "Properties given to the `shadowed' part of a filename in the minibuffer. Only used when `file-name-shadow-mode' is active. -- cgit v1.2.3 From 8da7086be6d0b0387c3ffbede062c4349045af70 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 9 Dec 2024 21:17:09 +0100 Subject: Don't call purecopy in emacs-lisp/*.el * lisp/emacs-lisp/byte-run.el (define-obsolete-face-alias) (make-obsolete-variable, make-obsolete): * lisp/emacs-lisp/cl-extra.el (cl-type-definition): * lisp/emacs-lisp/cl-preloaded.el (cl-assertion-failed): * lisp/emacs-lisp/cl-print.el (help-byte-code): * lisp/emacs-lisp/derived.el (define-derived-mode): * lisp/emacs-lisp/easy-mmode.el (define-minor-mode): * lisp/emacs-lisp/eldoc.el (eldoc-minor-mode-string): * lisp/emacs-lisp/gv.el (make-obsolete-generalized-variable): * lisp/emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression): * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--parse-file): * lisp/emacs-lisp/warnings.el (warning-type-format): Remove calls to purecopy. --- lisp/emacs-lisp/byte-run.el | 6 +-- lisp/emacs-lisp/cl-extra.el | 2 +- lisp/emacs-lisp/cl-preloaded.el | 2 +- lisp/emacs-lisp/cl-print.el | 2 +- lisp/emacs-lisp/derived.el | 6 +-- lisp/emacs-lisp/easy-mmode.el | 2 +- lisp/emacs-lisp/eldoc.el | 2 +- lisp/emacs-lisp/gv.el | 2 +- lisp/emacs-lisp/lisp-mode.el | 110 ++++++++++++++++++++-------------------- lisp/emacs-lisp/loaddefs-gen.el | 2 +- lisp/emacs-lisp/warnings.el | 2 +- 11 files changed, 69 insertions(+), 69 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index f1486f70634..c6ed967c893 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -543,7 +543,7 @@ was first made obsolete, for example a date or a release number." (put obsolete-name 'byte-obsolete-info ;; The second entry used to hold the `byte-compile' handler, but ;; is not used any more nowadays. - (purecopy (list current-name nil when))) + (list current-name nil when)) obsolete-name) (defmacro define-obsolete-function-alias ( obsolete-name current-name when @@ -578,7 +578,7 @@ ACCESS-TYPE if non-nil should specify the kind of access that will trigger obsolescence warnings; it can be either `get' or `set'." (byte-run--constant-obsolete-warning obsolete-name) (put obsolete-name 'byte-obsolete-variable - (purecopy (list current-name access-type when))) + (list current-name access-type when)) obsolete-name) (defmacro define-obsolete-variable-alias ( obsolete-name current-name when @@ -633,7 +633,7 @@ obsolete, for example a date or a release number." `(progn (put ,obsolete-face 'face-alias ,current-face) ;; Used by M-x describe-face. - (put ,obsolete-face 'obsolete-face (or (purecopy ,when) t)))) + (put ,obsolete-face 'obsolete-face (or ,when t)))) (defmacro dont-compile (&rest body) "Like `progn', but the body always runs interpreted (not compiled). diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 4108512b3fa..8d06b0712b4 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -722,7 +722,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (define-button-type 'cl-type-definition :supertype 'help-function-def - 'help-echo (purecopy "mouse-2, RET: find type definition")) + 'help-echo "mouse-2, RET: find type definition") (declare-function help-fns-short-filename "help-fns" (filename)) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 4b1bd2a9aff..7432cd6e4ce 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -41,7 +41,7 @@ ;; The `assert' macro from the cl package signals ;; `cl-assertion-failed' at runtime so always define it. -(define-error 'cl-assertion-failed (purecopy "Assertion failed")) +(define-error 'cl-assertion-failed "Assertion failed") (defun cl--assertion-failed (form &optional string sargs args) (if debug-on-error diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index e8e6502e66f..0d96f87b3b3 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -160,7 +160,7 @@ Print the contents hidden by the ellipsis to STREAM." 'follow-link t 'action (lambda (button) (disassemble (button-get button 'byte-code-function))) - 'help-echo (purecopy "mouse-2, RET: disassemble this function")) + 'help-echo "mouse-2, RET: disassemble this function") (defvar cl-print-compiled nil "Control how to print byte-compiled functions. diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 2423426dca0..cc733c312cc 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -220,7 +220,7 @@ No problems result if this variable is not bound. (with-no-warnings (defvar ,map (make-sparse-keymap))) (unless (get ',map 'variable-documentation) (put ',map 'variable-documentation - (purecopy ,(format "Keymap for `%s'." child)))) + ,(format "Keymap for `%s'." child))) ,(if declare-syntax `(progn (defvar ,syntax) @@ -229,7 +229,7 @@ No problems result if this variable is not bound. (defvar ,syntax (make-syntax-table))) (unless (get ',syntax 'variable-documentation) (put ',syntax 'variable-documentation - (purecopy ,(format "Syntax table for `%s'." child)))))) + ,(format "Syntax table for `%s'." child))))) ,(if declare-abbrev `(progn (defvar ,abbrev) @@ -239,7 +239,7 @@ No problems result if this variable is not bound. (progn (define-abbrev-table ',abbrev nil) ,abbrev))) (unless (get ',abbrev 'variable-documentation) (put ',abbrev 'variable-documentation - (purecopy ,(format "Abbrev table for `%s'." child)))))) + ,(format "Abbrev table for `%s'." child))))) (if (fboundp 'derived-mode-set-parent) ;; Emacsā‰„30.1 (derived-mode-set-parent ',child ',parent) (put ',child 'derived-mode-parent ',parent)) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 9c429828b13..73ab5bbed6c 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -269,7 +269,7 @@ INIT-VALUE LIGHTER KEYMAP. (setq body (cdr body)) (pcase keyw (:init-value (setq init-value (pop body))) - (:lighter (setq lighter (purecopy (pop body)))) + (:lighter (setq lighter (pop body))) (:global (setq globalp (pop body)) (when (and globalp (symbolp mode)) (setq setter `(setq-default ,mode)) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 417c0145be4..aa1871ac482 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -78,7 +78,7 @@ If nil, truncated messages will just have \"...\" to indicate truncation." :version "28.1") ;;;###autoload -(defcustom eldoc-minor-mode-string (purecopy " ElDoc") +(defcustom eldoc-minor-mode-string " ElDoc" "String to display in mode line when ElDoc Mode is enabled; nil for none." :type '(choice string (const :tag "None" nil))) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index fa9b437fcfd..cce15faa1e0 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -182,7 +182,7 @@ If CURRENT-NAME is a string, that is the `use instead' message. WHEN should be a string indicating when the variable was first made obsolete, for example a date or a release number." (put obsolete-name 'byte-obsolete-generalized-variable - (purecopy (list current-name when))) + (list current-name when)) obsolete-name) ;; Additions for `declare'. We specify the values as named aliases so diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 4b89eb91387..dddeb8f53d9 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -94,68 +94,68 @@ (defvar lisp-imenu-generic-expression (list (list nil - (purecopy (concat "^\\s-*(" - (regexp-opt - '("defun" "defmacro" - ;; Elisp. - "defun*" "defsubst" "define-inline" - "define-advice" "defadvice" "define-skeleton" - "define-compilation-mode" "define-minor-mode" - "define-global-minor-mode" - "define-globalized-minor-mode" - "define-derived-mode" "define-generic-mode" - "ert-deftest" - "cl-defun" "cl-defsubst" "cl-defmacro" - "cl-define-compiler-macro" "cl-defgeneric" - "cl-defmethod" - ;; CL. - "define-compiler-macro" "define-modify-macro" - "defsetf" "define-setf-expander" - "define-method-combination" - ;; CLOS and EIEIO - "defgeneric" "defmethod") - t) - "\\s-+\\(" (rx lisp-mode-symbol) "\\)")) + (concat "^\\s-*(" + (regexp-opt + '("defun" "defmacro" + ;; Elisp. + "defun*" "defsubst" "define-inline" + "define-advice" "defadvice" "define-skeleton" + "define-compilation-mode" "define-minor-mode" + "define-global-minor-mode" + "define-globalized-minor-mode" + "define-derived-mode" "define-generic-mode" + "ert-deftest" + "cl-defun" "cl-defsubst" "cl-defmacro" + "cl-define-compiler-macro" "cl-defgeneric" + "cl-defmethod" + ;; CL. + "define-compiler-macro" "define-modify-macro" + "defsetf" "define-setf-expander" + "define-method-combination" + ;; CLOS and EIEIO + "defgeneric" "defmethod") + t) + "\\s-+\\(" (rx lisp-mode-symbol) "\\)") 2) ;; Like the previous, but uses a quoted symbol as the name. (list nil - (purecopy (concat "^\\s-*(" - (regexp-opt - '("defalias" "define-obsolete-function-alias") - t) - "\\s-+'\\(" (rx lisp-mode-symbol) "\\)")) + (concat "^\\s-*(" + (regexp-opt + '("defalias" "define-obsolete-function-alias") + t) + "\\s-+'\\(" (rx lisp-mode-symbol) "\\)") 2) - (list (purecopy "Variables") - (purecopy (concat "^\\s-*(" - (regexp-opt - '(;; Elisp - "defconst" "defcustom" "defvar-keymap" - ;; CL - "defconstant" - "defparameter" "define-symbol-macro") - t) - "\\s-+\\(" (rx lisp-mode-symbol) "\\)")) + (list "Variables" + (concat "^\\s-*(" + (regexp-opt + '(;; Elisp + "defconst" "defcustom" "defvar-keymap" + ;; CL + "defconstant" + "defparameter" "define-symbol-macro") + t) + "\\s-+\\(" (rx lisp-mode-symbol) "\\)") 2) ;; For `defvar'/`defvar-local', we ignore (defvar FOO) constructs. - (list (purecopy "Variables") - (purecopy (concat "^\\s-*(defvar\\(?:-local\\)?\\s-+\\(" - (rx lisp-mode-symbol) "\\)" - "[[:space:]\n]+[^)]")) + (list "Variables" + (concat "^\\s-*(defvar\\(?:-local\\)?\\s-+\\(" + (rx lisp-mode-symbol) "\\)" + "[[:space:]\n]+[^)]") 1) - (list (purecopy "Types") - (purecopy (concat "^\\s-*(" - (regexp-opt - '(;; Elisp - "defgroup" "deftheme" - "define-widget" "define-error" - "defface" "cl-deftype" "cl-defstruct" - ;; CL - "deftype" "defstruct" - "define-condition" "defpackage" - ;; CLOS and EIEIO - "defclass") - t) - "\\s-+'?\\(" (rx lisp-mode-symbol) "\\)")) + (list "Types" + (concat "^\\s-*(" + (regexp-opt + '(;; Elisp + "defgroup" "deftheme" + "define-widget" "define-error" + "defface" "cl-deftype" "cl-defstruct" + ;; CL + "deftype" "defstruct" + "define-condition" "defpackage" + ;; CLOS and EIEIO + "defclass") + t) + "\\s-+'?\\(" (rx lisp-mode-symbol) "\\)") 2)) "Imenu generic expression for Lisp mode. See `imenu-generic-expression'.") diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 6e843f741d8..5578e10abf2 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -441,7 +441,7 @@ don't include." (file-name-sans-extension (file-name-nondirectory file))))) (push (list (or local-outfile main-outfile) file - `(push (purecopy ',(cons (intern package) version)) + `(push ',(cons (intern package) version) package--builtin-versions)) defs)))) diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index b11e1ebeb70..192d2331bcc 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -172,7 +172,7 @@ also call that function before the next warning.") ;; safely, testing the existing value, before they call one of the ;; warnings functions. ;;;###autoload -(defvar warning-type-format (purecopy " (%s)") +(defvar warning-type-format " (%s)" "Format for displaying the warning type in the warning message. The result of formatting the type this way gets included in the message under the control of the string in `warning-levels'.") -- cgit v1.2.3 From bb64e9464c584bace441f60678b80f41ddc6e2a3 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 9 Dec 2024 21:34:57 +0100 Subject: Remove purespace fix from cl-preloaded.el * lisp/emacs-lisp/cl-preloaded.el (cl-struct-define): Remove fix for purespace. This effectively reverts Stefan Monnier's commit e785c74d3a88. --- lisp/emacs-lisp/cl-preloaded.el | 15 +-------------- 1 file changed, 1 insertion(+), 14 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 7432cd6e4ce..f693b277a60 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -183,20 +183,7 @@ (add-to-list 'current-load-list `(define-type . ,name)) (cl--struct-register-child parent-class tag) (unless (or (eq named t) (eq tag name)) - ;; We used to use `defconst' instead of `set' but that - ;; has a side-effect of purecopying during the dump, so that the - ;; class object stored in the tag ends up being a *copy* of the - ;; one stored in the `cl--class' property! We could have fixed - ;; this needless duplication by using the purecopied object, but - ;; that then breaks down a bit later when we modify the - ;; cl-structure-class class object to close the recursion - ;; between cl-structure-object and cl-structure-class (because - ;; modifying purecopied objects is not allowed. Since this is - ;; done during dumping, we could relax this rule and allow the - ;; modification, but it's cumbersome). - ;; So in the end, it's easier to just avoid the duplication by - ;; avoiding the use of the purespace here. - (set tag class) + (eval `(defconst ,tag ',class) t) ;; In the cl-generic support, we need to be able to check ;; if a vector is a cl-struct object, without knowing its particular type. ;; So we use the (otherwise) unused function slots of the tag symbol -- cgit v1.2.3 From 52dcc032067381f50d658dc43bf7088f1782c7af Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 10 Dec 2024 12:34:34 +0100 Subject: Delete workaround for purespace in cl-generic * lisp/emacs-lisp/cl-generic.el (cl-generic-define-method): Delete purespace workaround. --- lisp/emacs-lisp/cl-generic.el | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 11685d09d12..96f585df0c5 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -654,11 +654,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (symbol-function sym))) ;; Prevent `defalias' from recording this as the definition site of ;; the generic function. - current-load-list - ;; BEWARE! Don't purify this function definition, since that leads - ;; to memory corruption if the hash-tables it holds are modified - ;; (the GC doesn't trace those pointers). - (purify-flag nil)) + current-load-list) (when (listp old-adv-cc) (set-advertised-calling-convention gfun old-adv-cc nil)) ;; But do use `defalias', so that it interacts properly with nadvice, -- cgit v1.2.3 From d6b05b128280cc23dc77a1a06194c4e69d1ac519 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 10 Dec 2024 19:39:03 +0100 Subject: Make 'purecopy' an obsolete function alias for 'identity' * lisp/subr.el (purecopy): New obsolete function alias for 'identity'. * src/alloc.c (purecopy): Remove function. (Fpurecopy): Remove DEFUN. (syms_of_alloc): Remove defsubr for above DEFUN. * lisp/loadup.el (purify-flag): Don't set to hash table. * doc/lispref/spellfile: * doc/lispref/keymaps.texi (Tool Bar): * lisp/emacs-lisp/byte-opt.el (side-effect-free-fns): Delete references to 'purecopy' --- doc/lispref/keymaps.texi | 2 +- doc/lispref/spellfile | 1 - etc/NEWS | 3 +++ lisp/emacs-lisp/byte-opt.el | 2 +- lisp/loadup.el | 25 ++----------------------- lisp/subr.el | 2 ++ src/alloc.c | 37 ------------------------------------- 7 files changed, 9 insertions(+), 63 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 87723720b1e..878f51555c1 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -3056,7 +3056,7 @@ By default, the global map binds @code{[tool-bar]} as follows: @example (keymap-global-set "" - `(menu-item ,(purecopy "tool bar") ignore + '(menu-item "tool bar" ignore :filter tool-bar-make-keymap)) @end example diff --git a/doc/lispref/spellfile b/doc/lispref/spellfile index 11a6ce813af..d1875b464c6 100644 --- a/doc/lispref/spellfile +++ b/doc/lispref/spellfile @@ -418,7 +418,6 @@ ps psf psychotherapy pty -purecopy qu quux rassq diff --git a/etc/NEWS b/etc/NEWS index f00b2cd7bee..945882e00c8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -883,6 +883,9 @@ restore the old behavior, you can set 'eshell-pwd-convert-function' to * Lisp Changes in Emacs 31.1 ++++ +** The function 'purecopy' is now an obsolete alias for 'identity'. + --- ** New function 'native-compile-directory'. This function natively-compiles all Lisp files in a directory and in its diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 0a89a33cbc3..217445e9d15 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1859,7 +1859,7 @@ See Info node `(elisp) Integer Basics'." (side-effect-and-error-free-fns '( ;; alloc.c - bool-vector cons list make-marker purecopy record vector + bool-vector cons list make-marker record vector ;; buffer.c buffer-list buffer-live-p current-buffer overlay-lists overlayp ;; casetab.c diff --git a/lisp/loadup.el b/lisp/loadup.el index 1ba25d967b5..74fbc2372ab 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -105,10 +105,6 @@ ;; than usual. (setq max-lisp-eval-depth (max max-lisp-eval-depth 3400)))) -(if (eq t purify-flag) - ;; Hash consing saved around 11% of pure space in my tests. - (setq purify-flag (make-hash-table :test #'equal :size 80000))) - (message "Using load-path %s" load-path) (if dump-mode @@ -565,25 +561,8 @@ directory got moved. This is set to be a pair in the form of: ;; file-local variables. (defvar comp--no-native-compile (make-hash-table :test #'equal))) -(when (hash-table-p purify-flag) - (let ((strings 0) - (vectors 0) - (bytecodes 0) - (conses 0) - (others 0)) - (maphash (lambda (k v) - (cond - ((stringp k) (setq strings (1+ strings))) - ((vectorp k) (setq vectors (1+ vectors))) - ((consp k) (setq conses (1+ conses))) - ((byte-code-function-p v) (setq bytecodes (1+ bytecodes))) - (t (setq others (1+ others))))) - purify-flag) - (message "Pure-hashed: %d strings, %d vectors, %d conses, %d bytecodes, %d others" - strings vectors conses bytecodes others))) - -;; Avoid error if user loads some more libraries now and make sure the -;; hash-consing hash table is GC'd. + +;; Avoid error if user loads some more libraries now. (setq purify-flag nil) (if (null (garbage-collect)) diff --git a/lisp/subr.el b/lisp/subr.el index c72e6eb0b0e..0c54393494c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2042,6 +2042,8 @@ instead; it will indirectly limit the specpdl stack size as well.") (define-obsolete-function-alias 'fetch-bytecode #'ignore "30.1") +(define-obsolete-function-alias 'purecopy #'identity "31.1") + ;;;; Alternate names for functions - these are not being phased out. diff --git a/src/alloc.c b/src/alloc.c index 5e2747af1f0..82d1a3a9891 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5585,42 +5585,6 @@ hash_table_free_bytes (void *p, ptrdiff_t nbytes) xfree (p); } - -static Lisp_Object purecopy (Lisp_Object obj); - -DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, - doc: /* Make a copy of object OBJ in pure storage. -Recursively copies contents of vectors and cons cells. -Does not copy symbols. Copies strings without text properties. */) - (register Lisp_Object obj) -{ - if (NILP (Vpurify_flag)) - return obj; - else if (MARKERP (obj) || OVERLAYP (obj) || SYMBOLP (obj)) - /* Can't purify those. */ - return obj; - else - return purecopy (obj); -} - -static Lisp_Object -purecopy (Lisp_Object obj) -{ - if (FIXNUMP (obj) || SUBRP (obj)) - return obj; /* No need to hash. */ - - if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */ - { - Lisp_Object tmp = Fgethash (obj, Vpurify_flag, Qnil); - if (!NILP (tmp)) - return tmp; - Fputhash (obj, obj, Vpurify_flag); - } - - return obj; -} - - /*********************************************************************** Protection from GC @@ -7748,7 +7712,6 @@ N should be nonnegative. */); defsubr (&Smake_symbol); defsubr (&Smake_marker); defsubr (&Smake_finalizer); - defsubr (&Spurecopy); defsubr (&Sgarbage_collect); defsubr (&Sgarbage_collect_maybe); defsubr (&Smemory_info); -- cgit v1.2.3 From c729d224ca7bd55d9f49af9d730af45663a3f3d5 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 15 Dec 2024 19:15:29 +0100 Subject: Remove some more references to pure space * lisp/auth-source.el (read-passwd-map): * lisp/emacs-lisp/eldoc.el (eldoc-message-commands) (eldoc-last-data): Remove some references to pure space. --- lisp/auth-source.el | 2 -- lisp/emacs-lisp/eldoc.el | 2 -- 2 files changed, 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 1e0cde75583..d445c339571 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -2515,8 +2515,6 @@ Adapt also mode line." (read-passwd--hide-password))))) (defvar read-passwd-map - ;; BEWARE: `defconst' would purecopy it, breaking the sharing with - ;; minibuffer-local-map along the way! (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570 diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index aa1871ac482..f412a38d6f5 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -154,7 +154,6 @@ this file since the obarray is initialized at load time. Remember to keep it a prime number to improve hash performance.") (defvar eldoc-message-commands - ;; Don't define as `defconst' since it would then go to (read-only) purespace. (obarray-make eldoc-message-commands-table-size) "Commands after which it is appropriate to print in the echo area. ElDoc does not try to print function arglists, etc., after just any command, @@ -166,7 +165,6 @@ directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'.") ;; Not a constant. (defvar eldoc-last-data (make-vector 3 nil) - ;; Don't define as `defconst' since it would then go to (read-only) purespace. "Bookkeeping; elements are as follows: 0 - contains the last symbol read from the buffer. 1 - contains the string last displayed in the echo area for variables, -- cgit v1.2.3 From b86e4747e66febd400055cb6279238fb95f8a59d Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 18 Dec 2024 21:58:15 +0100 Subject: * Make again `comp--finalize-container' compilable * lisp/emacs-lisp/comp.el (comp--finalize-container): Don't emit '--lambda-fixup' immediate in data relocations. --- lisp/emacs-lisp/comp.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index dbd14b2740d..ab6fd77f11a 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3254,7 +3254,10 @@ Set it into the `type' slot." ;; from the corresponding m-var. collect (if (gethash obj (comp-ctxt-byte-func-to-func-h comp-ctxt)) - 'lambda-fixup + ;; Hack not to have `--lambda-fixup' in + ;; data relocations as it would trigger the + ;; check in 'check_comp_unit_relocs'. + (intern (concat (make-string 1 ?-) "-lambda-fixup")) obj)))) (defun comp--finalize-relocs () -- cgit v1.2.3