Re: MPS: Loaded pdump

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

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

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

> The dump is still an ambig root, objects are copied to MPS when a dump
> is loaded but references in the new graph in MPS are not yet mirrored.
> The infrastructure for that is there, but a felt gazillion small
> functions need to be written, one for each type :-/.

I'd like to submit some patches:

1) Actually implement igc_realloc_ambig; this is needed on X.

2) Make igc-info a bit more useful by reporting the different pvec
   types separately.

3) Some minor refactoring for the pdump code

4) Code to register the dump as exact root.  This will break some
   things.  Not surprising of course.  E.g.
   (progn
     (view-hello-file)
     (dotimes (_ 5) (redisplay) (igc--collect) (forward-line)))

    Not sure if now is a good time to make this change.



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Implement-igc_realloc_ambig.patch --]
[-- Type: text/x-diff, Size: 933 bytes --]

From 1a58ec991dac1f93736aaf7f25d1fca5f090d680 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Fri, 10 May 2024 09:39:46 +0200
Subject: [PATCH] Implement igc_realloc_ambig

After awaking from hybernation the X server reinitialized devices and
requires igc_realloc_ambig.

* src/igc.c (igc_realloc_ambig):
---
 src/igc.c | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/src/igc.c b/src/igc.c
index 5a27267b50a..2ccab619c40 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -2257,7 +2257,6 @@ igc_xzalloc_ambig (size_t size)
 void *
 igc_realloc_ambig (void *block, size_t size)
 {
-#if 0 // non tested code:
   struct igc_root_list *r = root_find (block);
   igc_assert (r != NULL);
   destroy_root (&r);
@@ -2269,8 +2268,6 @@ igc_realloc_ambig (void *block, size_t size)
   void *end = (char *)p + new_size;
   root_create_ambig (global_igc, p, end);
   return p;
-#endif
-  emacs_abort ();
 }
 
 
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-In-dflt_scanx-check-types-more-carefully.patch --]
[-- Type: text/x-diff, Size: 1746 bytes --]

From 3b7bfdf9931b624be0da7c75b3806bbba5a2ac4b Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Fri, 10 May 2024 09:43:19 +0200
Subject: [PATCH] In dflt_scanx, check types more carefully

* src/igc.c (dflt_scanx): Make sure that obj_type and pvec_type are in
the valid range before using them as index.
---
 src/igc.c | 19 ++++++++++++++-----
 1 file changed, 14 insertions(+), 5 deletions(-)

diff --git a/src/igc.c b/src/igc.c
index 2ccab619c40..e2cf00b2de6 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -1252,10 +1252,17 @@ dflt_scanx (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
 	if (closure)
 	  {
 	    struct igc_stats *st = closure;
-	    st->obj[header->obj_type].nwords += header->nwords;
-	    st->obj[header->obj_type].nobjs += 1;
-	    st->obj[header->pvec_type].nwords += header->nwords;
-	    st->obj[header->pvec_type].nobjs += 1;
+	    mps_word_t obj_type = header->obj_type;
+	    igc_assert (obj_type < IGC_OBJ_LAST);
+	    st->obj[obj_type].nwords += header->nwords;
+	    st->obj[obj_type].nobjs += 1;
+	    if (obj_type != IGC_OBJ_PAD)
+	      {
+		mps_word_t pvec_type = header->pvec_type;
+		igc_assert (pvec_type <= PVEC_TAG_MAX);
+		st->obj[pvec_type].nwords += header->nwords;
+		st->obj[pvec_type].nobjs += 1;
+	      }
 	  }
 
 	switch (header->obj_type)
@@ -3115,7 +3122,9 @@ DEFUN ("igc-info", Figc_info, Sigc_info, 0, 0, 0, doc : /* */)
   struct igc *gc = global_igc;
   struct igc_stats st = { 0 };
   mps_res_t res;
-  IGC_WITH_PARKED (gc) { res = mps_pool_walk (gc->dflt_pool, dflt_scanx, &st); }
+  IGC_WITH_PARKED (gc) {
+     res = mps_pool_walk (gc->dflt_pool, dflt_scanx, &st);
+  }
   if (res != MPS_RES_OK)
     error ("Error %d walking memory", res);
 
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0001-Tighter-bounds-for-the-dumped-hot-region.patch --]
[-- Type: text/x-diff, Size: 1095 bytes --]

From f920bb66bfd7a6364ff1fa8796a6b3fd5a6606f0 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Thu, 16 May 2024 09:01:45 +0200
Subject: [PATCH] Tighter bounds for the dumped hot region

* src/pdumper.c (pdumper_load): Exclude the header and the discardable
part.
---
 src/pdumper.c | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/src/pdumper.c b/src/pdumper.c
index 2437a70f0a8..00bb7dd8db8 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -5956,8 +5956,11 @@ pdumper_load (const char *dump_filename, char *argv0)
   dump_public.end = dump_public.start + dump_size;
 
 #ifdef HAVE_MPS
-  void *hot_start = (void *) dump_base;
-  void *hot_end = (void *) (dump_base + adj_discardable_start);
+  size_t aligned_header_size
+    = ((sizeof (struct dump_header) + DUMP_ALIGNMENT - 1)
+       & ~(DUMP_ALIGNMENT - 1));
+  void *hot_start = (void *) (dump_base + aligned_header_size);
+  void *hot_end = (void *) (dump_base + header->discardable_start);
 #endif
 
   dump_do_all_dump_reloc_for_phase (header, dump_base, EARLY_RELOCS);
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0001-Factorize-common-pattern-to-dump-arrays.patch --]
[-- Type: text/x-diff, Size: 3226 bytes --]

From 874c30967e1886ad3d42aa21c625f29381612e9d Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Thu, 16 May 2024 09:09:39 +0200
Subject: [PATCH] Factorize common pattern to dump arrays

* src/pdumper.c (dump_object_array): New.
(dump_hash_table_key, dump_hash_table_key, dump_obarray_buckets): Use it.
---
 src/pdumper.c | 53 +++++++++++++--------------------------------------
 1 file changed, 13 insertions(+), 40 deletions(-)

diff --git a/src/pdumper.c b/src/pdumper.c
index 00bb7dd8db8..738aeb458c9 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2781,49 +2781,39 @@ hash_table_freeze (struct Lisp_Hash_Table *h)
 }
 
 static dump_off
-dump_hash_table_key (struct dump_context *ctx, struct Lisp_Hash_Table *h)
+dump_object_array (struct dump_context *ctx,
+		   const Lisp_Object array[], size_t len)
 {
   dump_align_output (ctx, DUMP_ALIGNMENT);
   dump_off start_offset = ctx->offset;
-  ptrdiff_t n = h->count;
 
   struct dump_flags old_flags = ctx->flags;
   ctx->flags.pack_objects = true;
 
-  for (ptrdiff_t i = 0; i < n; i++)
+  for (size_t i = 0; i < len; i++)
     {
       Lisp_Object out;
-      const Lisp_Object *slot = &h->key[i];
+      const Lisp_Object *slot = &array[i];
       dump_object_start_1 (ctx, &out, sizeof out);
       dump_field_lv (ctx, &out, slot, slot, WEIGHT_STRONG);
       dump_object_finish_1 (ctx, &out, sizeof out);
     }
 
   ctx->flags = old_flags;
+
   return start_offset;
 }
 
 static dump_off
-dump_hash_table_value (struct dump_context *ctx, struct Lisp_Hash_Table *h)
+dump_hash_table_key (struct dump_context *ctx, struct Lisp_Hash_Table *h)
 {
-  dump_align_output (ctx, DUMP_ALIGNMENT);
-  dump_off start_offset = ctx->offset;
-  ptrdiff_t n = h->count;
-
-  struct dump_flags old_flags = ctx->flags;
-  ctx->flags.pack_objects = true;
-
-  for (ptrdiff_t i = 0; i < n; i++)
-    {
-      Lisp_Object out;
-      const Lisp_Object *slot = &h->value[i];
-      dump_object_start_1 (ctx, &out, sizeof out);
-      dump_field_lv (ctx, &out, slot, slot, WEIGHT_STRONG);
-      dump_object_finish_1 (ctx, &out, sizeof out);
-    }
+  return dump_object_array (ctx, h->key, h->count);
+}
 
-  ctx->flags = old_flags;
-  return start_offset;
+static dump_off
+dump_hash_table_value (struct dump_context *ctx, struct Lisp_Hash_Table *h)
+{
+  return dump_object_array (ctx, h->value, h->count);
 }
 
 static dump_off
@@ -2875,24 +2865,7 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object)
 static dump_off
 dump_obarray_buckets (struct dump_context *ctx, const struct Lisp_Obarray *o)
 {
-  dump_align_output (ctx, DUMP_ALIGNMENT);
-  dump_off start_offset = ctx->offset;
-  ptrdiff_t n = obarray_size (o);
-
-  struct dump_flags old_flags = ctx->flags;
-  ctx->flags.pack_objects = true;
-
-  for (ptrdiff_t i = 0; i < n; i++)
-    {
-      Lisp_Object out;
-      const Lisp_Object *slot = &o->buckets[i];
-      dump_object_start_1 (ctx, &out, sizeof out);
-      dump_field_lv (ctx, &out, slot, slot, WEIGHT_STRONG);
-      dump_object_finish_1 (ctx, &out, sizeof out);
-    }
-
-  ctx->flags = old_flags;
-  return start_offset;
+  return dump_object_array (ctx, o->buckets, obarray_size (o));
 }
 
 static dump_off
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0001-Include-stats-about-pseudovectors-in-igc-info.patch --]
[-- Type: text/x-diff, Size: 3757 bytes --]

From b8c40588bfa76f58cc00f51a844044c8d30f7d01 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Thu, 16 May 2024 09:13:00 +0200
Subject: [PATCH] Include stats about pseudovectors in igc-info

* src/igc.c (pvec_type_names, pvec_type_name): New.
(dflt_scanx): Better accounting for each pseudovector type.
(Figc_info): Return the accumulated values for pseudovectors.
---
 src/igc.c | 78 ++++++++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 68 insertions(+), 10 deletions(-)

diff --git a/src/igc.c b/src/igc.c
index 9656d4190c1..db02cdb85f8 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -208,6 +208,56 @@ #define IGC_DEFINE_LIST(data)                                                  \
 
 igc_static_assert (ARRAYELTS (obj_type_names) == IGC_OBJ_LAST);
 
+static const char *pvec_type_names[] = {
+  "PVEC_NORMAL_VECTOR",
+  "PVEC_FREE",
+  "PVEC_BIGNUM",
+  "PVEC_MARKER",
+  "PVEC_OVERLAY",
+  "PVEC_FINALIZER",
+  "PVEC_SYMBOL_WITH_POS",
+  "PVEC_MISC_PTR",
+  "PVEC_USER_PTR",
+  "PVEC_PROCESS",
+  "PVEC_FRAME",
+  "PVEC_WINDOW",
+  "PVEC_BOOL_VECTOR",
+  "PVEC_BUFFER",
+  "PVEC_HASH_TABLE",
+  "PVEC_OBARRAY",
+  "PVEC_TERMINAL",
+  "PVEC_WINDOW_CONFIGURATION",
+  "PVEC_SUBR",
+  "PVEC_OTHER",
+  "PVEC_XWIDGET",
+  "PVEC_XWIDGET_VIEW",
+  "PVEC_THREAD",
+  "PVEC_MUTEX",
+  "PVEC_CONDVAR",
+  "PVEC_MODULE_FUNCTION",
+  "PVEC_MODULE_GLOBAL_REFERENCE",
+  "PVEC_NATIVE_COMP_UNIT",
+  "PVEC_TS_PARSER",
+  "PVEC_TS_NODE",
+  "PVEC_TS_COMPILED_QUERY",
+  "PVEC_SQLITE",
+  "PVEC_WEAK_REF",
+  "PVEC_COMPILED",
+  "PVEC_CHAR_TABLE",
+  "PVEC_SUB_CHAR_TABLE",
+  "PVEC_RECORD",
+  "PVEC_FONT",
+};
+
+igc_static_assert (ARRAYELTS (pvec_type_names) == PVEC_TAG_MAX + 1);
+
+static const char *
+pvec_type_name (enum pvec_type type)
+{
+  igc_assert (0 <= type && type <= PVEC_TAG_MAX);
+  return pvec_type_names[type];
+}
+
 struct igc_stats
 {
   struct
@@ -1246,12 +1296,13 @@ dflt_scanx (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
 	    igc_assert (obj_type < IGC_OBJ_LAST);
 	    st->obj[obj_type].nwords += header->nwords;
 	    st->obj[obj_type].nobjs += 1;
-	    if (obj_type != IGC_OBJ_PAD)
+	    if (obj_type == IGC_OBJ_VECTOR)
 	      {
-		mps_word_t pvec_type = header->pvec_type;
-		igc_assert (pvec_type <= PVEC_TAG_MAX);
-		st->obj[pvec_type].nwords += header->nwords;
-		st->obj[pvec_type].nobjs += 1;
+		struct Lisp_Vector* v = (struct Lisp_Vector*)client;
+		enum pvec_type pvec_type = PSEUDOVECTOR_TYPE (v);
+		igc_assert (0 <= pvec_type && pvec_type <= PVEC_TAG_MAX);
+		st->pvec[pvec_type].nwords += header->nwords;
+		st->pvec[pvec_type].nobjs += 1;
 	      }
 	  }
 
@@ -3107,8 +3158,9 @@ DEFUN ("igc-info", Figc_info, Sigc_info, 0, 0, 0, doc : /* */)
   struct igc *gc = global_igc;
   struct igc_stats st = { 0 };
   mps_res_t res;
-  IGC_WITH_PARKED (gc) {
-     res = mps_pool_walk (gc->dflt_pool, dflt_scanx, &st);
+  IGC_WITH_PARKED (gc)
+  {
+    res = mps_pool_walk (gc->dflt_pool, dflt_scanx, &st);
   }
   if (res != MPS_RES_OK)
     error ("Error %d walking memory", res);
@@ -3117,11 +3169,17 @@ DEFUN ("igc-info", Figc_info, Sigc_info, 0, 0, 0, doc : /* */)
   for (int i = 0; i < IGC_OBJ_LAST; ++i)
     {
       Lisp_Object e
-	= list3 (build_string (obj_type_names[i]), make_int (st.obj[i].nobjs),
-		 make_int (st.obj[i].nwords));
+	  = list3 (build_string (obj_type_names[i]),
+		   make_int (st.obj[i].nobjs), make_int (st.obj[i].nwords));
+      result = Fcons (e, result);
+    }
+  for (enum pvec_type i = 0; i <= PVEC_TAG_MAX; i++)
+    {
+      Lisp_Object e
+	  = list3 (build_string (pvec_type_name (i)),
+		   make_int (st.pvec[i].nobjs), make_int (st.pvec[i].nwords));
       result = Fcons (e, result);
     }
-
   return result;
 }
 
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0001-Register-the-dump-as-exact-root.patch --]
[-- Type: text/x-diff, Size: 2365 bytes --]

From f4b2c18a788e03fcd7a2e3640288c4794a7d9057 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Thu, 16 May 2024 10:22:48 +0200
Subject: [PATCH] Register the dump as exact root

* src/igc.c (register_pdump_roots_ctx, register_pdump_roots_1)
(register_pdump_roots): New.
(igc_on_pdump_loaded): Use it.
---
 src/igc.c | 55 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 54 insertions(+), 1 deletion(-)

diff --git a/src/igc.c b/src/igc.c
index db02cdb85f8..c8698183bd4 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -3973,10 +3973,63 @@ mirror_dump (void)
   mirror_objects (&m);
 }
 
+struct register_pdump_roots_ctx
+{
+  void *hot_start;  /* start of hot section in pdump */
+  void *hot_end;    /* end of hot section in pdump */
+  void *root_start; /* start (or NULL) of current root */
+  void *root_end;   /* end (or NULL) of current root */
+};
+
+/* Try to combine adjacent objects into one root.  Naively creating a
+   separate root for each object seems to run into serious efficiency
+   problems. */
+static void
+register_pdump_roots_1 (void *start, void *closure)
+{
+  struct igc_header *h = start;
+  void *end = (char *)start + to_bytes (h->nwords);
+  struct register_pdump_roots_ctx *ctx = closure;
+  if (start < ctx->hot_start || ctx->hot_end <= start)
+    return;
+  if (ctx->root_end == start) /* adjacent objects? */
+    {
+      ctx->root_end = end; /* combine them */
+    }
+  else
+    {
+      if (ctx->root_start != NULL)
+	{
+	  root_create_exact (global_igc, ctx->root_start, ctx->root_end,
+			     dflt_scanx);
+	}
+      ctx->root_start = start;
+      ctx->root_end = end;
+    }
+}
+
+static void
+register_pdump_roots (void *start, void *end)
+{
+  struct register_pdump_roots_ctx ctx = {
+    .hot_start = start,
+    .hot_end = end,
+    .root_start = NULL,
+    .root_end = NULL,
+  };
+  pdumper_visit_object_starts (register_pdump_roots_1, &ctx);
+  if (ctx.root_start != NULL)
+    {
+      root_create_exact (global_igc, ctx.root_start, ctx.root_end,
+			 dflt_scanx);
+    }
+}
+
 void
 igc_on_pdump_loaded (void *start, void *end)
 {
-  root_create_ambig (global_igc, start, end);
+  // root_create_ambig (global_igc, start, end);
+  register_pdump_roots (start, end);
   specpdl_ref count = igc_park_arena ();
   mirror_dump ();
   unbind_to (count, Qnil);
-- 
2.39.2