1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-06 03:40:56 -08:00

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.
This commit is contained in:
Pip Cet 2025-01-18 20:55:18 +00:00
parent 20e3959dc3
commit 4eabfd68c9
3 changed files with 26 additions and 10 deletions

View file

@ -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 ()

View file

@ -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 */

View file

@ -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);
}