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

[Pip Cet]

Pip Cet <pipcet@protonmail.com> writes:

> But I'll try to come up with a patch doing the simple #1# thing first.

Easy enough to do, but it doesn't solve the read-circle problem (which
appears to affect autoloaded .elc files as well as .eln files, so it's
probably best to discuss that in a separate bug report once this is
merged).

>From 6f4133b54edc890993d6198940800cc9a19df85c Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet@protonmail.com>
Date: Fri, 20 Dec 2024 07:53:38 +0000
Subject: [PATCH] Use circular references as placeholders in nativecomp relocs

* lisp/emacs-lisp/comp.el (comp--finalize-container): Use temporary
placeholder rather than `--lambda-fixup'.
* src/comp.c (declare_imported_data_relocs): Replace temporary
placeholders by permanent placeholders.
(check_comp_unit_relocs): Check for circular reference instead of
`--lambda-fixup'.
(syms_of_comp): Remove `--lambda-fixup'.
* src/pdumper.c (dump_do_dump_relocation): Check for circular reference
instead of `--lambda-fixup'.
---
 lisp/emacs-lisp/comp.el |  8 ++++----
 src/comp.c              | 14 ++++++++++----
 src/pdumper.c           |  2 +-
 3 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index ab6fd77f11a..d5351fe440d 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -3254,10 +3254,10 @@ 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"))
+                             ;; Temporary placeholder, to be replaced by
+                             ;; a circular reference to the vector
+                             ;; containing the element
+                             (comp-data-container-idx cont)
                            obj))))
 
 (defun comp--finalize-relocs ()
diff --git a/src/comp.c b/src/comp.c
index 8b38adec252..3b3dfa58602 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -2854,13 +2854,20 @@ emit_static_object (const char *name, Lisp_Object obj)
 declare_imported_data_relocs (Lisp_Object container, const char *code_symbol,
                              const char *text_symbol)
 {
+  Lisp_Object index_table =
+    CALL1I (comp-data-container-idx, container);
   /* Imported objects.  */
   reloc_array_t res;
   res.len =
-    XFIXNUM (CALL1I (hash-table-count,
-                    CALL1I (comp-data-container-idx, container)));
+    XFIXNUM (CALL1I (hash-table-count, index_table));
   Lisp_Object d_reloc = CALL1I (comp-data-container-l, container);
   d_reloc = Fvconcat (1, &d_reloc);
+  /* Replace temporary placeholders, turning them into circular
+   * references to the vector itself. */
+  EMACS_INT n = XFIXNUM (Flength (d_reloc));
+  for (EMACS_INT i = 0; i < n; i++)
+    if (EQ (AREF (d_reloc, i), index_table))
+      ASET (d_reloc, i, d_reloc);
 
   res.r_val =
     gcc_jit_lvalue_as_rvalue (
@@ -5173,7 +5180,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, comp_u->data_vec))
        return false;
       else if (NATIVE_COMP_FUNCTIONP (x))
        {
@@ -5622,7 +5629,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,
diff --git a/src/pdumper.c b/src/pdumper.c
index d45bbc84bba..956da4d8c72 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, comp_u->data_vec));
            *fixup = tem;
            Fputhash (tem, Qt, comp_u->lambda_gc_guard_h);
          }
-- 
2.47.0