Re: MPS: Please check if scratch/igc builds with native compilation

[Helmut Eller <eller.helmut@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 230 bytes --]

On Thu, May 23 2024, Gerd Möllmann wrote:

> I'll let it rest a bit now.

When you have some time to spare, could you try the patch below?  I
think that load_static_obj can trigger GC and we should be prepared for
that.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Register-roots-for-comp-units-earlier.patch --]
[-- Type: text/x-diff, Size: 6861 bytes --]

From 000702e21a347d3bdd2b74d025ed9f358a2b6702 Mon Sep 17 00:00:00 2001
From: Helmut Eller <helmut@249.130.205.92.host.secureserver.net>
Date: Thu, 23 May 2024 16:42:06 +0200
Subject: [PATCH] Register roots for comp units earlier

---
 src/comp.c | 23 +++++++++++------------
 src/comp.h |  5 ++++-
 src/igc.c  | 46 +++++++++++++++++++++++-----------------------
 src/igc.h  |  3 +++
 4 files changed, 41 insertions(+), 36 deletions(-)

diff --git a/src/comp.c b/src/comp.c
index fdf99d51c78..a3756857205 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -5369,6 +5369,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
 #ifdef HAVE_MPS
   comp_u->data_relocs = dynlib_sym (handle, DATA_RELOC_SYM);
   comp_u->comp_unit = dynlib_sym (handle, COMP_UNIT_SYM);
+  comp_u->comp_unit_root = igc_root_create_n (saved_cu, 1);
 #endif
 
   if (!comp_u->loaded_once)
@@ -5418,6 +5419,8 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
       EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec));
 #ifdef HAVE_MPS
       comp_u->n_data_relocs = d_vec_len;
+      if (d_vec_len > 0)
+	comp_u->data_relocs_root = igc_root_create_n (data_relocs, d_vec_len);
 #endif
       for (EMACS_INT i = 0; i < d_vec_len; i++)
 	data_relocs[i] = AREF (comp_u->data_vec, i);
@@ -5425,6 +5428,9 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
       d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec));
 #ifdef HAVE_MPS
       comp_u->n_data_imp_relocs = d_vec_len;
+      if (d_vec_len > 0)
+	comp_u->data_imp_relocs_root
+	  = igc_root_create_n (data_imp_relocs, d_vec_len);
 #endif
       for (EMACS_INT i = 0; i < d_vec_len; i++)
 	data_imp_relocs[i] = AREF (comp_u->data_impure_vec, i);
@@ -5452,22 +5458,19 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
 	    load_static_obj (comp_u, TEXT_DATA_RELOC_EPHEMERAL_SYM);
 
 	  EMACS_INT d_vec_len = XFIXNUM (Flength (data_ephemeral_vec));
-	  for (EMACS_INT i = 0; i < d_vec_len; i++)
-	    data_eph_relocs[i] = AREF (data_ephemeral_vec, i);
 # ifdef HAVE_MPS
 	  /* FIXME: If we want to get rid of these objects, stop tracing
 	     these references at some point.  */
 	  comp_u->data_eph_relocs = data_eph_relocs;
 	  comp_u->n_data_eph_relocs = d_vec_len;
+	  if (d_vec_len > 0)
+	    comp_u->data_eph_relocs_root
+	      = igc_root_create_n (data_eph_relocs, d_vec_len);
 # endif
+	  for (EMACS_INT i = 0; i < d_vec_len; i++)
+	    data_eph_relocs[i] = AREF (data_ephemeral_vec, i);
 	}
 
-      /* FIXME: Remvoe eph root once it is no longer needed. */
-# ifdef HAVE_MPS
-      if (comp_u->igc_info == NULL)
-	igc_root_create_comp_unit (comp_u);
-# endif
-
       /* Executing this will perform all the expected environment
 	 modifications.  */
       res = top_level_run (comp_u_lisp_obj);
@@ -5477,10 +5480,6 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
       eassert (check_comp_unit_relocs (comp_u));
     }
 
-# ifdef HAVE_MPS
-  if (comp_u->igc_info == NULL)
-    igc_root_create_comp_unit (comp_u);
-# endif
 
   if (!recursive_load)
     /* Clean-up the load ongoing flag in case.  */
diff --git a/src/comp.h b/src/comp.h
index e2ff7296722..c48e93a0242 100644
--- a/src/comp.h
+++ b/src/comp.h
@@ -54,7 +54,10 @@ #define COMP_H
   Lisp_Object *data_eph_relocs;
   size_t n_data_eph_relocs;
   Lisp_Object *comp_unit;
-  void *igc_info;
+  struct igc_root *data_relocs_root;
+  struct igc_root *data_imp_relocs_root;
+  struct igc_root *data_eph_relocs_root;
+  struct igc_root *comp_unit_root;
 # endif
   bool loaded_once;
   bool load_ongoing;
diff --git a/src/igc.c b/src/igc.c
index 7cb42722a85..dc4512713f7 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -1724,7 +1724,9 @@ fix_terminal (mps_ss_t ss, struct terminal *t)
   {
     IGC_FIX_CALL_FN (ss, struct Lisp_Vector, t, fix_vectorlike);
     IGC_FIX12_RAW (ss, &t->next_terminal);
+#ifdef HAVE_WINDOW_SYSTEM
     IGC_FIX12_RAW (ss, &t->image_cache);
+#endif
     // These are malloc'd, so they can be accessed.
     IGC_FIX_CALL_FN (ss, struct coding_system, t->keyboard_coding, fix_coding);
     IGC_FIX_CALL_FN (ss, struct coding_system, t->terminal_coding, fix_coding);
@@ -2190,37 +2192,33 @@ root_create_exact_n (Lisp_Object *start, size_t n)
   return root_create_exact (global_igc, start, start + n, scan_exact);
 }
 
+struct igc_root *
+igc_root_create_n (Lisp_Object start[], size_t n)
+{
+  return (struct igc_root *)root_create_exact_n (start, n);
+}
+
+void
+igc_root_destroy (struct igc_root **root)
+{
+  destroy_root ((struct igc_root_list **)root);
+}
+
 void
 igc_root_create_comp_unit (struct Lisp_Native_Comp_Unit *u)
 {
-  struct igc_cu_roots *r = xzalloc (sizeof *r);
-  if (u->n_data_relocs)
-    r->data_relocs = root_create_exact_n (u->data_relocs, u->n_data_relocs);
-  if (u->n_data_imp_relocs)
-    r->data_imp_relocs
-      = root_create_exact_n (u->data_imp_relocs, u->n_data_imp_relocs);
-  if (u->n_data_eph_relocs)
-    r->data_eph_relocs
-      = root_create_exact_n (u->data_eph_relocs, u->n_data_eph_relocs);
-  r->comp_unit = root_create_exact_n (u->comp_unit, 1);
-  igc_assert (u->igc_info == NULL);
-  u->igc_info = r;
 }
 
 void
 igc_root_destroy_comp_unit (struct Lisp_Native_Comp_Unit *u)
 {
-  igc_assert (u->igc_info != NULL);
-  struct igc_cu_roots *r = u->igc_info;
-  if (r->data_relocs)
-    destroy_root (&r->data_relocs);
-  if (r->data_imp_relocs)
-    destroy_root (&r->data_imp_relocs);
-  if (r->data_eph_relocs)
-    destroy_root (&r->data_eph_relocs);
-  destroy_root (&r->comp_unit);
-  xfree (r);
-  u->igc_info = NULL;
+  if (u->data_relocs_root)
+    igc_root_destroy (&u->data_relocs_root);
+  if (u->data_imp_relocs_root)
+    igc_root_destroy (&u->data_imp_relocs_root);
+  if (u->data_eph_relocs_root)
+    igc_root_destroy (&u->data_eph_relocs_root);
+  igc_root_destroy (&u->comp_unit_root);
 }
 
 static mps_res_t
@@ -3211,12 +3209,14 @@ igc_grow_ptr_vec (ptrdiff_t *n, ptrdiff_t n_incr_min, ptrdiff_t n_max)
   return new_vec;
 }
 
+#ifdef HAVE_WINDOW_SYSTEM
 struct image_cache *
 igc_make_image_cache (void)
 {
   struct image_cache *c = alloc (sizeof *c, IGC_OBJ_IMAGE_CACHE);
   return c;
 }
+#endif
 
 DEFUN ("igc-make-weak-ref", Figc_make_weak_ref, Sigc_make_weak_ref, 1, 1, 0,
        doc
diff --git a/src/igc.h b/src/igc.h
index 25b37a8ac41..fb37ce22e22 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -131,6 +131,9 @@ #define EMACS_IGC_H
 void igc_root_create_exact_ptr (void *var_addr);
 void igc_root_create_comp_unit (struct Lisp_Native_Comp_Unit *u);
 void igc_root_destroy_comp_unit (struct Lisp_Native_Comp_Unit *u);
+struct igc_root;
+struct igc_root *igc_root_create_n (Lisp_Object start[], size_t n);
+void igc_root_destroy (struct igc_root **);
 
 struct Lisp_Weak_Ref;
 Lisp_Object igc_weak_ref_deref (struct Lisp_Weak_Ref *);
-- 
2.39.2