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 f7e81b157a962e536074df885cf38d2e099caec3..248a1a9aa04120fbfa3a304928740cba4f9e19e8 100644 (file)
--- 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 7f31f3652a1fe8da7a34f54d83765214db8d2e73..13fb651b9306074debbd5a12630dc5f439277a93 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -468,7 +468,7 @@ load_gccjit_if_necessary (bool mandatory)
 
 \f
 /* 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 18c1ae49fe125e79c7b55715b5f7590aaa7c239a..b1aaefb310429d59a7c25792449af77604521f71 100644 (file)
--- 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);
          }