From: Pip Cet Date: Sat, 18 Jan 2025 20:55:18 +0000 (+0000) Subject: Use #$ for lambda fixups in native compilation data vectors X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=95fe14eaff936bdeb365369324e37cc97dd376cf;p=emacs.git Use #$ for lambda fixups in native compilation data vectors The "#$" syntax is recognized by Fread, which substitutes Vload_file_name in its place. If Vload_file_name is bound appropriately, no other value can produce an object EQ to the one produced by "#$". We use this to check the data vector for entries that we know should have been initialized: if the value is still equal to what we bound Vload_file_name to when it was read, it wasn't initialized, and we abort. * lisp/emacs-lisp/comp.el (comp--#$): New defvar. (comp--finalize-container): Use it. * src/comp.c (ABI_VERSION): Bump. (emit_static_object): Ensure 'comp--#$' prints as "#$". (load_static_obj): Ensure '#$' reads as Vcomp__hashdollar. (check_comp_unit_relocs): Adjust assertion. (syms_of_comp): Define 'comp--#$'. * src/pdumper.c (dump_do_dump_relocation): Adjust assertion. (cherry picked from commit 4eabfd68c91185909be307435e5db8b8f0fb4102) --- diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index f7e81b157a9..248a1a9aa04 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -42,6 +42,7 @@ (defvar comp-subr-arities-h) (defvar native-comp-eln-load-path) (defvar native-comp-enable-subr-trampolines) +(defvar comp--\#$) (declare-function comp--compile-ctxt-to-file0 "comp.c") (declare-function comp--init-ctxt "comp.c") @@ -3254,10 +3255,9 @@ Set it into the `type' slot." ;; from the corresponding m-var. collect (if (gethash obj (comp-ctxt-byte-func-to-func-h comp-ctxt)) - ;; 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")) + ;; This prints as #$, so we can assert this + ;; value does not remain in the data vector + comp--\#$ obj)))) (defun comp--finalize-relocs () diff --git a/src/comp.c b/src/comp.c index 7f31f3652a1..13fb651b930 100644 --- a/src/comp.c +++ b/src/comp.c @@ -468,7 +468,7 @@ load_gccjit_if_necessary (bool mandatory) /* Increase this number to force a new Vcomp_abi_hash to be generated. */ -#define ABI_VERSION "9" +#define ABI_VERSION "10" /* Length of the hashes used for eln file naming. */ #define HASH_LENGTH 8 @@ -2666,6 +2666,12 @@ emit_static_object (const char *name, Lisp_Object obj) specbind (intern_c_string ("print-quoted"), Qt); specbind (intern_c_string ("print-gensym"), Qt); specbind (intern_c_string ("print-circle"), Qt); + /* Bind print-number-table and print-continuous-numbering so comp--#$ + prints as #$. */ + Lisp_Object print_number_table = CALLN (Fmake_hash_table, QCtest, Qeq); + Fputhash (Vcomp__hashdollar, build_string ("#$") , print_number_table); + specbind (intern_c_string ("print-number-table"), print_number_table); + specbind (intern_c_string ("print-continuous-numbering"), Qt); Lisp_Object str = Fprin1_to_string (obj, Qnil, Qnil); unbind_to (count, Qnil); @@ -5129,18 +5135,25 @@ typedef char *(*comp_lit_str_func) (void); static Lisp_Object load_static_obj (struct Lisp_Native_Comp_Unit *comp_u, const char *name) { + specpdl_ref count = SPECPDL_INDEX (); static_obj_t *blob = dynlib_sym (comp_u->handle, format_string ("%s_blob", name)); + /* Special value so we can recognize #$, which is used for entries in + the static vector that must be overwritten at load time. This is a + specific string that contains "#$", which is not EQ to any + legitimate object returned by Fread. */ + specbind (intern_c_string ("load-file-name"), + Vcomp__hashdollar); if (blob) /* New blob format. */ - return Fread (make_string (blob->data, blob->len)); + return unbind_to (count, Fread (make_string (blob->data, blob->len))); static_obj_t *(*f)(void) = dynlib_sym (comp_u->handle, name); if (!f) xsignal1 (Qnative_lisp_file_inconsistent, comp_u->file); blob = f (); - return Fread (make_string (blob->data, blob->len)); + return unbind_to (count, Fread (make_string (blob->data, blob->len))); } @@ -5157,7 +5170,7 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) for (ptrdiff_t i = 0; i < d_vec_len; i++) { Lisp_Object x = data_relocs[i]; - if (EQ (x, Q__lambda_fixup)) + if (EQ (x, Vcomp__hashdollar)) return false; else if (NATIVE_COMP_FUNCTIONP (x)) { @@ -5610,7 +5623,6 @@ natively-compiled one. */); DEFSYM (Qfixnum, "fixnum"); DEFSYM (Qscratch, "scratch"); DEFSYM (Qlate, "late"); - DEFSYM (Q__lambda_fixup, "--lambda-fixup"); DEFSYM (Qgccjit, "gccjit"); DEFSYM (Qcomp_subr_trampoline_install, "comp-subr-trampoline-install"); DEFSYM (Qnative_comp_warning_on_missing_source, @@ -5792,6 +5804,10 @@ This is intended to be used only for development and verification of the native compiler. */); comp_sanitizer_active = false; + DEFVAR_LISP ("comp--#$", Vcomp__hashdollar, + doc: /* Special value which will print as "#$". */); + Vcomp__hashdollar = build_string ("#$"); + Fprovide (intern_c_string ("native-compile"), Qnil); #endif /* #ifdef HAVE_NATIVE_COMP */ diff --git a/src/pdumper.c b/src/pdumper.c index 18c1ae49fe1..b1aaefb3104 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5513,7 +5513,7 @@ dump_do_dump_relocation (const uintptr_t dump_base, XSETSUBR (tem, subr); Lisp_Object *fixup = &(comp_u->data_relocs[XFIXNUM (lambda_data_idx)]); - eassert (EQ (*fixup, Q__lambda_fixup)); + eassert (EQ (*fixup, Vcomp__hashdollar)); *fixup = tem; Fputhash (tem, Qt, comp_u->lambda_gc_guard_h); }