scratch/igc 31e90f38c98: Create roots for references in CUs

[Gerd Moellmann]

branch: scratch/igc
commit 31e90f38c9835e7e665825a365c67b70ed89fc34
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>

    Create roots for references in CUs
---
 src/comp.c |  8 ++++++++
 src/comp.h |  1 +
 src/igc.c  | 57 ++++++++++++++++++++++++++++++++++++++++++++++++---------
 src/igc.h  |  2 ++
 4 files changed, 59 insertions(+), 9 deletions(-)

diff --git a/src/comp.c b/src/comp.c
index 2df3c843f65..c58c36616ec 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -5470,6 +5470,10 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, 
bool loading_dump,
       eassert (check_comp_unit_relocs (comp_u));
     }
 
+# ifdef HAVE_MPS
+  igc_root_create_comp_unit (comp_u);
+# endif
+
   if (!recursive_load)
     /* Clean-up the load ongoing flag in case.  */
     unbind_to (count, Qnil);
@@ -5485,6 +5489,10 @@ unload_comp_unit (struct Lisp_Native_Comp_Unit *cu)
   if (cu->handle == NULL)
     return;
 
+# ifdef HAVE_MPS
+  igc_root_destroy_comp_unit (cu);
+# endif
+
   Lisp_Object *saved_cu = dynlib_sym (cu->handle, COMP_UNIT_SYM);
   Lisp_Object this_cu;
   XSETNATIVE_COMP_UNIT (this_cu, cu);
diff --git a/src/comp.h b/src/comp.h
index 5791d00a1bf..e2ff7296722 100644
--- a/src/comp.h
+++ b/src/comp.h
@@ -54,6 +54,7 @@ struct Lisp_Native_Comp_Unit
   Lisp_Object *data_eph_relocs;
   size_t n_data_eph_relocs;
   Lisp_Object *comp_unit;
+  void *igc_info;
 # endif
   bool loaded_once;
   bool load_ongoing;
diff --git a/src/igc.c b/src/igc.c
index 73a78e08eea..a74c0f5000a 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -1764,15 +1764,11 @@ fix_comp_unit (mps_ss_t ss, struct 
Lisp_Native_Comp_Unit *u)
   MPS_SCAN_BEGIN (ss)
   {
     IGC_FIX_CALL_FN (ss, struct Lisp_Vector, u, fix_vectorlike);
-    //fprintf (stderr, "+++ %p %zu\n", u->data_relocs, u->n_data_relocs);
-    if (u->data_imp_relocs)
-      IGC_FIX12_NOBJS (ss, u->data_imp_relocs, u->n_data_imp_relocs);
-    if (u->data_relocs)
-      IGC_FIX12_NOBJS (ss, u->data_relocs, u->n_data_relocs);
-    if (u->data_eph_relocs)
-      IGC_FIX12_NOBJS (ss, u->data_eph_relocs, u->n_data_eph_relocs);
-    if (u->comp_unit)
-      IGC_FIX12_OBJ (ss, u->comp_unit);
+    /* FIXME: Cannot scan things within the shared object because we
+       don't have exclusive (synchronized) access to them.  Instead of
+       storing Lisp_Object references in vectors in the dylib data
+       segment it would be much nicer to store them in MPS and give
+       the dylib a pointer to them. */
   }
   MPS_SCAN_END (ss);
   return MPS_RES_OK;
@@ -2178,6 +2174,49 @@ igc_on_grow_specpdl (void)
   }
 }
 
+struct igc_cu_roots
+{
+  struct igc_root_list *data_relocs;
+  struct igc_root_list *data_imp_relocs;
+  struct igc_root_list *data_eph_relocs;
+  struct igc_root_list *comp_unit;
+};
+
+static igc_root_list *
+root_create_exact_n (Lisp_Object *start, size_t n)
+{
+  igc_assert (start != NULL);
+  igc_assert (n > 0);
+  return root_create_exact (global_igc, start, start + n, scan_exact);
+}
+
+void
+igc_root_create_comp_unit (struct Lisp_Native_Comp_Unit *u)
+{
+  struct igc_cu_roots *r = xzalloc (sizeof *r);
+  r->data_relocs = root_create_exact_n (u->data_relocs, u->n_data_relocs);
+  r->data_imp_relocs
+    = root_create_exact_n (u->data_imp_relocs, u->n_data_imp_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;
+  destroy_root (&r->data_relocs);
+  destroy_root (&r->data_imp_relocs);
+  destroy_root (&r->data_eph_relocs);
+  destroy_root (&r->comp_unit);
+  xfree (r);
+  u->igc_info = NULL;
+}
+
 static mps_res_t
 create_weak_ap (mps_ap_t *ap, struct igc_thread *t, bool weak)
 {
diff --git a/src/igc.h b/src/igc.h
index 384d5acdf1b..25b37a8ac41 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -129,6 +129,8 @@ void igc_collect (void);
 void igc_root_create_ambig (void *start, void *end);
 void igc_root_create_exact (Lisp_Object *start, Lisp_Object *end);
 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 Lisp_Weak_Ref;
 Lisp_Object igc_weak_ref_deref (struct Lisp_Weak_Ref *);