Re: Merging scratch/no-purespace to remove unexec and purespace

[Eli Zaretskii]

Ping!  Andrea, any comments to the patch?

> Date: Tue, 07 Jan 2025 12:46:16 +0000
> From: Pip Cet <pipcet@protonmail.com>
> Cc: Eli Zaretskii <eliz@gnu.org>, emacs-devel@gnu.org, 
> stefankangas@gmail.com, gerd.moellmann@gmail.com, monnier@iro.umontreal.ca
> 
> "Andrea Corallo" <acorallo@gnu.org> writes:
> 
> > Eli Zaretskii <eliz@gnu.org> writes:
> >
> >>> Date: Sat, 04 Jan 2025 11:12:48 +0000
> >>> From: Pip Cet <pipcet@protonmail.com>
> >>> Cc: emacs-devel@gnu.org, stefankangas@gmail.com, acorallo@gnu.org, 
> >>> gerd.moellmann@gmail.com, monnier@iro.umontreal.ca
> >>>
> >>> "Eli Zaretskii" <eliz@gnu.org> writes:
> >>>
> >>> > Is this about bug#74966?  If so, let's not discuss the same issue
> >>>
> >>> No.  This is about the --enable-checking code treating --lambda-fixup as
> >>> a forbidden symbol and crashing if it is used in the obvious fashion by
> >>> any code that happens to be native-compiled, which is the current status
> >>> on scratch/no-purespace.
> >>
> >> Then I'd like to hear Andrea's opinion on this.
> >
> > My opinion is that, to fix the scratch/no-purespace bug, I'm okay with
> > the #$ solution if it works.  Honestly I'd be fine also using a comp
> > specific symbol like comp--something which is documented not to be
> > compilable, maybe less nice but probably less convoluted.  Anyway if Pip
> > prefers #$ and is not too complex I'm okay with that.
> 
> Here's the patch.  Okay to push?
> 
> (As with all the DEFVARs in comp.c, space for the new symbol is reserved
> in globals, and the documentation ends up in etc/DOC, even in
> non-nativecomp builds.  The same is true for DEFSYM: make-docfile.c
> doesn't care about #ifdef.  If someone fixes this so non-nativecomp
> builds don't pay a price for nativecomp, this code will need fixing,
> too.)
> 
> commit a0abd3033414a011125e815d30890ed22b80a84e (HEAD)
> Author: Pip Cet <pipcet@protonmail.com>
> Date:   Tue Jan 7 12:13:40 2025 +0000
> 
>     Use #$ for lambda fixups in native compilation data vectors
>     
>     * 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.
> 
> diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
> index ab6fd77f11a..a8698ef6454 100644
> --- a/lisp/emacs-lisp/comp.el
> +++ b/lisp/emacs-lisp/comp.el
> @@ -42,6 +42,7 @@ comp-native-version-dir
>  (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 @@ comp--finalize-container
>                   ;; 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 8b38adec252..ecdf01b91cb 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
> @@ -2682,6 +2682,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);
>  
> @@ -5145,18 +5151,22 @@ fixup_eln_load_path (Lisp_Object eln_filename)
>  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 #$.  */
> +  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)));
>  
>  }
>  
> @@ -5173,7 +5183,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))
>       {
> @@ -5622,7 +5632,6 @@ syms_of_comp (void)
>    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,
> @@ -5804,6 +5813,10 @@ syms_of_comp (void)
>  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 d45bbc84bba..a27df8d96d4 100644
> --- a/src/pdumper.c
> +++ b/src/pdumper.c
> @@ -5504,7 +5504,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);
>         }
> 
>