MPS: Forwording symbols

MPS: Forwording symbols

[Gerd Möllmann]

Ok, I've looked a bit closer, and I think we can avoid dumping the
the forwarding structs altogether.

There are 5 types of forwarding structs

 enum Lisp_Fwd_Type
   {
     Lisp_Fwd_Int,		/* Fwd to a C `int' variable.  */
     Lisp_Fwd_Bool,		/* Fwd to a C boolean var.  */
     Lisp_Fwd_Obj,		/* Fwd to a C Lisp_Object variable.  */
     Lisp_Fwd_Buffer_Obj,	/* Fwd to a Lisp_Object field of buffers.  */
     Lisp_Fwd_Kboard_Obj		/* Fwd to a Lisp_Object field of kboards.  */
   };

Four of them contain only the type and either integer offsets or
pointers to variables in Emacs' data segment. The only interesting one
is Lisp_Fwd_Buffer_Obj which looks like

  struct Lisp_Buffer_Objfwd
    {
      enum Lisp_Fwd_Type type;	/* = Lisp_Fwd_Buffer_Obj */
      int offset;
      /* One of Qnil, Qintegerp, Qsymbolp, Qstringp, Qfloatp or Qnumberp.  */
      Lisp_Object predicate;
    };

which has an additional member for the predicate. AFAICT, the comment is
true, and thus predicate is also a constant because it is always from a
DEFSYM, i.e. it is a symbol from lispsym.

Means that dumping the fwd structs is not strictly needed. (And maybe
one should replace the Lisp_Object predicate member with an enum, to
make that sure for the future.)

If we don't dump_fwd, we would have to make sure though not to overwrite
the existing values for symbols in lispsym, which happens in
dump_do_dump_relocation

    case RELOC_DUMP_TO_EMACS_PTR_RAW:
      {
        uintptr_t value = dump_read_word_from_dump (dump_base, reloc_offset);
        eassert (dump_reloc_size (reloc) == sizeof (value));
        value += emacs_basis ();
        dump_write_word_to_dump (dump_base, reloc_offset, value);
        break;
      }

The name dump_write_word_to_dump is misleading. It does a memcpy to
Emacs' data segment.

Maybe one could introduce a new RELOC_xyz type to signify that a
forwarding symbol is patched and save the fwd value around the memcpy if
needed.

Or something like that?

Re: MPS: Forwording symbols

[Gerd Möllmann]

Gerd Möllmann <gerd.moellmann@gmail.com> writes:

> Or something like that?

And we must preserve the values of the forwarded-to variables, of
course. So, this must happen

  dump_emacs_reloc_immediate_intmax_t (ctx, intfwd->intvar, *intfwd->intvar);

(from dump_fwd_int), even if we don't dump the structs.

Re: MPS: Forwording symbols

[Helmut Eller]

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

On Sun, Jun 16 2024, Gerd Möllmann wrote:

> If we don't dump_fwd, we would have to make sure though not to overwrite
> the existing values for symbols in lispsym, which happens in
> dump_do_dump_relocation
>
>     case RELOC_DUMP_TO_EMACS_PTR_RAW:
>       {
>         uintptr_t value = dump_read_word_from_dump (dump_base, reloc_offset);
>         eassert (dump_reloc_size (reloc) == sizeof (value));
>         value += emacs_basis ();
>         dump_write_word_to_dump (dump_base, reloc_offset, value);
>         break;
>       }
>
> The name dump_write_word_to_dump is misleading. It does a memcpy to
> Emacs' data segment.

Hm, why do you think it writes to the data segment?  Confusing names
aside, it seems to read a value, which presumably is a pointer, adjusts
it to the new basis and then writes it back.

> Maybe one could introduce a new RELOC_xyz type to signify that a
> forwarding symbol is patched and save the fwd value around the memcpy if
> needed.
>
> Or something like that?

Yes, looks like a better reloc kind is needed.

Below is what I currently have.  Tracing those IGC_OBJ_DUMPED_FWD
objects seems problematic, especially while the binding of the symbol is
temporarily swapped out.



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-WIP-Allocate-the-dump-as-a-single-MPS-block.patch --]
[-- Type: text/x-diff, Size: 24210 bytes --]

From 3e106ed1fb15a8c41f4d7296a4ec72d4736c6c55 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Sun, 16 Jun 2024 20:18:01 +0200
Subject: [PATCH 1/3] WIP Allocate the dump as a single MPS block

* src/igc.c (dump_mmap_contiguous_mps): New variant of
dump_mmap_contiguous.
(dump_mmap_release_mps): New.
(pdumper_load): Call igc_on_pdump_loaded with more details.
(dump_header): Record some important positions.
(dump_fwd_int, dump_fwd_bool, dump_fwd_obj, dump_fwd_buffer_obj)
(dump_fwd_kboard_obj): Add IGC_OBJ_DUMPED_FWD header.
(dump_charset_table): Add IGC_OBJ_DUMPED_CHARSET_TABLE header.
(dump_cold_charsets): New. Add IGC_OBJ_DUMPED_CODE_SPACE_MASKS header.
(dump_cold_buffer): Add IGC_OBJ_DUMPED_BUFFER_TEXT header.
(Fdump_emacs_portable): Record positions for cold_user_data_start and
heap_end.

* src/igc.h (igc_obj_type): Add some tags to mark object in the dump.
(igc_on_pdump_loaded): Add some arguments for various regions.
(igc_alloc_dump): New.

* src/igc.c (igc_alloc_dump): Implement it.
(igc_on_pdump_loaded): Insert some IGC_OBJ_PAD headers, pin some stuff,
and prepare the text of the buffers.
(builtin_obj_type_and_hash): Allow some of the new object types.
---
 src/igc.c     | 196 +++++++++++++++++++++++++++++++++++++++++++++++-
 src/igc.h     |  12 ++-
 src/pdumper.c | 203 +++++++++++++++++++++++++++++++++++++++++---------
 3 files changed, 372 insertions(+), 39 deletions(-)

diff --git a/src/igc.c b/src/igc.c
index d9fb5a783f7..50fec431529 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -205,6 +205,11 @@ #define IGC_DEFINE_LIST(data)                                                  \
   "IGC_OBJ_BUILTIN_SYMBOL",
   "IGC_OBJ_BUILTIN_THREAD",
   "IGC_OBJ_BUILTIN_SUBR",
+  "IGC_OBJ_DUMPED_FWD",
+  "IGC_OBJ_DUMPED_CHARSET_TABLE",
+  "IGC_OBJ_DUMPED_CODE_SPACE_MASKS",
+  "IGC_OBJ_DUMPED_BUFFER_TEXT",
+  "IGC_OBJ_DUMPED_BYTES",
 };
 
 igc_static_assert (ARRAYELTS (obj_type_names) == IGC_OBJ_NUM_TYPES);
@@ -1280,6 +1285,22 @@ fix_handler (mps_ss_t ss, struct handler *h)
   return MPS_RES_OK;
 }
 
+static mps_res_t
+fix_charset_table (mps_ss_t ss, struct charset *table, size_t nbytes)
+{
+  igc_assert (table == charset_table);
+  igc_assert (nbytes
+	      == (charset_table_size * sizeof (struct charset)
+		  + sizeof (struct igc_header)));
+  MPS_SCAN_BEGIN (ss)
+  {
+    for (size_t i = 0, len = nbytes / sizeof (struct charset); i < len; i++)
+      IGC_FIX12_OBJ (ss, &table[i].attributes);
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
 static mps_res_t fix_vector (mps_ss_t ss, struct Lisp_Vector *v);
 
 static mps_res_t
@@ -1341,6 +1362,9 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
       case IGC_OBJ_STRING_DATA:
       case IGC_OBJ_FLOAT:
       case IGC_OBJ_BYTES:
+      case IGC_OBJ_DUMPED_CODE_SPACE_MASKS:
+      case IGC_OBJ_DUMPED_BUFFER_TEXT:
+      case IGC_OBJ_DUMPED_BYTES:
 	/* Can occur in the dump. */
 	break;
 
@@ -1392,6 +1416,15 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
 	IGC_FIX_CALL_FN (ss, struct Lisp_Buffer_Local_Value, client,
 			 fix_blv);
 	break;
+
+      case IGC_OBJ_DUMPED_FWD:
+	IGC_FIX_CALL (ss, fix_fwd (ss, (lispfwd){ client }));
+	break;
+
+      case IGC_OBJ_DUMPED_CHARSET_TABLE:
+	IGC_FIX_CALL (ss, fix_charset_table (ss, (struct charset *)client,
+					     obj_size (header)));
+	break;
       }
   }
   MPS_SCAN_END (ss);
@@ -2646,6 +2679,11 @@ finalize (struct igc *gc, mps_addr_t base)
     case IGC_OBJ_BUILTIN_SYMBOL:
     case IGC_OBJ_BUILTIN_THREAD:
     case IGC_OBJ_BUILTIN_SUBR:
+    case IGC_OBJ_DUMPED_FWD:
+    case IGC_OBJ_DUMPED_CHARSET_TABLE:
+    case IGC_OBJ_DUMPED_CODE_SPACE_MASKS:
+    case IGC_OBJ_DUMPED_BUFFER_TEXT:
+    case IGC_OBJ_DUMPED_BYTES:
     case IGC_OBJ_BYTES:
     case IGC_OBJ_NUM_TYPES:
       emacs_abort ();
@@ -2813,6 +2851,11 @@ thread_ap (enum igc_obj_type type)
     case IGC_OBJ_BUILTIN_SYMBOL:
     case IGC_OBJ_BUILTIN_THREAD:
     case IGC_OBJ_BUILTIN_SUBR:
+    case IGC_OBJ_DUMPED_FWD:
+    case IGC_OBJ_DUMPED_CHARSET_TABLE:
+    case IGC_OBJ_DUMPED_CODE_SPACE_MASKS:
+    case IGC_OBJ_DUMPED_BUFFER_TEXT:
+    case IGC_OBJ_DUMPED_BYTES:
     case IGC_OBJ_NUM_TYPES:
       emacs_abort ();
 
@@ -3600,6 +3643,17 @@ builtin_obj_type_and_hash (size_t *hash, enum igc_obj_type type, void *client)
       return IGC_OBJ_BUILTIN_SUBR;
     }
 
+  if (type == IGC_OBJ_DUMPED_FWD
+      || type == IGC_OBJ_DUMPED_CHARSET_TABLE
+      || type == IGC_OBJ_DUMPED_CODE_SPACE_MASKS
+      || type == IGC_OBJ_DUMPED_BUFFER_TEXT
+      || type == IGC_OBJ_DUMPED_BYTES
+      )
+    {
+      *hash = 0;
+      return type;
+    }
+
   emacs_abort ();
 }
 
@@ -3860,6 +3914,12 @@ copy_dump (struct igc_mirror *m)
 	case IGC_OBJ_BUILTIN_THREAD:
 	case IGC_OBJ_BUILTIN_SUBR:
 	  break;
+	case IGC_OBJ_DUMPED_FWD:
+	case IGC_OBJ_DUMPED_CHARSET_TABLE:
+	case IGC_OBJ_DUMPED_CODE_SPACE_MASKS:
+	case IGC_OBJ_DUMPED_BUFFER_TEXT:
+	case IGC_OBJ_DUMPED_BYTES:
+	  emacs_abort ();
 	}
     }
   record_time (m, "Copy objects to MPS");
@@ -4415,6 +4475,11 @@ mirror (struct igc_mirror *m, void *org_base, void *copy_base)
     case IGC_OBJ_PAD:
     case IGC_OBJ_FWD:
     case IGC_OBJ_INVALID:
+    case IGC_OBJ_DUMPED_FWD:
+    case IGC_OBJ_DUMPED_CHARSET_TABLE:
+    case IGC_OBJ_DUMPED_CODE_SPACE_MASKS:
+    case IGC_OBJ_DUMPED_BUFFER_TEXT:
+    case IGC_OBJ_DUMPED_BYTES:
     case IGC_OBJ_NUM_TYPES:
       emacs_abort ();
 
@@ -4549,19 +4614,144 @@ mirror_dump (void *start, void *end)
       redirect_roots (&m);
 
       if (getenv ("IGC_MIRROR_STATS"))
-	print_mirror_stats (&m);
+        print_mirror_stats (&m);
     }
 }
 
+static mps_addr_t pinned_objects_in_dump[3];
+
 /* Called from pdumper_load. [START, END) is the hot section of the
    dump. Copy objects from the dump to MPS, and discard the dump. */
 
 void
-igc_on_pdump_loaded (void *start, void *end)
+igc_on_pdump_loaded (void *dump_base, void *hot_start, void *hot_end,
+		     void *cold_start, void *cold_end,
+		     void *cold_user_data_start, void *heap_end)
+{
+  // mirror_dump (start, end);
+  igc_assert (global_igc->park_count > 0);
+  eassert (base_to_client (hot_start) == charset_table);
+  eassert (((struct igc_header *)cold_start)->obj_type
+	   == IGC_OBJ_DUMPED_CODE_SPACE_MASKS);
+  eassert (((struct igc_header *)cold_user_data_start)->obj_type
+	   == IGC_OBJ_DUMPED_BYTES);
+  eassert (((struct igc_header *)heap_end)->obj_type == IGC_OBJ_DUMPED_BYTES);
+
+  size_t discardable_size = (uint8_t *)cold_start - (uint8_t *)hot_end;
+  size_t dump_size = (uint8_t *)cold_end - (uint8_t *)dump_base;
+  // size_t cold_size = (uint8_t *)cold_end - (uint8_t *)cold_start;
+  size_t dump_header_size = (uint8_t *)hot_start - (uint8_t *)dump_base;
+  size_t relocs_size = (uint8_t *)cold_end - (uint8_t *)heap_end;
+  struct igc_header *h = client_to_base (dump_base);
+  igc_assert (h->obj_type == IGC_OBJ_INVALID);
+  igc_assert (obj_size (h) == sizeof *h + dump_size);
+  igc_assert (discardable_size > 2 * sizeof *h);
+  /* Ignore dump_header */
+  set_header (h, IGC_OBJ_PAD, sizeof *h + dump_header_size, 0);
+  /* Ignore discardable section */
+  set_header (hot_end, IGC_OBJ_PAD, discardable_size, 0);
+  /* Ignore relocs */
+  set_header (heap_end, IGC_OBJ_PAD, relocs_size, 0);
+
+  /* Pin some stuff in the dump  */
+  mps_addr_t pinned_roots[] = {
+    charset_table,
+    base_to_client (cold_start), /* code_space_masks */
+    base_to_client (cold_user_data_start),
+  };
+  igc_static_assert (sizeof pinned_roots == sizeof pinned_objects_in_dump);
+  memcpy (pinned_objects_in_dump, pinned_roots, sizeof pinned_roots);
+  igc_root_create_ambig (pinned_objects_in_dump,
+			 (uint8_t *)pinned_objects_in_dump
+			     + sizeof pinned_objects_in_dump);
+
+  /* Copy to buffer text to out of pdump */
+  for (Lisp_Object l = Vbuffer_alist; !NILP (l); l = XCDR (l))
+    {
+      struct buffer *buf = XBUFFER (XCDR (XCAR (l)));
+      eassert (pdumper_object_p (buf->text->beg));
+      enlarge_buffer_text (buf, 0);
+      eassert (!pdumper_object_p (buf->text->beg));
+    }
+}
+
+void *
+igc_alloc_dump (size_t nbytes)
 {
-  mirror_dump (start, end);
+  igc_assert (global_igc->park_count > 0);
+  mps_ap_t ap = thread_ap (IGC_OBJ_CONS);
+  mps_addr_t block;
+  do
+    {
+      mps_res_t res = mps_reserve (&block, ap, nbytes);
+      if (res != MPS_RES_OK)
+	memory_full (0);
+    }
+  while (!mps_commit (ap, block, nbytes));
+  set_header (block, IGC_OBJ_INVALID, nbytes, 0);
+  return base_to_client (block);
 }
 
+struct gap_it
+{
+  void *last_end;
+  struct pdumper_object_it it;
+};
+
+static void *
+gap_it_next (void **gap_end, struct gap_it *it)
+{
+  if (!it->last_end)
+    {
+      it->last_end = (void *)dump_public.start;
+      return gap_it_next (gap_end, it);
+    }
+  else
+    {
+      for (;;)
+	{
+	  struct igc_header *h = pdumper_next_object (&it->it);
+	  if (!h)
+	    {
+	      if (it->last_end == (void *)dump_public.end)
+		return NULL;
+	      else
+		{
+		  void *gap_start = it->last_end;
+		  it->last_end = *gap_end = (void *)dump_public.end;
+		  return gap_start;
+		}
+	    }
+	  void *end = dflt_skip (h);
+	  if (it->last_end == h)
+	    {
+	      it->last_end = end;
+	      continue;
+	    }
+	  void *gap_start = it->last_end;
+	  *gap_end = h;
+	  it->last_end = end;
+	  return gap_start;
+	}
+    }
+}
+
+void
+print_gaps (size_t start, size_t len)
+{
+  struct gap_it it = { 0 };
+  for (size_t i = start; i < start + len; i++)
+    {
+      void *gap_end;
+      void *gap_start = gap_it_next (&gap_end, &it);
+      if (!gap_start)
+	return;
+      size_t offset = (size_t)gap_start - dump_public.start;
+      size_t len = (size_t)gap_end - (size_t)gap_start;
+      fprintf (stderr, "%p: %p %p %zu\n", (void *)offset, gap_start, gap_end,
+	       len);
+    }
+}
 
 \f
 /***********************************************************************
diff --git a/src/igc.h b/src/igc.h
index 559b95bd7e8..e78ec659b8d 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -51,6 +51,11 @@ #define EMACS_IGC_H
   IGC_OBJ_BUILTIN_SYMBOL,
   IGC_OBJ_BUILTIN_THREAD,
   IGC_OBJ_BUILTIN_SUBR,
+  IGC_OBJ_DUMPED_FWD,
+  IGC_OBJ_DUMPED_CHARSET_TABLE,
+  IGC_OBJ_DUMPED_CODE_SPACE_MASKS,
+  IGC_OBJ_DUMPED_BUFFER_TEXT,
+  IGC_OBJ_DUMPED_BYTES,
   IGC_OBJ_NUM_TYPES
 };
 
@@ -65,7 +70,11 @@ #define EMACS_IGC_H
 void *igc_thread_add (struct thread_state *ts);
 void igc_thread_remove (void *info);
 void igc_on_idle (void);
-void igc_on_pdump_loaded (void *start, void *end);
+void igc_on_pdump_loaded (void *dump_base,
+			  void *hot_start, void *hot_end,
+			  void *cold_start, void *cold_end,
+			  void *cold_user_data_start,
+			  void *heap_end);
 void igc_on_face_cache_change (void *face_cache);
 
 void igc_process_messages (void);
@@ -146,6 +155,7 @@ #define EMACS_IGC_H
 size_t igc_header_size (void);
 char *igc_dump_finish_obj (void *client, enum igc_obj_type type,
 			   char *base, char *end);
+void *igc_alloc_dump (size_t nbytes);
 
 # define eassert_not_mps() eassert (false)
 #else
diff --git a/src/pdumper.c b/src/pdumper.c
index 269bc2d2050..c824da06b5e 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -373,6 +373,9 @@ dump_fingerprint (FILE *output, char const *label,
 
 # ifdef HAVE_MPS
   struct dump_table_locator igc_object_starts;
+  dump_off code_space_masks;
+  dump_off cold_user_data_start;
+  dump_off heap_end;
 # endif
 
   /* Relocation table for Emacs; each entry is a struct
@@ -2360,71 +2363,82 @@ dump_fwd_int (struct dump_context *ctx, const struct Lisp_Intfwd *intfwd)
 #endif
   dump_emacs_reloc_immediate_intmax_t (ctx, intfwd->intvar, *intfwd->intvar);
   struct Lisp_Intfwd out;
-  dump_object_start_1 (ctx, &out, sizeof (out));
+  //dump_object_start_1 (ctx, &out, sizeof (out));
+  dump_object_start (ctx, intfwd, IGC_OBJ_DUMPED_FWD, &out, sizeof (out));
   DUMP_FIELD_COPY (&out, intfwd, type);
   dump_field_emacs_ptr (ctx, &out, intfwd, &intfwd->intvar);
-  return dump_object_finish_1 (ctx, &out, sizeof (out));
+  //return dump_object_finish_1 (ctx, &out, sizeof (out));
+  return dump_object_finish (ctx, &out, sizeof (out));
 }
 
 static dump_off
 dump_fwd_bool (struct dump_context *ctx, const struct Lisp_Boolfwd *boolfwd)
 {
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Boolfwd_0EA1C7ADCC)
-# error "Lisp_Boolfwd changed. See CHECK_STRUCTS comment in config.h."
+#if CHECK_STRUCTS && !defined(HASH_Lisp_Boolfwd_0EA1C7ADCC)
+#error "Lisp_Boolfwd changed. See CHECK_STRUCTS comment in config.h."
 #endif
   dump_emacs_reloc_immediate_bool (ctx, boolfwd->boolvar, *boolfwd->boolvar);
   struct Lisp_Boolfwd out;
-  dump_object_start_1 (ctx, &out, sizeof (out));
+  // dump_object_start_1 (ctx, &out, sizeof (out));
+  dump_object_start (ctx, boolfwd, IGC_OBJ_DUMPED_FWD, &out, sizeof (out));
   DUMP_FIELD_COPY (&out, boolfwd, type);
   dump_field_emacs_ptr (ctx, &out, boolfwd, &boolfwd->boolvar);
-  return dump_object_finish_1 (ctx, &out, sizeof (out));
+  // return dump_object_finish_1 (ctx, &out, sizeof (out));
+  return dump_object_finish (ctx, &out, sizeof (out));
 }
 
 static dump_off
 dump_fwd_obj (struct dump_context *ctx, const struct Lisp_Objfwd *objfwd)
 {
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Objfwd_45D3E513DC)
-# error "Lisp_Objfwd changed. See CHECK_STRUCTS comment in config.h."
+#if CHECK_STRUCTS && !defined(HASH_Lisp_Objfwd_45D3E513DC)
+#error "Lisp_Objfwd changed. See CHECK_STRUCTS comment in config.h."
 #endif
   if (NILP (Fgethash (dump_off_to_lisp (emacs_offset (objfwd->objvar)),
-                      ctx->staticpro_table,
-                      Qnil)))
+		      ctx->staticpro_table, Qnil)))
     dump_emacs_reloc_to_lv (ctx, objfwd->objvar, *objfwd->objvar);
   struct Lisp_Objfwd out;
-  dump_object_start_1 (ctx, &out, sizeof (out));
+  // dump_object_start_1 (ctx, &out, sizeof (out));
+  dump_object_start (ctx, objfwd, IGC_OBJ_DUMPED_FWD, &out, sizeof (out));
   DUMP_FIELD_COPY (&out, objfwd, type);
   dump_field_emacs_ptr (ctx, &out, objfwd, &objfwd->objvar);
-  return dump_object_finish_1 (ctx, &out, sizeof (out));
+  // return dump_object_finish_1 (ctx, &out, sizeof (out));
+  return dump_object_finish (ctx, &out, sizeof (out));
 }
 
 static dump_off
 dump_fwd_buffer_obj (struct dump_context *ctx,
-                     const struct Lisp_Buffer_Objfwd *buffer_objfwd)
+		     const struct Lisp_Buffer_Objfwd *buffer_objfwd)
 {
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Buffer_Objfwd_611EBD13FF)
-# error "Lisp_Buffer_Objfwd changed. See CHECK_STRUCTS comment in config.h."
+#if CHECK_STRUCTS && !defined(HASH_Lisp_Buffer_Objfwd_611EBD13FF)
+#error "Lisp_Buffer_Objfwd changed. See CHECK_STRUCTS comment in config.h."
 #endif
   struct Lisp_Buffer_Objfwd out;
-  dump_object_start_1 (ctx, &out, sizeof (out));
+  // dump_object_start_1 (ctx, &out, sizeof (out));
+  dump_object_start (ctx, buffer_objfwd, IGC_OBJ_DUMPED_FWD, &out,
+		     sizeof (out));
   DUMP_FIELD_COPY (&out, buffer_objfwd, type);
   DUMP_FIELD_COPY (&out, buffer_objfwd, offset);
   dump_field_lv (ctx, &out, buffer_objfwd, &buffer_objfwd->predicate,
-                 WEIGHT_NORMAL);
-  return dump_object_finish_1 (ctx, &out, sizeof (out));
+		 WEIGHT_NORMAL);
+  //return dump_object_finish_1 (ctx, &out, sizeof (out));
+  return dump_object_finish (ctx, &out, sizeof (out));
 }
 
 static dump_off
 dump_fwd_kboard_obj (struct dump_context *ctx,
-                     const struct Lisp_Kboard_Objfwd *kboard_objfwd)
+		     const struct Lisp_Kboard_Objfwd *kboard_objfwd)
 {
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Kboard_Objfwd_CAA7E71069)
-# error "Lisp_Intfwd changed. See CHECK_STRUCTS comment in config.h."
+#if CHECK_STRUCTS && !defined(HASH_Lisp_Kboard_Objfwd_CAA7E71069)
+#error "Lisp_Intfwd changed. See CHECK_STRUCTS comment in config.h."
 #endif
   struct Lisp_Kboard_Objfwd out;
-  dump_object_start_1 (ctx, &out, sizeof (out));
+  // dump_object_start_1 (ctx, &out, sizeof (out));
+  dump_object_start (ctx, kboard_objfwd, IGC_OBJ_DUMPED_FWD, &out,
+		     sizeof (out));
   DUMP_FIELD_COPY (&out, kboard_objfwd, type);
   DUMP_FIELD_COPY (&out, kboard_objfwd, offset);
-  return dump_object_finish_1 (ctx, &out, sizeof (out));
+  // return dump_object_finish_1 (ctx, &out, sizeof (out));
+  return dump_object_finish (ctx, &out, sizeof (out));
 }
 
 static dump_off
@@ -3425,6 +3439,9 @@ dump_charset_table (struct dump_context *ctx)
   struct dump_flags old_flags = ctx->flags;
   ctx->flags.pack_objects = true;
   dump_align_output (ctx, alignof (struct charset));
+# ifdef HAVE_MPS
+  dump_igc_start_obj (ctx, IGC_OBJ_DUMPED_CHARSET_TABLE, charset_table);
+# endif
   dump_off offset = ctx->offset;
   if (dump_set_referrer (ctx))
     ctx->current_referrer = build_string ("charset_table");
@@ -3437,6 +3454,9 @@ dump_charset_table (struct dump_context *ctx)
   dump_clear_referrer (ctx);
   dump_emacs_reloc_to_dump_ptr_raw (ctx, &charset_table, offset);
   ctx->flags = old_flags;
+# ifdef HAVE_MPS
+  dump_igc_finish_obj (ctx);
+# endif
   return offset;
 }
 
@@ -3591,6 +3611,32 @@ dump_cold_charset (struct dump_context *ctx, Lisp_Object data)
   dump_write (ctx, cs->code_space_mask, 256);
 }
 
+#ifdef HAVE_MPS
+/* The charsets come all from the charset_table. Combine them to
+   a single IGC_OBJ_DUMPED_CODE_SPACE_MASKS object.
+ */
+static void
+dump_cold_charsets (struct dump_context *ctx, Lisp_Object *cold_queue,
+		    Lisp_Object data)
+{
+  dump_align_output (ctx, DUMP_ALIGNMENT);
+  dump_igc_start_obj (ctx, IGC_OBJ_DUMPED_CODE_SPACE_MASKS, charset_table);
+  eassert (!ctx->header.code_space_masks);
+  ctx->header.code_space_masks = ctx->offset;
+  for (;;)
+    {
+      dump_cold_charset (ctx, data);
+      Lisp_Object next = XCAR (*cold_queue);
+      enum cold_op op = (enum cold_op)XFIXNUM (XCAR (next));
+      if (op != COLD_OP_CHARSET)
+	break;
+      data = XCDR (next);
+      *cold_queue = XCDR (*cold_queue);
+    }
+  dump_igc_finish_obj (ctx);
+}
+#endif
+
 static void
 dump_cold_buffer (struct dump_context *ctx, Lisp_Object data)
 {
@@ -3609,11 +3655,17 @@ dump_cold_buffer (struct dump_context *ctx, Lisp_Object data)
     + 1;
   if (nbytes > DUMP_OFF_MAX)
     error ("buffer too large");
+# ifdef HAVE_MPS
+  dump_igc_start_obj (ctx, IGC_OBJ_DUMPED_BUFFER_TEXT, b->own_text.beg);
+# endif
   dump_remember_fixup_ptr_raw
     (ctx,
      buffer_offset + dump_offsetof (struct buffer, own_text.beg),
      ctx->offset);
   dump_write (ctx, b->own_text.beg, ptrdiff_t_to_dump_off (nbytes));
+# ifdef HAVE_MPS
+  dump_igc_finish_obj (ctx);
+# endif
 }
 
 static void
@@ -3685,7 +3737,11 @@ dump_drain_cold_data (struct dump_context *ctx)
           dump_cold_string (ctx, data);
           break;
         case COLD_OP_CHARSET:
+#ifdef HAVE_MPS
+	  dump_cold_charsets (ctx, &cold_queue, data);
+#else
           dump_cold_charset (ctx, data);
+#endif
           break;
         case COLD_OP_BUFFER:
           dump_cold_buffer (ctx, data);
@@ -4479,6 +4535,13 @@ DEFUN ("dump-emacs-portable",
      never change and so can be direct-mapped from the dump without
      special processing.  */
   dump_drain_cold_data (ctx);
+# ifdef HAVE_MPS
+  dump_align_output (ctx, DUMP_ALIGNMENT);
+  fprintf (stderr, "cold user data: %x\n", (unsigned)ctx->offset);
+  ctx->header.cold_user_data_start = ctx->offset;
+  dump_igc_start_obj (ctx, IGC_OBJ_DUMPED_BYTES, &discardable_end);
+# endif
+
    /* dump_drain_user_remembered_data_cold needs to be after
       dump_drain_cold_data in case dump_drain_cold_data dumps a lisp
       object to which C code points.
@@ -4486,10 +4549,20 @@ DEFUN ("dump-emacs-portable",
       objects have been dumped.  */
   dump_drain_user_remembered_data_cold (ctx);
 
+# ifdef HAVE_MPS
+  dump_align_output (ctx, DUMP_ALIGNMENT);
+  dump_igc_finish_obj (ctx);
+  fprintf (stderr, "heap end: %x\n", (unsigned)ctx->offset);
+# endif
   /* After this point, the dump file contains no data that can be part
      of the Lisp heap.  */
   ctx->end_heap = ctx->offset;
 
+# ifdef HAVE_MPS
+  ctx->header.heap_end = ctx->offset;
+  dump_igc_start_obj (ctx, IGC_OBJ_DUMPED_BYTES, &discardable_end);
+# endif
+
   /* Make remembered modifications to the dump file itself.  */
   dump_do_fixups (ctx);
 
@@ -4520,6 +4593,10 @@ DEFUN ("dump-emacs-portable",
   drain_reloc_list (ctx, dump_emit_emacs_reloc, dump_merge_emacs_relocs,
 		    &ctx->emacs_relocs, &ctx->header.emacs_relocs);
 
+# ifdef HAVE_MPS
+  fprintf (stderr, "cold end: %x\n", (unsigned)ctx->offset);
+  dump_igc_finish_obj (ctx);
+# endif
   const dump_off cold_end = ctx->offset;
 
   eassert (dump_queue_empty_p (&ctx->dump_queue));
@@ -5072,6 +5149,49 @@ dump_mmap_contiguous_heap (struct dump_memory_map *maps, int nr_maps,
   return ret;
 }
 
+#ifdef HAVE_MPS
+
+static void
+dump_mmap_release_mps (struct dump_memory_map *map)
+{
+  emacs_abort ();
+}
+
+/* Implement dump_mmap using mps_reserve and read.  */
+static bool
+dump_mmap_contiguous_mps (struct dump_memory_map *maps, int nr_maps,
+			  size_t total_size)
+{
+  uint8_t *p = igc_alloc_dump (igc_header_size () + total_size);
+  for (size_t i = 0; i < nr_maps; ++i)
+    {
+      struct dump_memory_map *map = &maps[i];
+      const struct dump_memory_map_spec spec = map->spec;
+      if (!spec.size)
+	continue;
+      map->mapping = p;
+      map->release = dump_mmap_release_mps;
+      map->private = NULL;
+      if (spec.fd < 0)
+	memset (map->mapping, 0, spec.size);
+      else
+	{
+	  if (lseek (spec.fd, spec.offset, SEEK_SET) < 0)
+	    return false;
+	  ssize_t nb = dump_read_all (spec.fd, map->mapping, spec.size);
+	  if (nb != spec.size)
+	    {
+	      if (nb >= 0)
+		errno = EIO;
+	      return false;
+	    }
+	}
+      p += spec.size;
+    }
+  return true;
+}
+#endif
+
 static void
 dump_mmap_release_vm (struct dump_memory_map *map)
 {
@@ -5206,12 +5326,17 @@ dump_mmap_contiguous (struct dump_memory_map *maps, int nr_maps)
       eassert (maps[i].release == NULL);
       eassert (maps[i].private == NULL);
       if (i != nr_maps - 1)
-        eassert (maps[i].spec.size % worst_case_page_size == 0);
+	eassert (maps[i].spec.size % worst_case_page_size == 0);
       total_size += maps[i].spec.size;
     }
 
-  return (VM_SUPPORTED ? dump_mmap_contiguous_vm : dump_mmap_contiguous_heap)
-    (maps, nr_maps, total_size);
+#ifdef HAVE_MPS
+  return dump_mmap_contiguous_mps (maps, nr_maps, total_size);
+#else
+  return (VM_SUPPORTED
+	      ? dump_mmap_contiguous_vm
+	      : dump_mmap_contiguous_heap) (maps, nr_maps, total_size);
+#endif
 }
 
 typedef uint_fast32_t dump_bitset_word;
@@ -5953,14 +6078,6 @@ pdumper_load (const char *dump_filename, char *argv0)
   dump_public.start = dump_base;
   dump_public.end = dump_public.start + dump_size;
 
-#ifdef HAVE_MPS
-  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);
   dump_do_all_emacs_relocations (header, dump_base);
 
@@ -5991,8 +6108,24 @@ pdumper_load (const char *dump_filename, char *argv0)
   dump_do_all_dump_reloc_for_phase (header, dump_base, LATE_RELOCS);
   dump_do_all_dump_reloc_for_phase (header, dump_base, VERY_LATE_RELOCS);
 
+#ifdef HAVE_MPS
+  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);
+  void *cold_start = (void *) (dump_base + header->cold_start);
+  void *cold_end = (void *) (dump_base + dump_size);
+  void *cold_user_data_start = (void *) (dump_base +
+					 header->cold_user_data_start);
+  void *heap_end = (void *) (dump_base + header->heap_end);
+#endif
+
 # ifdef HAVE_MPS
-  igc_on_pdump_loaded (hot_start, hot_end);
+  igc_on_pdump_loaded ((void *)dump_base,
+		       hot_start, hot_end,
+		       cold_start, cold_end,
+		       cold_user_data_start, heap_end);
 # endif
 
   /* Run the functions Emacs registered for doing post-dump-load
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-WIP-Trace-the-FWD-objects-in-the-dump.patch --]
[-- Type: text/x-diff, Size: 663 bytes --]

From b8bd9c8e7586c0a71281711ded92816c6d42a0aa Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Sun, 16 Jun 2024 20:33:41 +0200
Subject: [PATCH 2/3] WIP Trace the FWD objects in the dump.

* src/igc.c (fix_symbol):
---
 src/igc.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/igc.c b/src/igc.c
index 50fec431529..56154d0a538 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -787,6 +787,7 @@ fix_symbol (mps_ss_t ss, struct Lisp_Symbol *sym)
 	break;
 
       case SYMBOL_FORWARDED:
+	IGC_FIX12_RAW (ss, &sym->u.s.val.fwd); /* for IGC_OBJ_DUMPED_FWD */
 	IGC_FIX_CALL (ss, fix_fwd (ss, sym->u.s.val.fwd));
 	break;
       }
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-WIP-Remove-uses-of-pdumper_object_p.patch --]
[-- Type: text/x-diff, Size: 1490 bytes --]

From e287a4c8b3264eccf7a40dce105342edf7c96090 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Sun, 16 Jun 2024 20:35:05 +0200
Subject: [PATCH 3/3] WIP Remove uses of pdumper_object_p

* src/igc.c (is_mps, igc_xfree, igc_hash): After the first collection,
pdumper_object_p doesn't make much sense any more.
---
 src/igc.c | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/src/igc.c b/src/igc.c
index 56154d0a538..044c24d4ac8 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -126,7 +126,8 @@ is_pure (const mps_addr_t addr)
 static bool
 is_mps (const mps_addr_t addr)
 {
-  return addr >= min_addr && addr < max_addr && !pdumper_object_p (addr)
+  return addr >= min_addr && addr < max_addr
+    //&& !pdumper_object_p (addr)
     && !c_symbol_p (addr) && !is_pure (addr);
 }
 
@@ -2385,7 +2386,9 @@ igc_realloc_ambig (void *block, size_t size)
 void
 igc_xfree (void *p)
 {
-  if (p == NULL || pdumper_object_p (p))
+  if (p == NULL
+      // || pdumper_object_p (p)
+      )
     return;
   struct igc_root_list *r = root_find (p);
   igc_assert (r != NULL);
@@ -2956,7 +2959,9 @@ igc_hash (Lisp_Object key)
     }
 
   /* Objects in the The dump have igc_headers, too. */
-  if (is_mps (client) || pdumper_object_p (client))
+  if (is_mps (client)
+      //|| pdumper_object_p (client)
+      )
     {
       // The following assertion is very expensive.
       // igc_assert (mps_arena_has_addr (global_igc->arena, client));
-- 
2.39.2

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Sun, Jun 16 2024, Gerd Möllmann wrote:
>
>> If we don't dump_fwd, we would have to make sure though not to overwrite
>> the existing values for symbols in lispsym, which happens in
>> dump_do_dump_relocation
>>
>>     case RELOC_DUMP_TO_EMACS_PTR_RAW:
>>       {
>>         uintptr_t value = dump_read_word_from_dump (dump_base, reloc_offset);
>>         eassert (dump_reloc_size (reloc) == sizeof (value));
>>         value += emacs_basis ();
>>         dump_write_word_to_dump (dump_base, reloc_offset, value);
>>         break;
>>       }
>>
>> The name dump_write_word_to_dump is misleading. It does a memcpy to
>> Emacs' data segment.
>
> Hm, why do you think it writes to the data segment?  Confusing names
> aside, it seems to read a value, which presumably is a pointer, adjusts
> it to the new basis and then writes it back.

Becasue of this

     value += emacs_basis ();

It has dumnped pointer - basis, and now uses that value to get the
pointer in the current process.

>> Maybe one could introduce a new RELOC_xyz type to signify that a
>> forwarding symbol is patched and save the fwd value around the memcpy if
>> needed.
>>
>> Or something like that?
>
> Yes, looks like a better reloc kind is needed.
>
> Below is what I currently have.  Tracing those IGC_OBJ_DUMPED_FWD
> objects seems problematic, especially while the binding of the symbol is
> temporarily swapped out.

Thanks! I'll take a look tomorrow, it's a bit late for me.

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> Below is what I currently have.  

And pushed.

> Tracing those IGC_OBJ_DUMPED_FWD objects seems problematic, especially
> while the binding of the symbol is temporarily swapped out.

The whole dumping of these structs looks highly dubious to me,
independent of MPS. They are constants, always have been, AFAICT, even
from what I remember from the 90s.

Anyway.

Looking forward to the time when the mirror code is gone :-).

Re: MPS: Forwording symbols

[Eli Zaretskii]

> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: Emacs Devel <emacs-devel@gnu.org>,  Eli Zaretskii <eliz@gnu.org>
> Date: Sun, 16 Jun 2024 21:39:41 +0200
> 
> Helmut Eller <eller.helmut@gmail.com> writes:
> 
> > On Sun, Jun 16 2024, Gerd Möllmann wrote:
> >
> >> If we don't dump_fwd, we would have to make sure though not to overwrite
> >> the existing values for symbols in lispsym, which happens in
> >> dump_do_dump_relocation
> >>
> >>     case RELOC_DUMP_TO_EMACS_PTR_RAW:
> >>       {
> >>         uintptr_t value = dump_read_word_from_dump (dump_base, reloc_offset);
> >>         eassert (dump_reloc_size (reloc) == sizeof (value));
> >>         value += emacs_basis ();
> >>         dump_write_word_to_dump (dump_base, reloc_offset, value);
> >>         break;
> >>       }
> >>
> >> The name dump_write_word_to_dump is misleading. It does a memcpy to
> >> Emacs' data segment.
> >
> > Hm, why do you think it writes to the data segment?  Confusing names
> > aside, it seems to read a value, which presumably is a pointer, adjusts
> > it to the new basis and then writes it back.
> 
> Becasue of this
> 
>      value += emacs_basis ();
> 
> It has dumnped pointer - basis, and now uses that value to get the
> pointer in the current process.

Isn't this because the dumped data is loaded with a different base
address than the one with which is was dumped?

Re: MPS: Forwording symbols

[Eli Zaretskii]

> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: Emacs Devel <emacs-devel@gnu.org>,  Eli Zaretskii <eliz@gnu.org>
> Date: Mon, 17 Jun 2024 05:43:11 +0200
> 
> Helmut Eller <eller.helmut@gmail.com> writes:
> 
> > Below is what I currently have.  
> 
> And pushed.

This leads to

    CC       pdumper.o
    CC       igc.o
  igc.c:4746:1: warning: no previous prototype for 'print_gaps' [-Wmissing-prototypes]
   4746 | print_gaps (size_t start, size_t len)
	| ^~~~~~~~~~
  igc.c:4612:1: warning: 'mirror_dump' defined but not used [-Wunused-function]
   4612 | mirror_dump (void *start, void *end)
	| ^~~~~~~~~~~
  pdumper.c:5215:1: warning: 'dump_mmap_contiguous_vm' defined but not used [-Wunused-function]
   5215 | dump_mmap_contiguous_vm (struct dump_memory_map *maps, int nr_maps,
	| ^~~~~~~~~~~~~~~~~~~~~~~
  pdumper.c:5098:1: warning: 'dump_mmap_contiguous_heap' defined but not used [-Wunused-function]
   5098 | dump_mmap_contiguous_heap (struct dump_memory_map *maps, int nr_maps,
	| ^~~~~~~~~~~~~~~~~~~~~~~~~

(the warnings should be harmless, as they are about functions that are
defined, but not used), followed by an infloop in generating/updating
loaddefs.el.

Re: MPS: Forwording symbols

[Gerd Möllmann]

Eli Zaretskii <eliz@gnu.org> writes:

>> > Hm, why do you think it writes to the data segment?  Confusing names
>> > aside, it seems to read a value, which presumably is a pointer, adjusts
>> > it to the new basis and then writes it back.
>> 
>> Becasue of this
>> 
>>      value += emacs_basis ();
>> 
>> It has dumnped pointer - basis, and now uses that value to get the
>> pointer in the current process.
>
> Isn't this because the dumped data is loaded with a different base
> address than the one with which is was dumped?

That'c correct. The same happens, with a different basis, for addresses
in the dump. Helmut asked how I know that it writes to Emacs' data
segment. That's from the use of emacs_basis.

Re: MPS: Forwording symbols

[Eli Zaretskii]

> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: eller.helmut@gmail.com,  emacs-devel@gnu.org
> Date: Mon, 17 Jun 2024 14:15:25 +0200
> 
> Eli Zaretskii <eliz@gnu.org> writes:
> 
> >> > Hm, why do you think it writes to the data segment?  Confusing names
> >> > aside, it seems to read a value, which presumably is a pointer, adjusts
> >> > it to the new basis and then writes it back.
> >> 
> >> Becasue of this
> >> 
> >>      value += emacs_basis ();
> >> 
> >> It has dumnped pointer - basis, and now uses that value to get the
> >> pointer in the current process.
> >
> > Isn't this because the dumped data is loaded with a different base
> > address than the one with which is was dumped?
> 
> That'c correct. The same happens, with a different basis, for addresses
> in the dump. Helmut asked how I know that it writes to Emacs' data
> segment. That's from the use of emacs_basis.

My reading of the code snippet you posted is that it writes to the
same address as the one from which it read.  IOW, the value is read,
updated, and then written to the same address.  Or what did I miss?

Maybe I don't understand what you mean by "Emacs data segment" or what
is the significance of that.

Re: MPS: Forwording symbols

[Gerd Möllmann]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
>> Cc: eller.helmut@gmail.com,  emacs-devel@gnu.org
>> Date: Mon, 17 Jun 2024 14:15:25 +0200
>> 
>> Eli Zaretskii <eliz@gnu.org> writes:
>> 
>> >> > Hm, why do you think it writes to the data segment?  Confusing names
>> >> > aside, it seems to read a value, which presumably is a pointer, adjusts
>> >> > it to the new basis and then writes it back.
>> >> 
>> >> Becasue of this
>> >> 
>> >>      value += emacs_basis ();
>> >> 
>> >> It has dumnped pointer - basis, and now uses that value to get the
>> >> pointer in the current process.
>> >
>> > Isn't this because the dumped data is loaded with a different base
>> > address than the one with which is was dumped?
>> 
>> That'c correct. The same happens, with a different basis, for addresses
>> in the dump. Helmut asked how I know that it writes to Emacs' data
>> segment. That's from the use of emacs_basis.
>
> My reading of the code snippet you posted is that it writes to the
> same address as the one from which it read.  IOW, the value is read,
> updated, and then written to the same address.  Or what did I miss?
>
> Maybe I don't understand what you mean by "Emacs data segment" or what
> is the significance of that.

Oh, I think you're right, I landed in the wrong place. It seems to be
this one:

  static void
  dump_do_emacs_relocation (const uintptr_t dump_base,
                            const struct emacs_reloc reloc)
  {
    ptrdiff_t pval;
    Lisp_Object lv;

    switch (reloc.type)
      {
      case RELOC_EMACS_COPY_FROM_DUMP:
        eassume (reloc.length > 0);
        memcpy (emacs_ptr_at (reloc.emacs_offset),
                dump_ptr (dump_base, reloc.u.dump_offset),
                reloc.length);
        break;

Re: MPS: Forwording symbols

[Helmut Eller]

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

On Mon, Jun 17 2024, Gerd Möllmann wrote:

> The whole dumping of these structs looks highly dubious to me,
> independent of MPS. They are constants, always have been, AFAICT, even
> from what I remember from the 90s.

The patch below creates the necessary relocs so that no forwarding
structs end up in the dump.

> Looking forward to the time when the mirror code is gone :-).

I'm not so optimistic.  The first collection is very slow:

   time ./emacs -batch -f igc--collect
   
   real    0m12.555s
   user    0m11.708s
   sys     0m0.097s

That's not good.  Maybe there is some unfixed problem that is causing
this slowness, but it could also be that MPS simply is so slow for this
allocation pattern.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Don-t-dump-lispfwd-objects.patch --]
[-- Type: text/x-diff, Size: 4360 bytes --]

From a61d8752bfc390df45d8b66c30f81dc5ed5ac2ef Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Mon, 17 Jun 2024 19:47:04 +0200
Subject: [PATCH] Don't dump lispfwd objects

The forwarding structs already exist in the data or bss section.
They are all created with DEFVAR_INT and similar macros.  Instead
of creating new structs in the dump, create relocs to the data section.

* src/pdumper.c (dump_field_fwd): New.
(dump_blv, dump_symbol): Use it.
(dump_pre_dump_symbol): Don't dump fwd objects.
---
 src/pdumper.c | 67 ++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 47 insertions(+), 20 deletions(-)

diff --git a/src/pdumper.c b/src/pdumper.c
index c824da06b5e..f0996cea08c 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2474,6 +2474,51 @@ dump_fwd (struct dump_context *ctx, lispfwd fwd)
   return offset;
 }
 
+static void
+dump_field_fwd (struct dump_context *ctx, void *out, const void *in_start,
+		const lispfwd *in_field)
+{
+  dump_field_emacs_ptr (ctx, out, in_start, in_field);
+  switch (XFWDTYPE (*in_field))
+    {
+    case Lisp_Fwd_Int:
+      {
+	const struct Lisp_Intfwd *fwd = in_field->fwdptr;
+	dump_emacs_reloc_immediate_intmax_t (ctx, fwd->intvar, *fwd->intvar);
+      }
+      break;
+    case Lisp_Fwd_Bool:
+      {
+	const struct Lisp_Boolfwd *fwd = in_field->fwdptr;
+	dump_emacs_reloc_immediate_bool (ctx, fwd->boolvar, *fwd->boolvar);
+      }
+      break;
+    case Lisp_Fwd_Obj:
+      {
+	const struct Lisp_Objfwd *fwd = in_field->fwdptr;
+	if (NILP (Fgethash (dump_off_to_lisp (emacs_offset (fwd->objvar)),
+			    ctx->staticpro_table, Qnil)))
+	  dump_emacs_reloc_to_lv (ctx, fwd->objvar, *fwd->objvar);
+      }
+      break;
+    case Lisp_Fwd_Kboard_Obj:
+      break;
+    case Lisp_Fwd_Buffer_Obj:
+      {
+	const struct Lisp_Buffer_Objfwd *fwd = in_field->fwdptr;
+	dump_emacs_reloc_immediate (ctx, &fwd->type, &fwd->type,
+				    sizeof fwd->type);
+	dump_emacs_reloc_immediate (ctx, &fwd->offset, &fwd->offset,
+				    sizeof fwd->offset);
+	eassert (SYMBOLP (fwd->predicate));
+	/* FIXME: assumes symbols are represented as offsets from lispsym */
+	dump_emacs_reloc_immediate (ctx, &fwd->predicate, &fwd->predicate,
+				    sizeof fwd->predicate);
+      }
+      break;
+    }
+}
+
 static dump_off
 dump_blv (struct dump_context *ctx,
           const struct Lisp_Buffer_Local_Value *blv)
@@ -2486,16 +2531,11 @@ dump_blv (struct dump_context *ctx,
   DUMP_FIELD_COPY (&out, blv, local_if_set);
   DUMP_FIELD_COPY (&out, blv, found);
   if (blv->fwd.fwdptr)
-    dump_field_fixup_later (ctx, &out, blv, &blv->fwd.fwdptr);
+    dump_field_fwd (ctx, &out, blv, &blv->fwd);
   dump_field_lv (ctx, &out, blv, &blv->where, WEIGHT_NORMAL);
   dump_field_lv (ctx, &out, blv, &blv->defcell, WEIGHT_STRONG);
   dump_field_lv (ctx, &out, blv, &blv->valcell, WEIGHT_STRONG);
   dump_off offset = dump_object_finish (ctx, &out, sizeof (out));
-  if (blv->fwd.fwdptr)
-    dump_remember_fixup_ptr_raw
-      (ctx,
-       offset + dump_offsetof (struct Lisp_Buffer_Local_Value, fwd),
-       dump_fwd (ctx, blv->fwd));
   return offset;
 }
 
@@ -2529,10 +2569,6 @@ dump_pre_dump_symbol (struct dump_context *ctx, struct Lisp_Symbol *symbol)
       dump_remember_symbol_aux (ctx, symbol_lv,
 				dump_blv (ctx, symbol->u.s.val.blv));
       break;
-    case SYMBOL_FORWARDED:
-      dump_remember_symbol_aux (ctx, symbol_lv,
-				dump_fwd (ctx, symbol->u.s.val.fwd));
-      break;
     default:
       break;
     }
@@ -2600,7 +2636,7 @@ dump_symbol (struct dump_context *ctx,
       dump_field_fixup_later (ctx, &out, symbol, &symbol->u.s.val.blv);
       break;
     case SYMBOL_FORWARDED:
-      dump_field_fixup_later (ctx, &out, symbol, &symbol->u.s.val.fwd);
+      dump_field_fwd (ctx, &out, symbol, &symbol->u.s.val.fwd);
       break;
     default:
       emacs_abort ();
@@ -2624,15 +2660,6 @@ dump_symbol (struct dump_context *ctx,
 	  ? aux_offset
 	  : dump_blv (ctx, symbol->u.s.val.blv)));
       break;
-    case SYMBOL_FORWARDED:
-      aux_offset = dump_recall_symbol_aux (ctx, make_lisp_symbol (symbol));
-      dump_remember_fixup_ptr_raw
-	(ctx,
-	 offset + dump_offsetof (struct Lisp_Symbol, u.s.val.fwd),
-	 (aux_offset
-	  ? aux_offset
-	  : dump_fwd (ctx, symbol->u.s.val.fwd)));
-      break;
     default:
       break;
     }
-- 
2.39.2

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Mon, Jun 17 2024, Gerd Möllmann wrote:
>
>> The whole dumping of these structs looks highly dubious to me,
>> independent of MPS. They are constants, always have been, AFAICT, even
>> from what I remember from the 90s.
>
> The patch below creates the necessary relocs so that no forwarding
> structs end up in the dump.

Thanks. pushed.

>
>> Looking forward to the time when the mirror code is gone :-).
>
> I'm not so optimistic.  The first collection is very slow:
>
>    time ./emacs -batch -f igc--collect
>    
>    real    0m12.555s
>    user    0m11.708s
>    sys     0m0.097s

That's pretty slow, indeed. The version of Emacs I'm currently running,
which is my fork which does not contain your recent changes, and is an
optimized build with -lmps says

.../emacs/github/igc % /usr/bin/time src/emacs -batch -f igc--collect
        0.25 real         0.14 user         0.11 sys

> That's not good.  Maybe there is some unfixed problem that is causing
> this slowness, but it could also be that MPS simply is so slow for this
> allocation pattern.

I guess it is what you suspect because I run into an assertion when dumping:

  Dumping fingerprint: 79b503a407de48b18f4c304971c234d89bf236c259a1e7cd857559f919943b91

  igc.c:345: Emacs fatal error: assertion failed: h->obj_type == IGC_OBJ_PAD || nbytes >= sizeof (struct igc_fwd)
  Fatal error 6: Aborted

That's a build starting from git clean -xdf, optimized, -lmps, and no
native compilation here of course.

I'll try to debug this, but I think I have to read the new code first a
bit to understand where to start.

Re: MPS: Forwording symbols

[Gerd Möllmann]

Gerd Möllmann <gerd.moellmann@gmail.com> writes:

> Helmut Eller <eller.helmut@gmail.com> writes:
>
>> On Mon, Jun 17 2024, Gerd Möllmann wrote:
>>
>>> The whole dumping of these structs looks highly dubious to me,
>>> independent of MPS. They are constants, always have been, AFAICT, even
>>> from what I remember from the 90s.
>>
>> The patch below creates the necessary relocs so that no forwarding
>> structs end up in the dump.
>
> Thanks. pushed.
>
>>
>>> Looking forward to the time when the mirror code is gone :-).
>>
>> I'm not so optimistic.  The first collection is very slow:
>>
>>    time ./emacs -batch -f igc--collect
>>    
>>    real    0m12.555s
>>    user    0m11.708s
>>    sys     0m0.097s
>
> That's pretty slow, indeed. The version of Emacs I'm currently running,
> which is my fork which does not contain your recent changes, and is an
> optimized build with -lmps says
>
> .../emacs/github/igc % /usr/bin/time src/emacs -batch -f igc--collect
>         0.25 real         0.14 user         0.11 sys
>
>> That's not good.  Maybe there is some unfixed problem that is causing
>> this slowness, but it could also be that MPS simply is so slow for this
>> allocation pattern.
>
> I guess it is what you suspect because I run into an assertion when dumping:
>
>   Dumping fingerprint: 79b503a407de48b18f4c304971c234d89bf236c259a1e7cd857559f919943b91
>
>   igc.c:345: Emacs fatal error: assertion failed: h->obj_type == IGC_OBJ_PAD || nbytes >= sizeof (struct igc_fwd)
>   Fatal error 6: Aborted
>
> That's a build starting from git clean -xdf, optimized, -lmps, and no
> native compilation here of course.
>
> I'll try to debug this, but I think I have to read the new code first a
> bit to understand where to start.

Anyway, maybe the following gives you a hint already. The abort happens
with this backtrace while writing the dump

* thread #1, queue = 'com.apple.main-thread', stop reason = breakpoint 5.2
    frame #0: 0x00000001001e3cf8 bootstrap-emacs`emacs_abort at sysdep.c:2391:3
    frame #1: 0x00000001003ec57c bootstrap-emacs`ns_term_shutdown(sig=6) at nsterm.m:5889:5
    frame #2: 0x00000001001a2dbc bootstrap-emacs`shut_down_emacs(sig=6, stuff=(struct Lisp_Symbol *) $2 = 0x0000000100ca5010) at emacs.c:3162:3
    frame #3: 0x00000001001a27a4 bootstrap-emacs`terminate_due_to_signal(sig=6, backtrace_limit=2147483647) at emacs.c:464:11
    frame #4: 0x0000000100399fa4 bootstrap-emacs`igc_assert_fail(file="igc.c", line=345, msg="h->obj_type == IGC_OBJ_PAD || nbytes >= sizeof (struct igc_fwd)") at igc.c:82:3
    frame #5: 0x000000010039cde8 bootstrap-emacs`obj_size(h=0x00000001298085f8) at igc.c:345:3
    frame #6: 0x000000010039cc6c bootstrap-emacs`igc_dump_finish_obj(client=0x0000000129808600, type=IGC_OBJ_DUMPED_BUFFER_TEXT, base="", end="") at igc.c:3721:7
    frame #7: 0x0000000100277fc0 bootstrap-emacs`dump_igc_finish_obj(ctx=0x000000016fdfc3e8) at pdumper.c:910:26
  * frame #8: 0x00000001002840d0 bootstrap-emacs`dump_cold_buffer(ctx=0x000000016fdfc3e8, data=(struct buffer *) $3 = 0x000000010e4d3308) at pdumper.c:3694:3

here:
  char *
  igc_dump_finish_obj (void *client, enum igc_obj_type type,
                       char *base, char *end)
  {
    if (client == NULL)
      return end;

    struct igc_header *out = (struct igc_header *) base;
    if (is_mps (client))
      {
        struct igc_header *h = client_to_base (client);
        if (h->obj_type == IGC_OBJ_VECTOR_WEAK)
          igc_assert (
            (type == IGC_OBJ_VECTOR && h->obj_type == IGC_OBJ_VECTOR_WEAK)
            || h->obj_type == type);
        igc_assert (base + obj_size (h) >= end);

Looks like the client object passed in is bogus

  (lldb) p *h
  (igc_header)  (obj_type = IGC_OBJ_INVALID, hash = 128931976, nwords = 1)
  (lldb)

Re: MPS: Forwording symbols

[Helmut Eller]

On Mon, Jun 17 2024, Gerd Möllmann wrote:

> Looks like the client object passed in is bogus
>
>   (lldb) p *h
>   (igc_header)  (obj_type = IGC_OBJ_INVALID, hash = 128931976, nwords = 1)
>   (lldb)

Hm, is_mps used filter that out.  Now pdumper_object_p must
called explicitly:

   if (is_mps (client) && !pdumper_object_p (client)) ...

Re: MPS: Forwording symbols

[Gerd Möllmann]

Gerd Möllmann <gerd.moellmann@gmail.com> writes:

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>> Helmut Eller <eller.helmut@gmail.com> writes:
>>
>>> On Mon, Jun 17 2024, Gerd Möllmann wrote:
>>>
>>>> The whole dumping of these structs looks highly dubious to me,
>>>> independent of MPS. They are constants, always have been, AFAICT, even
>>>> from what I remember from the 90s.
>>>
>>> The patch below creates the necessary relocs so that no forwarding
>>> structs end up in the dump.
>>
>> Thanks. pushed.
>>
>>>
>>>> Looking forward to the time when the mirror code is gone :-).
>>>
>>> I'm not so optimistic.  The first collection is very slow:
>>>
>>>    time ./emacs -batch -f igc--collect
>>>    
>>>    real    0m12.555s
>>>    user    0m11.708s
>>>    sys     0m0.097s
>>
>> That's pretty slow, indeed. The version of Emacs I'm currently running,
>> which is my fork which does not contain your recent changes, and is an
>> optimized build with -lmps says
>>
>> .../emacs/github/igc % /usr/bin/time src/emacs -batch -f igc--collect
>>         0.25 real         0.14 user         0.11 sys
>>
>>> That's not good.  Maybe there is some unfixed problem that is causing
>>> this slowness, but it could also be that MPS simply is so slow for this
>>> allocation pattern.
>>
>> I guess it is what you suspect because I run into an assertion when dumping:
>>
>>   Dumping fingerprint: 79b503a407de48b18f4c304971c234d89bf236c259a1e7cd857559f919943b91
>>
>>   igc.c:345: Emacs fatal error: assertion failed: h->obj_type == IGC_OBJ_PAD || nbytes >= sizeof (struct igc_fwd)
>>   Fatal error 6: Aborted
>>
>> That's a build starting from git clean -xdf, optimized, -lmps, and no
>> native compilation here of course.
>>
>> I'll try to debug this, but I think I have to read the new code first a
>> bit to understand where to start.
>
> Anyway, maybe the following gives you a hint already. The abort happens
> with this backtrace while writing the dump
>
> * thread #1, queue = 'com.apple.main-thread', stop reason = breakpoint 5.2
>     frame #0: 0x00000001001e3cf8 bootstrap-emacs`emacs_abort at sysdep.c:2391:3
>     frame #1: 0x00000001003ec57c bootstrap-emacs`ns_term_shutdown(sig=6) at nsterm.m:5889:5
>     frame #2: 0x00000001001a2dbc bootstrap-emacs`shut_down_emacs(sig=6, stuff=(struct Lisp_Symbol *) $2 = 0x0000000100ca5010) at emacs.c:3162:3
>     frame #3: 0x00000001001a27a4 bootstrap-emacs`terminate_due_to_signal(sig=6, backtrace_limit=2147483647) at emacs.c:464:11
>     frame #4: 0x0000000100399fa4 bootstrap-emacs`igc_assert_fail(file="igc.c", line=345, msg="h->obj_type == IGC_OBJ_PAD || nbytes >= sizeof (struct igc_fwd)") at igc.c:82:3
>     frame #5: 0x000000010039cde8 bootstrap-emacs`obj_size(h=0x00000001298085f8) at igc.c:345:3
>     frame #6: 0x000000010039cc6c bootstrap-emacs`igc_dump_finish_obj(client=0x0000000129808600, type=IGC_OBJ_DUMPED_BUFFER_TEXT, base="", end="") at igc.c:3721:7
>     frame #7: 0x0000000100277fc0 bootstrap-emacs`dump_igc_finish_obj(ctx=0x000000016fdfc3e8) at pdumper.c:910:26
>   * frame #8: 0x00000001002840d0 bootstrap-emacs`dump_cold_buffer(ctx=0x000000016fdfc3e8, data=(struct buffer *) $3 = 0x000000010e4d3308) at pdumper.c:3694:3
>
> here:
>   char *
>   igc_dump_finish_obj (void *client, enum igc_obj_type type,
>                        char *base, char *end)
>   {
>     if (client == NULL)
>       return end;
>
>     struct igc_header *out = (struct igc_header *) base;
>     if (is_mps (client))
>       {
>         struct igc_header *h = client_to_base (client);
>         if (h->obj_type == IGC_OBJ_VECTOR_WEAK)
>           igc_assert (
>             (type == IGC_OBJ_VECTOR && h->obj_type == IGC_OBJ_VECTOR_WEAK)
>             || h->obj_type == type);
>         igc_assert (base + obj_size (h) >= end);
>
> Looks like the client object passed in is bogus
>
>   (lldb) p *h
>   (igc_header)  (obj_type = IGC_OBJ_INVALID, hash = 128931976, nwords = 1)
>   (lldb)

And that is because for the 2nd buffer that is dumped in
dump_cold_buffer

  (lldb) p is_mps (b->own_text.beg)
  (bool) true

which makes igc_dump_finish_obj assume it is an MPS object which I don't
think it is, or is it?

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Mon, Jun 17 2024, Gerd Möllmann wrote:
>
>> Looks like the client object passed in is bogus
>>
>>   (lldb) p *h
>>   (igc_header)  (obj_type = IGC_OBJ_INVALID, hash = 128931976, nwords = 1)
>>   (lldb)
>
> Hm, is_mps used filter that out.  Now pdumper_object_p must
> called explicitly:
>
>    if (is_mps (client) && !pdumper_object_p (client)) ...

With

  char *
  igc_dump_finish_obj (void *client, enum igc_obj_type type,
                       char *base, char *end)
  {
    if (client == NULL)
      return end;

    struct igc_header *out = (struct igc_header *) base;
    if (is_mps (client) && !pdumper_object_p (client))
      {
        struct igc_header *h = client_to_base (client);
        if (h->obj_type == IGC_OBJ_VECTOR_WEAK)
          igc_assert (
            (type == IGC_OBJ_VECTOR && h->obj_type == IGC_OBJ_VECTOR_WEAK)
            || h->obj_type == type);
        igc_assert (base + obj_size (h) >= end);

I still get the same assertion because client is not pdumper_object_p.
Could it be that we have to use pdumper_cold_object_p? I'll
give it a try. Strangely, I can't call that function in LLDB... :-(

Re: MPS: Forwording symbols

[Helmut Eller]

On Mon, Jun 17 2024, Gerd Möllmann wrote:

> I still get the same assertion because client is not pdumper_object_p.
> Could it be that we have to use pdumper_cold_object_p? I'll
> give it a try. Strangely, I can't call that function in LLDB... :-(

dump_cold_buffer uses a dirty trick to get that damn
IGC_OBJ_DUMPED_BUFFER_TEXT header written out.  igc_dump_finish_obj
could just check the type.  That's something for tomorrow.  Now it's too
late.

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Mon, Jun 17 2024, Gerd Möllmann wrote:
>
>> I still get the same assertion because client is not pdumper_object_p.
>> Could it be that we have to use pdumper_cold_object_p? I'll
>> give it a try. Strangely, I can't call that function in LLDB... :-(
>
> dump_cold_buffer uses a dirty trick to get that damn
> IGC_OBJ_DUMPED_BUFFER_TEXT header written out.  igc_dump_finish_obj
> could just check the type.  That's something for tomorrow.  Now it's too
> late.

Ok. I'll push something that lets me build, and with an optimized build
I get

.../emacs/savannah/igc % /usr/bin/time src/emacs -batch -f igc--collect
        0.18 real         0.09 user         0.08 sys

Not too bad :-). Good night!

Re: MPS: Forwording symbols

[Gerd Möllmann]

Gerd Möllmann <gerd.moellmann@gmail.com> writes:

> Helmut Eller <eller.helmut@gmail.com> writes:
>
>> On Mon, Jun 17 2024, Gerd Möllmann wrote:
>>
>>> I still get the same assertion because client is not pdumper_object_p.
>>> Could it be that we have to use pdumper_cold_object_p? I'll
>>> give it a try. Strangely, I can't call that function in LLDB... :-(
>>
>> dump_cold_buffer uses a dirty trick to get that damn
>> IGC_OBJ_DUMPED_BUFFER_TEXT header written out.  igc_dump_finish_obj
>> could just check the type.  That's something for tomorrow.  Now it's too
>> late.
>
> Ok. I'll push something that lets me build, and with an optimized build
> I get
>
> .../emacs/savannah/igc % /usr/bin/time src/emacs -batch -f igc--collect
>         0.18 real         0.09 user         0.08 sys
>
> Not too bad :-). Good night!

I've now pushed a change that makes IGC_DEBUG optional, which makes the
various igc_asserts in igc.c optional, so that one can get a really
optimized build. To enable IGC_DEBUG one now has to configure with
--enable-checking=igc_debug. It's not included in 'all', so one has to
do something like --enable-checking=all,igc_debug to get both.

Overall, the times when not mirroring are consistently better than
before, unsurprisingly.

It's itching me to axe the mirroring code...

Re: MPS: Forwording symbols

[Helmut Eller]

On Tue, Jun 18 2024, Gerd Möllmann wrote:

>> Ok. I'll push something that lets me build, and with an optimized build
>> I get
>>
>> .../emacs/savannah/igc % /usr/bin/time src/emacs -batch -f igc--collect
>>         0.18 real         0.09 user         0.08 sys
>>
>> Not too bad :-). Good night!

That looks more reasonable.

> I've now pushed a change that makes IGC_DEBUG optional, which makes the
> various igc_asserts in igc.c optional, so that one can get a really
> optimized build. To enable IGC_DEBUG one now has to configure with
> --enable-checking=igc_debug. It's not included in 'all', so one has to
> do something like --enable-checking=all,igc_debug to get both.

So it was all the debugging/checking code that made my version so slow.

> It's itching me to axe the mirroring code...

One remaining problem is what to do with all the uses of
pdumper_object_p.  Those in buffer.c are at least easy to understand.
Strange: there are 4 IGC_OBJ_DUMPED_BUFFER_TEXT objects in the dump but
only 3 buffers in Vbuffer_alist.

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Tue, Jun 18 2024, Gerd Möllmann wrote:
>
>>> Ok. I'll push something that lets me build, and with an optimized build
>>> I get
>>>
>>> .../emacs/savannah/igc % /usr/bin/time src/emacs -batch -f igc--collect
>>>         0.18 real         0.09 user         0.08 sys
>>>
>>> Not too bad :-). Good night!
>
> That looks more reasonable.

👍

>> I've now pushed a change that makes IGC_DEBUG optional, which makes the
>> various igc_asserts in igc.c optional, so that one can get a really
>> optimized build. To enable IGC_DEBUG one now has to configure with
>> --enable-checking=igc_debug. It's not included in 'all', so one has to
>> do something like --enable-checking=all,igc_debug to get both.
>
> So it was all the debugging/checking code that made my version so
> slow.

-lmps-debug also adds a lot, in my experience.

>> It's itching me to axe the mirroring code...
>
> One remaining problem is what to do with all the uses of
> pdumper_object_p.  

I can offer to take care of these, if you want. But I would also remove
that child of tunnel vision, you know what I mean...

> Those in buffer.c are at least easy to understand. Strange: there are
> 4 IGC_OBJ_DUMPED_BUFFER_TEXT objects in the dump but only 3 buffers in
> Vbuffer_alist.

Somehow there is never an end to surprises...

Re: MPS: Forwording symbols

[Gerd Möllmann]

Gerd Möllmann <gerd.moellmann@gmail.com> writes:

>> One remaining problem is what to do with all the uses of
>> pdumper_object_p.  
>
> I can offer to take care of these, if you want. But I would also remove
> that child of tunnel vision, you know what I mean...

I've now just done that, sorry :-). Except that I didn't look at the
pdumper_object_p outside igc.c because I think these should all be ok.

Re: MPS: Forwording symbols

[Helmut Eller]

On Tue, Jun 18 2024, Gerd Möllmann wrote:

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>>> One remaining problem is what to do with all the uses of
>>> pdumper_object_p.  
>>
>> I can offer to take care of these, if you want. But I would also remove
>> that child of tunnel vision, you know what I mean...

Hm, not sure what you mean.  I was thinking about shrinking the region
in dump_public to the part that is pinned or making it empty.

> I've now just done that, sorry :-). Except that I didn't look at the
> pdumper_object_p outside igc.c because I think these should all be ok.

In alloc.c, pdumper_object_p is used a lot.  Let's hope for the best :-).

Re: MPS: Forwording symbols

[Helmut Eller]

On Tue, Jun 18 2024, Gerd Möllmann wrote:

>> Those in buffer.c are at least easy to understand. Strange: there are
>> 4 IGC_OBJ_DUMPED_BUFFER_TEXT objects in the dump but only 3 buffers in
>> Vbuffer_alist.
>
> Somehow there is never an end to surprises...

An interesting comment in buffer.c:

      /* The dumped buffers reference addresses of buffer text
	 recorded by temacs, that cannot be used by the dumped Emacs.
	 We map new memory for their text here.

	 Implementation notes: the buffers we carry from temacs are:
	 " prin1", "*scratch*", " *Minibuf-0*", "*Messages*", and
	 " *code-conversion-work*".  They are created by
	 init_buffer_once and init_window_once (which are not called
	 in the dumped Emacs), and by the first call to coding.c
	 routines.  Since FOR_EACH_LIVE_BUFFER only walks the buffers
	 in Vbuffer_alist, any buffer we carry from temacs that is
	 not in the alist (a.k.a. "magic invisible buffers") should
	 be handled here explicitly.  */
      FOR_EACH_LIVE_BUFFER (tail, buffer)
        {
	  struct buffer *b = XBUFFER (buffer);
	  b->text->beg = NULL;
	  enlarge_buffer_text (b, 0);
	}
      /* The " prin1" buffer is not in Vbuffer_alist.  */
      XBUFFER (Vprin1_to_string_buffer)->text->beg = NULL;
      enlarge_buffer_text (XBUFFER (Vprin1_to_string_buffer), 0);

The " *code-conversion-work*" buffer doesn't seem to exist anymore and
the only non-empty buffer is *Messages*, which contains 374 bytes
(pretty useless to have in the dump).  The quoted code is only used when
dumped_with_unexec_p, but I was going to do almost the same.

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Tue, Jun 18 2024, Gerd Möllmann wrote:
>
>> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>>
>>>> One remaining problem is what to do with all the uses of
>>>> pdumper_object_p.  
>>>
>>> I can offer to take care of these, if you want. But I would also remove
>>> that child of tunnel vision, you know what I mean...
>
> Hm, not sure what you mean.  I was thinking about shrinking the region
> in dump_public to the part that is pinned or making it empty.

I meant the mirroring code. I find it still funny that I completely
overlooked the idea of simply loading the dump into an area allocated
from MPS :-). Instead: here's a object graph, or graph(s), - and wee
let's copy them :-). Really strange :-).

>> I've now just done that, sorry :-). Except that I didn't look at the
>> pdumper_object_p outside igc.c because I think these should all be ok.
>
> In alloc.c, pdumper_object_p is used a lot.  Let's hope for the best :-).

Et het noch immer jootjejange :-)

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Tue, Jun 18 2024, Gerd Möllmann wrote:
>
>>> Those in buffer.c are at least easy to understand. Strange: there are
>>> 4 IGC_OBJ_DUMPED_BUFFER_TEXT objects in the dump but only 3 buffers in
>>> Vbuffer_alist.
>>
>> Somehow there is never an end to surprises...
>
> An interesting comment in buffer.c:
>
>       /* The dumped buffers reference addresses of buffer text
> 	 recorded by temacs, that cannot be used by the dumped Emacs.
> 	 We map new memory for their text here.
>
> 	 Implementation notes: the buffers we carry from temacs are:
> 	 " prin1", "*scratch*", " *Minibuf-0*", "*Messages*", and
> 	 " *code-conversion-work*".  They are created by
> 	 init_buffer_once and init_window_once (which are not called
> 	 in the dumped Emacs), and by the first call to coding.c
> 	 routines.  Since FOR_EACH_LIVE_BUFFER only walks the buffers
> 	 in Vbuffer_alist, any buffer we carry from temacs that is
> 	 not in the alist (a.k.a. "magic invisible buffers") should
> 	 be handled here explicitly.  */
>       FOR_EACH_LIVE_BUFFER (tail, buffer)
>         {
> 	  struct buffer *b = XBUFFER (buffer);
> 	  b->text->beg = NULL;
> 	  enlarge_buffer_text (b, 0);
> 	}
>       /* The " prin1" buffer is not in Vbuffer_alist.  */
>       XBUFFER (Vprin1_to_string_buffer)->text->beg = NULL;
>       enlarge_buffer_text (XBUFFER (Vprin1_to_string_buffer), 0);
>
> The " *code-conversion-work*" buffer doesn't seem to exist anymore and
> the only non-empty buffer is *Messages*, which contains 374 bytes
> (pretty useless to have in the dump).  The quoted code is only used when
> dumped_with_unexec_p, but I was going to do almost the same.

Interesting, thanks!

Re: MPS: Forwording symbols

[Eli Zaretskii]

> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: Emacs Devel <emacs-devel@gnu.org>,  Eli Zaretskii <eliz@gnu.org>
> Date: Mon, 17 Jun 2024 22:07:03 +0200
> 
> Helmut Eller <eller.helmut@gmail.com> writes:
> 
> > On Mon, Jun 17 2024, Gerd Möllmann wrote:
> >
> >> I still get the same assertion because client is not pdumper_object_p.
> >> Could it be that we have to use pdumper_cold_object_p? I'll
> >> give it a try. Strangely, I can't call that function in LLDB... :-(
> >
> > dump_cold_buffer uses a dirty trick to get that damn
> > IGC_OBJ_DUMPED_BUFFER_TEXT header written out.  igc_dump_finish_obj
> > could just check the type.  That's something for tomorrow.  Now it's too
> > late.
> 
> Ok. I'll push something that lets me build, and with an optimized build
> I get
> 
> .../emacs/savannah/igc % /usr/bin/time src/emacs -batch -f igc--collect
>         0.18 real         0.09 user         0.08 sys
> 
> Not too bad :-). Good night!

The latest HEAD builds here with one harmless warning:

  pdumper.c:4776:1: warning: 'dump_map_file_w32' defined but not used [-Wunused-function]
   4776 | dump_map_file_w32 (void *base, int fd, off_t offset, size_t size,
	| ^~~~~~~~~~~~~~~~~
  pdumper.c:4639:1: warning: 'dump_anonymous_allocate_w32' defined but not used [-Wunused-function]
   4639 | dump_anonymous_allocate_w32 (void *base,
	| ^~~~~~~~~~~~~~~~~~~~~~~~~~~

and still infloops(?), hitting SIGSEGV repeatedly here:

  Thread 1 received signal SIGSEGV, Segmentation fault.
  igc_on_pdump_loaded (dump_base=dump_base@entry=0xb000008,
      hot_start=hot_start@entry=0xb000080, hot_end=0xb585408,
      cold_start=0xb5b0008, cold_end=cold_end@entry=0xba8b6a8,
      cold_user_data_start=0xb7038a8, heap_end=0xb707af8) at igc.c:3763
  3763      eassert (((struct igc_header *)cold_start)->obj_type
  (gdb) p cold_start
  $1 = (void *) 0xb5b0008
  (gdb) p ((struct igc_header *)cold_start)->obj_type
  Cannot access memory at address 0xb5b0008

Any ideas are welcome.  I will gladly provide more information if
needed.

Thanks.

Re: MPS: Forwording symbols

[Eli Zaretskii]

> From: Helmut Eller <eller.helmut@gmail.com>
> Cc: Emacs Devel <emacs-devel@gnu.org>,  Eli Zaretskii <eliz@gnu.org>
> Date: Tue, 18 Jun 2024 14:05:39 +0200
> 
> On Tue, Jun 18 2024, Gerd Möllmann wrote:
> 
> >> Those in buffer.c are at least easy to understand. Strange: there are
> >> 4 IGC_OBJ_DUMPED_BUFFER_TEXT objects in the dump but only 3 buffers in
> >> Vbuffer_alist.
> >
> > Somehow there is never an end to surprises...
> 
> An interesting comment in buffer.c:

Yes, yours truly is responsible for it ;-)

>       /* The dumped buffers reference addresses of buffer text
> 	 recorded by temacs, that cannot be used by the dumped Emacs.
> 	 We map new memory for their text here.
> 
> 	 Implementation notes: the buffers we carry from temacs are:
> 	 " prin1", "*scratch*", " *Minibuf-0*", "*Messages*", and
> 	 " *code-conversion-work*".  They are created by
> 	 init_buffer_once and init_window_once (which are not called
> 	 in the dumped Emacs), and by the first call to coding.c
> 	 routines.  Since FOR_EACH_LIVE_BUFFER only walks the buffers
> 	 in Vbuffer_alist, any buffer we carry from temacs that is
> 	 not in the alist (a.k.a. "magic invisible buffers") should
> 	 be handled here explicitly.  */
>       FOR_EACH_LIVE_BUFFER (tail, buffer)
>         {
> 	  struct buffer *b = XBUFFER (buffer);
> 	  b->text->beg = NULL;
> 	  enlarge_buffer_text (b, 0);
> 	}
>       /* The " prin1" buffer is not in Vbuffer_alist.  */
>       XBUFFER (Vprin1_to_string_buffer)->text->beg = NULL;
>       enlarge_buffer_text (XBUFFER (Vprin1_to_string_buffer), 0);
> 
> The " *code-conversion-work*" buffer doesn't seem to exist anymore and

It does exist.  From coding.c:

  Vcode_conversion_workbuf_name = build_pure_c_string (" *code-conversion-work*");

AFAIR, whether it exists in the dump depends on what happens during
dumping, probably due to locale differences or something.

Re: MPS: Forwording symbols

[Helmut Eller]

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

On Tue, Jun 18 2024, Eli Zaretskii wrote:

> Any ideas are welcome.  I will gladly provide more information if
> needed.

The 32-bit build has two bignums in the dump.  Can you try this patch?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Support-dumping-bignums.patch --]
[-- Type: text/x-diff, Size: 3659 bytes --]

From a89b85b556f3905d42b588042475dc56981073f3 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Tue, 18 Jun 2024 18:12:11 +0200
Subject: [PATCH] Support dumping bignums

* src/igc.h (enum igc_obj_type): Add IGC_OBJ_DUMPED_BIGNUM_DATA.
* src/igc.h: Allow IGC_OBJ_DUMPED_BIGNUM_DATA in the usual places.
* src/pdumper.c (dump_cold_bignum): Emit IGC_OBJ_DUMPED_BIGNUM_DATA
headers.
---
 src/igc.c     | 6 ++++++
 src/igc.h     | 1 +
 src/pdumper.c | 6 ++++++
 3 files changed, 13 insertions(+)

diff --git a/src/igc.c b/src/igc.c
index 7443973f033..b80d8e7251a 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -208,6 +208,7 @@ #define IGC_DEFINE_LIST(data)                                                  \
   "IGC_OBJ_DUMPED_CHARSET_TABLE",
   "IGC_OBJ_DUMPED_CODE_SPACE_MASKS",
   "IGC_OBJ_DUMPED_BUFFER_TEXT",
+  "IGC_OBJ_DUMPED_BIGNUM_DATA",
   "IGC_OBJ_DUMPED_BYTES",
 };
 
@@ -1374,6 +1375,7 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
       case IGC_OBJ_BYTES:
       case IGC_OBJ_DUMPED_CODE_SPACE_MASKS:
       case IGC_OBJ_DUMPED_BUFFER_TEXT:
+      case IGC_OBJ_DUMPED_BIGNUM_DATA:
       case IGC_OBJ_DUMPED_BYTES:
 	/* Can occur in the dump. */
 	break;
@@ -2691,6 +2693,7 @@ finalize (struct igc *gc, mps_addr_t base)
     case IGC_OBJ_DUMPED_CHARSET_TABLE:
     case IGC_OBJ_DUMPED_CODE_SPACE_MASKS:
     case IGC_OBJ_DUMPED_BUFFER_TEXT:
+    case IGC_OBJ_DUMPED_BIGNUM_DATA:
     case IGC_OBJ_DUMPED_BYTES:
     case IGC_OBJ_BYTES:
     case IGC_OBJ_NUM_TYPES:
@@ -2862,6 +2865,7 @@ thread_ap (enum igc_obj_type type)
     case IGC_OBJ_DUMPED_CHARSET_TABLE:
     case IGC_OBJ_DUMPED_CODE_SPACE_MASKS:
     case IGC_OBJ_DUMPED_BUFFER_TEXT:
+    case IGC_OBJ_DUMPED_BIGNUM_DATA:
     case IGC_OBJ_DUMPED_BYTES:
     case IGC_OBJ_NUM_TYPES:
       emacs_abort ();
@@ -3654,6 +3658,7 @@ builtin_obj_type_and_hash (size_t *hash, enum igc_obj_type type, void *client)
   if (type == IGC_OBJ_DUMPED_CHARSET_TABLE
       || type == IGC_OBJ_DUMPED_CODE_SPACE_MASKS
       || type == IGC_OBJ_DUMPED_BUFFER_TEXT
+      || type == IGC_OBJ_DUMPED_BIGNUM_DATA
       || type == IGC_OBJ_DUMPED_BYTES)
     {
       *hash = 0;
@@ -3716,6 +3721,7 @@ igc_dump_finish_obj (void *client, enum igc_obj_type type,
     case IGC_OBJ_DUMPED_CHARSET_TABLE:
     case IGC_OBJ_DUMPED_CODE_SPACE_MASKS:
     case IGC_OBJ_DUMPED_BUFFER_TEXT:
+    case IGC_OBJ_DUMPED_BIGNUM_DATA:
     case IGC_OBJ_DUMPED_BYTES:
       is_in_dump = true;
       break;
diff --git a/src/igc.h b/src/igc.h
index f7833a713d8..55ef7d4d56c 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -54,6 +54,7 @@ #define EMACS_IGC_H
   IGC_OBJ_DUMPED_CHARSET_TABLE,
   IGC_OBJ_DUMPED_CODE_SPACE_MASKS,
   IGC_OBJ_DUMPED_BUFFER_TEXT,
+  IGC_OBJ_DUMPED_BIGNUM_DATA,
   IGC_OBJ_DUMPED_BYTES,
   IGC_OBJ_NUM_TYPES
 };
diff --git a/src/pdumper.c b/src/pdumper.c
index 9147be38294..5a8dc2ad466 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -3584,6 +3584,9 @@ dump_cold_bignum (struct dump_context *ctx, Lisp_Object object)
   eassert (sz_nlimbs < DUMP_OFF_MAX);
   dump_align_output (ctx, alignof (mp_limb_t));
   dump_off nlimbs = (dump_off) sz_nlimbs;
+# ifdef HAVE_MPS
+  dump_igc_start_obj (ctx, IGC_OBJ_DUMPED_BIGNUM_DATA, n);
+# endif
   Lisp_Object descriptor
     = list2 (dump_off_to_lisp (ctx->offset),
 	     dump_off_to_lisp (mpz_sgn (*n) < 0 ? -nlimbs : nlimbs));
@@ -3593,6 +3596,9 @@ dump_cold_bignum (struct dump_context *ctx, Lisp_Object object)
       mp_limb_t limb = mpz_getlimbn (*n, i);
       dump_write (ctx, &limb, sizeof (limb));
     }
+# ifdef HAVE_MPS
+  dump_igc_finish_obj (ctx);
+# endif
 }
 
 #ifdef HAVE_NATIVE_COMP
-- 
2.39.2

Re: MPS: Forwording symbols

[Eli Zaretskii]

> From: Helmut Eller <eller.helmut@gmail.com>
> Cc: Gerd Möllmann <gerd.moellmann@gmail.com>,
>   emacs-devel@gnu.org
> Date: Tue, 18 Jun 2024 18:20:26 +0200
> 
> On Tue, Jun 18 2024, Eli Zaretskii wrote:
> 
> > Any ideas are welcome.  I will gladly provide more information if
> > needed.
> 
> The 32-bit build has two bignums in the dump.  Can you try this patch?

Thanks.  Unfortunately, it doesn't change what I see.  Same infinite
sequence of segfaults in the same place in the code.

Re: MPS: Forwording symbols

[Helmut Eller]

> and still infloops(?), hitting SIGSEGV repeatedly here:
>
>   Thread 1 received signal SIGSEGV, Segmentation fault.
>   igc_on_pdump_loaded (dump_base=dump_base@entry=0xb000008,
>       hot_start=hot_start@entry=0xb000080, hot_end=0xb585408,
>       cold_start=0xb5b0008, cold_end=cold_end@entry=0xba8b6a8,
>       cold_user_data_start=0xb7038a8, heap_end=0xb707af8) at igc.c:3763
>   3763      eassert (((struct igc_header *)cold_start)->obj_type
>   (gdb) p cold_start
>   $1 = (void *) 0xb5b0008
>   (gdb) p ((struct igc_header *)cold_start)->obj_type
>   Cannot access memory at address 0xb5b0008
>
> Any ideas are welcome.  I will gladly provide more information if
> needed.

Can you access it after calling igc_postmortem?  Maybe barriers
work differently on Windows.

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Tue, Jun 18 2024, Eli Zaretskii wrote:
>
>> Any ideas are welcome.  I will gladly provide more information if
>> needed.
>
> The 32-bit build has two bignums in the dump.  Can you try this patch?

(Pushed)

Re: MPS: Forwording symbols

[Eli Zaretskii]

> From: Helmut Eller <eller.helmut@gmail.com>
> Cc: Gerd Möllmann <gerd.moellmann@gmail.com>,
>   emacs-devel@gnu.org
> Date: Tue, 18 Jun 2024 18:37:52 +0200
> 
> > and still infloops(?), hitting SIGSEGV repeatedly here:
> >
> >   Thread 1 received signal SIGSEGV, Segmentation fault.
> >   igc_on_pdump_loaded (dump_base=dump_base@entry=0xb000008,
> >       hot_start=hot_start@entry=0xb000080, hot_end=0xb585408,
> >       cold_start=0xb5b0008, cold_end=cold_end@entry=0xba8b6a8,
> >       cold_user_data_start=0xb7038a8, heap_end=0xb707af8) at igc.c:3763
> >   3763      eassert (((struct igc_header *)cold_start)->obj_type
> >   (gdb) p cold_start
> >   $1 = (void *) 0xb5b0008
> >   (gdb) p ((struct igc_header *)cold_start)->obj_type
> >   Cannot access memory at address 0xb5b0008
> >
> > Any ideas are welcome.  I will gladly provide more information if
> > needed.
> 
> Can you access it after calling igc_postmortem?  Maybe barriers
> work differently on Windows.

No idea if this helps, but here's what I get then:

  #0  igc_on_pdump_loaded (dump_base=dump_base@entry=0xb000008,
      hot_start=hot_start@entry=0xb000080, hot_end=0xb585408,
      cold_start=0xb5b0008, cold_end=cold_end@entry=0xba8b6c8,
      cold_user_data_start=0xb7038c0, heap_end=0xb707b10) at igc.c:3769
  3769      eassert (((struct igc_header *)cold_start)->obj_type
  (gdb) p ((struct igc_header *)cold_start)->obj_type
  Cannot access memory at address 0xb5b0008
  (gdb) call igc_postmortem()

  Thread 5 received signal SIGTRAP, Trace/breakpoint trap.
  [Switching to Thread 60368.0xb908]
  0x77c79031 in ntdll!DbgBreakPoint () from C:\WINDOWS\SysWOW64\ntdll.dll
  The program received a signal in another thread while
  making a function call from GDB.
  Evaluation of the expression containing the function
  (igc_postmortem) will be abandoned.
  When the function is done executing, GDB will silently stop.
  (gdb) c
  Continuing.
  [Thread 60368.0xb908 exited with code 0]

  Thread 1 received signal SIGTRAP, Trace/breakpoint trap.
  [Switching to Thread 60368.0xcaa8]
  0x774996c3 in KERNELBASE!DebugBreak () from C:\WINDOWS\SysWOW64\KernelBase.dll
  (gdb) thread 1
  [Switching to thread 1 (Thread 60368.0xcaa8)]
  #0  0x774996c3 in KERNELBASE!DebugBreak ()
     from C:\WINDOWS\SysWOW64\KernelBase.dll
  (gdb) bt
  #0  0x774996c3 in KERNELBASE!DebugBreak ()
     from C:\WINDOWS\SysWOW64\KernelBase.dll
  #1  0x0092477c in emacs_abort () at w32fns.c:11279
  #2  0x007d4c70 in terminate_due_to_signal (sig=sig@entry=22,
      backtrace_limit=backtrace_limit@entry=2147483647) at emacs.c:481
  #3  0x009032bf in igc_assert_fail (
      file=0xdfce76 <__mon_yday+45622> "protw3.c", line=36,
      msg=0xdf1c80 <__mon_yday+64> "unreachable code") at igc.c:82
  #4  0x009f9d53 in mps_lib_assert_fail (
      condition=0xdf1c80 <__mon_yday+64> "unreachable code", line=36,
      file=0xdfce76 <__mon_yday+45622> "protw3.c") at mpsliban.c:87
  #5  ProtSet (base=0xb590000, limit=0xb591000, mode=0) at protw3.c:36
  #6  ProtSet (base=0xb590000, limit=0xb591000, mode=0) at protw3.c:19
  #7  0x009f9f70 in arenaExpose (arena=0x9220000) at traceanc.c:588
  #8  ArenaPostmortem (globals=0x9220008) at traceanc.c:617
  #9  0x009fa035 in mps_arena_postmortem (arena=<optimized out>) at mpsi.c:292
  #10 0x0090530d in igc_postmortem () at igc.c:3612
  #11 <function called from gdb>
  #12 igc_on_pdump_loaded (dump_base=dump_base@entry=0xb000008,
      hot_start=hot_start@entry=0xb000080, hot_end=0xb585408,
      cold_start=0xb5b0008, cold_end=cold_end@entry=0xba8b6c8,
      cold_user_data_start=0xb7038c0, heap_end=0xb707b10) at igc.c:3769
  #13 0x008571b8 in pdumper_load (dump_filename=<optimized out>,
      argv0=<optimized out>,
      argv0@entry=0xacf0850 "d:\\gnu\\git\\emacs\\feature\\src\\emacs.exe")
      at pdumper.c:6051
  #14 0x00a19ae5 in load_pdump (dump_file=<optimized out>, argv=0x93325d0,
      argc=<optimized out>) at emacs.c:991
  #15 main (argc=<optimized out>, argv=<optimized out>) at emacs.c:1443
  (gdb)

IOW, the call to igc_postmortem itself hits assertion violation.

Re: MPS: Forwording symbols

[Helmut Eller]

On Tue, Jun 18 2024, Eli Zaretskii wrote:

> IOW, the call to igc_postmortem itself hits assertion violation.

Hm.  Could it be that allocating in a parked arena doesn't work on
Windows?  Does it look any different with this change?

diff --git a/src/igc.c b/src/igc.c
index b80d8e7251a..3695cec1ebf 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -3823,12 +3823,74 @@ igc_alloc_dump (size_t nbytes)
       mps_res_t res = mps_reserve (&block, ap, nbytes);
       if (res != MPS_RES_OK)
 	memory_full (0);
+      set_header (block, IGC_OBJ_INVALID, nbytes, 0);
     }
   while (!mps_commit (ap, block, nbytes));
-  set_header (block, IGC_OBJ_INVALID, nbytes, 0);
   return base_to_client (block);
 }

Re: MPS: Forwording symbols

[Eli Zaretskii]

> Date: Tue, 18 Jun 2024 20:33:45 +0300
> From: Eli Zaretskii <eliz@gnu.org>
> Cc: gerd.moellmann@gmail.com, emacs-devel@gnu.org
> 
> > Can you access it after calling igc_postmortem?  Maybe barriers
> > work differently on Windows.
> 
> No idea if this helps, but here's what I get then:
> 
>   #0  igc_on_pdump_loaded (dump_base=dump_base@entry=0xb000008,
>       hot_start=hot_start@entry=0xb000080, hot_end=0xb585408,
>       cold_start=0xb5b0008, cold_end=cold_end@entry=0xba8b6c8,
>       cold_user_data_start=0xb7038c0, heap_end=0xb707b10) at igc.c:3769
>   3769      eassert (((struct igc_header *)cold_start)->obj_type
>   (gdb) p ((struct igc_header *)cold_start)->obj_type
>   Cannot access memory at address 0xb5b0008
>   (gdb) call igc_postmortem()
> 
>   Thread 5 received signal SIGTRAP, Trace/breakpoint trap.
>   [Switching to Thread 60368.0xb908]
>   0x77c79031 in ntdll!DbgBreakPoint () from C:\WINDOWS\SysWOW64\ntdll.dll
>   The program received a signal in another thread while
>   making a function call from GDB.
>   Evaluation of the expression containing the function
>   (igc_postmortem) will be abandoned.
>   When the function is done executing, GDB will silently stop.
>   (gdb) c
>   Continuing.
>   [Thread 60368.0xb908 exited with code 0]
> 
>   Thread 1 received signal SIGTRAP, Trace/breakpoint trap.
>   [Switching to Thread 60368.0xcaa8]
>   0x774996c3 in KERNELBASE!DebugBreak () from C:\WINDOWS\SysWOW64\KernelBase.dll
>   (gdb) thread 1
>   [Switching to thread 1 (Thread 60368.0xcaa8)]
>   #0  0x774996c3 in KERNELBASE!DebugBreak ()
>      from C:\WINDOWS\SysWOW64\KernelBase.dll
>   (gdb) bt
>   #0  0x774996c3 in KERNELBASE!DebugBreak ()
>      from C:\WINDOWS\SysWOW64\KernelBase.dll
>   #1  0x0092477c in emacs_abort () at w32fns.c:11279
>   #2  0x007d4c70 in terminate_due_to_signal (sig=sig@entry=22,
>       backtrace_limit=backtrace_limit@entry=2147483647) at emacs.c:481
>   #3  0x009032bf in igc_assert_fail (
>       file=0xdfce76 <__mon_yday+45622> "protw3.c", line=36,
>       msg=0xdf1c80 <__mon_yday+64> "unreachable code") at igc.c:82
>   #4  0x009f9d53 in mps_lib_assert_fail (
>       condition=0xdf1c80 <__mon_yday+64> "unreachable code", line=36,
>       file=0xdfce76 <__mon_yday+45622> "protw3.c") at mpsliban.c:87
>   #5  ProtSet (base=0xb590000, limit=0xb591000, mode=0) at protw3.c:36
>   #6  ProtSet (base=0xb590000, limit=0xb591000, mode=0) at protw3.c:19
>   #7  0x009f9f70 in arenaExpose (arena=0x9220000) at traceanc.c:588
>   #8  ArenaPostmortem (globals=0x9220008) at traceanc.c:617
>   #9  0x009fa035 in mps_arena_postmortem (arena=<optimized out>) at mpsi.c:292
>   #10 0x0090530d in igc_postmortem () at igc.c:3612
>   #11 <function called from gdb>
>   #12 igc_on_pdump_loaded (dump_base=dump_base@entry=0xb000008,
>       hot_start=hot_start@entry=0xb000080, hot_end=0xb585408,
>       cold_start=0xb5b0008, cold_end=cold_end@entry=0xba8b6c8,
>       cold_user_data_start=0xb7038c0, heap_end=0xb707b10) at igc.c:3769
>   #13 0x008571b8 in pdumper_load (dump_filename=<optimized out>,
>       argv0=<optimized out>,
>       argv0@entry=0xacf0850 "d:\\gnu\\git\\emacs\\feature\\src\\emacs.exe")
>       at pdumper.c:6051
>   #14 0x00a19ae5 in load_pdump (dump_file=<optimized out>, argv=0x93325d0,
>       argc=<optimized out>) at emacs.c:991
>   #15 main (argc=<optimized out>, argv=<optimized out>) at emacs.c:1443
>   (gdb)
> 
> IOW, the call to igc_postmortem itself hits assertion violation.

Btw, the "unreachable" code in this case is this:

  void ProtSet(Addr base, Addr limit, AccessSet mode)
  {
    DWORD newProtect;
    DWORD oldProtect;

    AVER(base < limit);
    AVER(base != 0);
    AVERT(AccessSet, mode);

    newProtect = PAGE_EXECUTE_READWRITE;
    if((mode & AccessWRITE) != 0)
      newProtect = PAGE_EXECUTE_READ;
    if((mode & AccessREAD) != 0)
      newProtect = PAGE_NOACCESS;

    if(VirtualProtect((LPVOID)base, (SIZE_T)AddrOffset(base, limit),
		      newProtect, &oldProtect) == 0)
      NOTREACHED; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  }

It means that VirtualProtect failed.  Since 'mode' is zero, it means
the function was called to remove protection from the mmemory block,
and it failed, probably because the specified memory region was out of
the program's address space?

Re: MPS: Forwording symbols

[Gerd Möllmann]

Eli Zaretskii <eliz@gnu.org> writes:

>> Date: Tue, 18 Jun 2024 20:33:45 +0300
>> From: Eli Zaretskii <eliz@gnu.org>
>> Cc: gerd.moellmann@gmail.com, emacs-devel@gnu.org
>> 
>> > Can you access it after calling igc_postmortem?  Maybe barriers
>> > work differently on Windows.
>> 
>> No idea if this helps, but here's what I get then:
>> 
>>   #0  igc_on_pdump_loaded (dump_base=dump_base@entry=0xb000008,
>>       hot_start=hot_start@entry=0xb000080, hot_end=0xb585408,
>>       cold_start=0xb5b0008, cold_end=cold_end@entry=0xba8b6c8,
>>       cold_user_data_start=0xb7038c0, heap_end=0xb707b10) at igc.c:3769
>>   3769      eassert (((struct igc_header *)cold_start)->obj_type
>>   (gdb) p ((struct igc_header *)cold_start)->obj_type
>>   Cannot access memory at address 0xb5b0008
>>   (gdb) call igc_postmortem()
>> 
>>   Thread 5 received signal SIGTRAP, Trace/breakpoint trap.
>>   [Switching to Thread 60368.0xb908]
>>   0x77c79031 in ntdll!DbgBreakPoint () from C:\WINDOWS\SysWOW64\ntdll.dll
>>   The program received a signal in another thread while
>>   making a function call from GDB.
>>   Evaluation of the expression containing the function
>>   (igc_postmortem) will be abandoned.
>>   When the function is done executing, GDB will silently stop.
>>   (gdb) c
>>   Continuing.
>>   [Thread 60368.0xb908 exited with code 0]
>> 
>>   Thread 1 received signal SIGTRAP, Trace/breakpoint trap.
>>   [Switching to Thread 60368.0xcaa8]
>>   0x774996c3 in KERNELBASE!DebugBreak () from C:\WINDOWS\SysWOW64\KernelBase.dll
>>   (gdb) thread 1
>>   [Switching to thread 1 (Thread 60368.0xcaa8)]
>>   #0  0x774996c3 in KERNELBASE!DebugBreak ()
>>      from C:\WINDOWS\SysWOW64\KernelBase.dll
>>   (gdb) bt
>>   #0  0x774996c3 in KERNELBASE!DebugBreak ()
>>      from C:\WINDOWS\SysWOW64\KernelBase.dll
>>   #1  0x0092477c in emacs_abort () at w32fns.c:11279
>>   #2  0x007d4c70 in terminate_due_to_signal (sig=sig@entry=22,
>>       backtrace_limit=backtrace_limit@entry=2147483647) at emacs.c:481
>>   #3  0x009032bf in igc_assert_fail (
>>       file=0xdfce76 <__mon_yday+45622> "protw3.c", line=36,
>>       msg=0xdf1c80 <__mon_yday+64> "unreachable code") at igc.c:82
>>   #4  0x009f9d53 in mps_lib_assert_fail (
>>       condition=0xdf1c80 <__mon_yday+64> "unreachable code", line=36,
>>       file=0xdfce76 <__mon_yday+45622> "protw3.c") at mpsliban.c:87
>>   #5  ProtSet (base=0xb590000, limit=0xb591000, mode=0) at protw3.c:36
>>   #6  ProtSet (base=0xb590000, limit=0xb591000, mode=0) at protw3.c:19
>>   #7  0x009f9f70 in arenaExpose (arena=0x9220000) at traceanc.c:588
>>   #8  ArenaPostmortem (globals=0x9220008) at traceanc.c:617
>>   #9  0x009fa035 in mps_arena_postmortem (arena=<optimized out>) at mpsi.c:292
>>   #10 0x0090530d in igc_postmortem () at igc.c:3612
>>   #11 <function called from gdb>
>>   #12 igc_on_pdump_loaded (dump_base=dump_base@entry=0xb000008,
>>       hot_start=hot_start@entry=0xb000080, hot_end=0xb585408,
>>       cold_start=0xb5b0008, cold_end=cold_end@entry=0xba8b6c8,
>>       cold_user_data_start=0xb7038c0, heap_end=0xb707b10) at igc.c:3769
>>   #13 0x008571b8 in pdumper_load (dump_filename=<optimized out>,
>>       argv0=<optimized out>,
>>       argv0@entry=0xacf0850 "d:\\gnu\\git\\emacs\\feature\\src\\emacs.exe")
>>       at pdumper.c:6051
>>   #14 0x00a19ae5 in load_pdump (dump_file=<optimized out>, argv=0x93325d0,
>>       argc=<optimized out>) at emacs.c:991
>>   #15 main (argc=<optimized out>, argv=<optimized out>) at emacs.c:1443
>>   (gdb)
>> 
>> IOW, the call to igc_postmortem itself hits assertion violation.
>
> Btw, the "unreachable" code in this case is this:
>
>   void ProtSet(Addr base, Addr limit, AccessSet mode)
>   {
>     DWORD newProtect;
>     DWORD oldProtect;
>
>     AVER(base < limit);
>     AVER(base != 0);
>     AVERT(AccessSet, mode);
>
>     newProtect = PAGE_EXECUTE_READWRITE;
>     if((mode & AccessWRITE) != 0)
>       newProtect = PAGE_EXECUTE_READ;
>     if((mode & AccessREAD) != 0)
>       newProtect = PAGE_NOACCESS;
>
>     if(VirtualProtect((LPVOID)base, (SIZE_T)AddrOffset(base, limit),
> 		      newProtect, &oldProtect) == 0)
>       NOTREACHED; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
>   }
>
> It means that VirtualProtect failed.  Since 'mode' is zero, it means
> the function was called to remove protection from the mmemory block,
> and it failed, probably because the specified memory region was out of
> the program's address space?

FWIW, I don't think one can usefully continue execution after calling
igc_postmorten, one can only look around in memory and such. Here's what
the docs say:

  In the postmortem state, incremental collection does not take place,
  objects do not move in memory, references do not change, the staleness
  of location dependencies does not change, and memory occupied by
  unreachable objects is not recycled. Additionally, all memory protection
  is removed, and memory may be in an inconsistent state.

  Warning

  In this state, memory managed by the arena is not in a consistent state,
  and so it is not safe to continue running the client program. This state
  is intended for postmortem debugging only.

Re: MPS: Forwording symbols

[Helmut Eller]

On Tue, Jun 18 2024, Eli Zaretskii wrote:

> It means that VirtualProtect failed.  Since 'mode' is zero, it means
> the function was called to remove protection from the mmemory block,
> and it failed, probably because the specified memory region was out of
> the program's address space?

Could this be our old friend dump_discard_mem that is too lazy to check
error codes?  What happens if you remove the call to
dump_mmap_discard_contents in pdumper_load?

Re: MPS: Forwording symbols

[Eli Zaretskii]

> From: Helmut Eller <eller.helmut@gmail.com>
> Cc: gerd.moellmann@gmail.com,  emacs-devel@gnu.org
> Date: Tue, 18 Jun 2024 19:51:42 +0200
> 
> On Tue, Jun 18 2024, Eli Zaretskii wrote:
> 
> > IOW, the call to igc_postmortem itself hits assertion violation.
> 
> Hm.  Could it be that allocating in a parked arena doesn't work on
> Windows?  Does it look any different with this change?

No change.

Re: MPS: Forwording symbols

[Eli Zaretskii]

> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: eller.helmut@gmail.com,  emacs-devel@gnu.org
> Date: Tue, 18 Jun 2024 20:11:16 +0200
> 
> Eli Zaretskii <eliz@gnu.org> writes:
> 
> >> IOW, the call to igc_postmortem itself hits assertion violation.
> >
> > Btw, the "unreachable" code in this case is this:
> >
> >   void ProtSet(Addr base, Addr limit, AccessSet mode)
> >   {
> >     DWORD newProtect;
> >     DWORD oldProtect;
> >
> >     AVER(base < limit);
> >     AVER(base != 0);
> >     AVERT(AccessSet, mode);
> >
> >     newProtect = PAGE_EXECUTE_READWRITE;
> >     if((mode & AccessWRITE) != 0)
> >       newProtect = PAGE_EXECUTE_READ;
> >     if((mode & AccessREAD) != 0)
> >       newProtect = PAGE_NOACCESS;
> >
> >     if(VirtualProtect((LPVOID)base, (SIZE_T)AddrOffset(base, limit),
> > 		      newProtect, &oldProtect) == 0)
> >       NOTREACHED; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
> >   }
> >
> > It means that VirtualProtect failed.  Since 'mode' is zero, it means
> > the function was called to remove protection from the mmemory block,
> > and it failed, probably because the specified memory region was out of
> > the program's address space?
> 
> FWIW, I don't think one can usefully continue execution after calling
> igc_postmorten, one can only look around in memory and such. Here's what
> the docs say:

Maybe I'm misunderstanding something, but the above is not an attempt
to continue execution, it is part of the call to igc_postmortem
itself.  That call is the one which crashes, not the code that runs
after that call returns.

Re: MPS: Forwording symbols

[Eli Zaretskii]

> From: Helmut Eller <eller.helmut@gmail.com>
> Cc: gerd.moellmann@gmail.com,  emacs-devel@gnu.org
> Date: Tue, 18 Jun 2024 20:12:12 +0200
> 
> On Tue, Jun 18 2024, Eli Zaretskii wrote:
> 
> > It means that VirtualProtect failed.  Since 'mode' is zero, it means
> > the function was called to remove protection from the mmemory block,
> > and it failed, probably because the specified memory region was out of
> > the program's address space?
> 
> Could this be our old friend dump_discard_mem that is too lazy to check
> error codes?  What happens if you remove the call to
> dump_mmap_discard_contents in pdumper_load?

Then the build succeeds.

Re: MPS: Forwording symbols

[Gerd Möllmann]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
>> Cc: eller.helmut@gmail.com,  emacs-devel@gnu.org
>> Date: Tue, 18 Jun 2024 20:11:16 +0200
>> 
>> Eli Zaretskii <eliz@gnu.org> writes:
>> 
>> >> IOW, the call to igc_postmortem itself hits assertion violation.
>> >
>> > Btw, the "unreachable" code in this case is this:
>> >
>> >   void ProtSet(Addr base, Addr limit, AccessSet mode)
>> >   {
>> >     DWORD newProtect;
>> >     DWORD oldProtect;
>> >
>> >     AVER(base < limit);
>> >     AVER(base != 0);
>> >     AVERT(AccessSet, mode);
>> >
>> >     newProtect = PAGE_EXECUTE_READWRITE;
>> >     if((mode & AccessWRITE) != 0)
>> >       newProtect = PAGE_EXECUTE_READ;
>> >     if((mode & AccessREAD) != 0)
>> >       newProtect = PAGE_NOACCESS;
>> >
>> >     if(VirtualProtect((LPVOID)base, (SIZE_T)AddrOffset(base, limit),
>> > 		      newProtect, &oldProtect) == 0)
>> >       NOTREACHED; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
>> >   }
>> >
>> > It means that VirtualProtect failed.  Since 'mode' is zero, it means
>> > the function was called to remove protection from the mmemory block,
>> > and it failed, probably because the specified memory region was out of
>> > the program's address space?
>> 
>> FWIW, I don't think one can usefully continue execution after calling
>> igc_postmorten, one can only look around in memory and such. Here's what
>> the docs say:
>
> Maybe I'm misunderstanding something, but the above is not an attempt
> to continue execution, it is part of the call to igc_postmortem
> itself.  That call is the one which crashes, not the code that runs
> after that call returns.

Sorry, then I interpreted this wrong:

>   (gdb) call igc_postmortem()
> 
>   Thread 5 received signal SIGTRAP, Trace/breakpoint trap.
>   [Switching to Thread 60368.0xb908]
>   0x77c79031 in ntdll!DbgBreakPoint () from C:\WINDOWS\SysWOW64\ntdll.dll
>   The program received a signal in another thread while
>   making a function call from GDB.
>   Evaluation of the expression containing the function
>   (igc_postmortem) will be abandoned.
>   When the function is done executing, GDB will silently stop.
>   (gdb) c
>   Continuing.

Too long no GDB for me :-)

Re: MPS: Forwording symbols

[Helmut Eller]

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

On Tue, Jun 18 2024, Eli Zaretskii wrote:

>> Could this be our old friend dump_discard_mem that is too lazy to check
>> error codes?  What happens if you remove the call to
>> dump_mmap_discard_contents in pdumper_load?
>
> Then the build succeeds.

With the patch below, dump_mmap_discard_contents calls the map->release
callback.  I think that was the original reason for having this
callback.  It also adds stricter error checking to dump_discard_mem, but
that function is now unused.  It's not clear to me, when it should be
used instead of dump_unmap_file.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-More-strict-error-checking-in-pdump_mmap_discard.patch --]
[-- Type: text/x-diff, Size: 2317 bytes --]

From 018e0b1f6b0f3c2e53d7a99b3f29e968470e3ef1 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Tue, 18 Jun 2024 21:15:32 +0200
Subject: [PATCH] More strict error checking in pdump_mmap_discard

* src/dumper.c (dump_discard_mem): Abort on error.
(dump_mmap_discard_contents): Call dump_mmap_release instead
of dump_discard_mem, which invokes the map specific callback.
---
 src/pdumper.c | 29 ++++++++++++++++++-----------
 1 file changed, 18 insertions(+), 11 deletions(-)

diff --git a/src/pdumper.c b/src/pdumper.c
index 9147be38294..9800652da5f 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -4951,24 +4951,22 @@ dump_discard_mem (void *mem, size_t size)
       DWORD old_prot;
       (void) VirtualProtect (mem, size, PAGE_NOACCESS, &old_prot);
 #elif VM_SUPPORTED == VM_POSIX
+      int err = 0;
 # ifdef HAVE_POSIX_MADVISE
       /* Discard COWed pages.  */
-      (void) posix_madvise (mem, size, POSIX_MADV_DONTNEED);
+      err = posix_madvise (mem, size, POSIX_MADV_DONTNEED);
 # elif defined HAVE_MADVISE
-      (void) madvise (mem, size, MADV_DONTNEED);
+      err = madvise (mem, size, MADV_DONTNEED);
 #endif
+      if (err)
+	emacs_abort ();
       /* Release the commit charge for the mapping.  */
-      (void) mprotect (mem, size, PROT_NONE);
+      err = mprotect (mem, size, PROT_NONE);
+      if (err)
+	emacs_abort ();
 #endif
 }
 
-static void
-dump_mmap_discard_contents (struct dump_memory_map *map)
-{
-  if (map->mapping)
-    dump_discard_mem (map->mapping, map->spec.size);
-}
-
 static void
 dump_mmap_reset (struct dump_memory_map *map)
 {
@@ -4985,6 +4983,13 @@ dump_mmap_release (struct dump_memory_map *map)
   dump_mmap_reset (map);
 }
 
+static void
+dump_mmap_discard_contents (struct dump_memory_map *map)
+{
+  if (map->mapping)
+    dump_mmap_release (map);
+}
+
 /* Allows heap-allocated dump_mmap to "free" maps individually.  */
 struct dump_memory_map_heap_control_block
 {
@@ -5072,7 +5077,9 @@ dump_mmap_contiguous_heap (struct dump_memory_map *maps, int nr_maps,
 static void
 dump_mmap_release_mps (struct dump_memory_map *map)
 {
-  emacs_abort ();
+  /* FIXME: igc_on_pdump_loaded "knows" that DS_DISCARDABLE is unused.
+     Maybe come up with a nicer API.
+   */
 }
 
 /* Implement dump_mmap using mps_reserve and read.  */
-- 
2.39.2

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Tue, Jun 18 2024, Eli Zaretskii wrote:
>
>>> Could this be our old friend dump_discard_mem that is too lazy to check
>>> error codes?  What happens if you remove the call to
>>> dump_mmap_discard_contents in pdumper_load?
>>
>> Then the build succeeds.
>
> With the patch below, dump_mmap_discard_contents calls the map->release
> callback.  I think that was the original reason for having this
> callback.  It also adds stricter error checking to dump_discard_mem, but
> that function is now unused.  It's not clear to me, when it should be
> used instead of dump_unmap_file.

Pushed.

Re: MPS: Forwording symbols

[Helmut Eller]

On Tue, Jun 18 2024, Gerd Möllmann wrote:

> I meant the mirroring code. I find it still funny that I completely
> overlooked the idea of simply loading the dump into an area allocated
> from MPS :-). Instead: here's a object graph, or graph(s), - and wee
> let's copy them :-). Really strange :-).

All the examples in the documentation for mps_reserve, allocate a single
object.  That was probably the reason why I didn't even consider the
possibility that it can also be used to allocate many objects or an
array of objects.  I only noticed that MPS makes a distinction between
blocks and objects, when I was re-reading the documentation to see if
what MPS calls object formats is the same as what I called layout in the
codegen.

BTW, MPS also has a pool for stacks.  Maybe prstack etc. could use that.

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Tue, Jun 18 2024, Gerd Möllmann wrote:
>
>> I meant the mirroring code. I find it still funny that I completely
>> overlooked the idea of simply loading the dump into an area allocated
>> from MPS :-). Instead: here's a object graph, or graph(s), - and wee
>> let's copy them :-). Really strange :-).
>
> All the examples in the documentation for mps_reserve, allocate a single
> object.  That was probably the reason why I didn't even consider the
> possibility that it can also be used to allocate many objects or an
> array of objects.  I only noticed that MPS makes a distinction between
> blocks and objects, when I was re-reading the documentation to see if
> what MPS calls object formats is the same as what I called layout in the
> codegen.

Yes, good catch :-). 

> BTW, MPS also has a pool for stacks.  Maybe prstack etc. could use that.

Yeah.

I would also find using allocation frames interesting. Alas the
best usage example of dumping which allocates lots of objects that are
dead after dumping doesn't happen very often :-).

Re: MPS: Forwording symbols

[Eli Zaretskii]

> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: Eli Zaretskii <eliz@gnu.org>,  emacs-devel@gnu.org
> Date: Tue, 18 Jun 2024 21:33:02 +0200
> 
> Helmut Eller <eller.helmut@gmail.com> writes:
> 
> > On Tue, Jun 18 2024, Eli Zaretskii wrote:
> >
> >>> Could this be our old friend dump_discard_mem that is too lazy to check
> >>> error codes?  What happens if you remove the call to
> >>> dump_mmap_discard_contents in pdumper_load?
> >>
> >> Then the build succeeds.
> >
> > With the patch below, dump_mmap_discard_contents calls the map->release
> > callback.  I think that was the original reason for having this
> > callback.  It also adds stricter error checking to dump_discard_mem, but
> > that function is now unused.  It's not clear to me, when it should be
> > used instead of dump_unmap_file.
> 
> Pushed.

Thanks, I've cleaned up the MS-Windows bits.

Re: MPS: Forwording symbols

[Helmut Eller]

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

I added labels to some roots so that the telemetry data is easier to
interpret.  When recording telemetry with

  MPS_TELEMETRY_CONTROL="all" MPS_TELEMETRY_FILENAME=/tmp/mpsio.log
  ../src/emacs -Q --batch -l lisp/emacs-lisp/ert-tests.el --eval
  '(ert-run-tests-batch-and-exit
  "ert-test-\\(parse\\|plist\\|record\\|run-tests-batch-exp\\)")'

and displaying it with this SQL statement:

  select root,label,avg(delta),min(delta),max(delta),count(*) as count from (select root, (select I.string from  EVENT_Intern AS I,  EVENT_Label AS L where I.stringId = L.stringId and R.root=L.address) as label,time, time - lag(time) over (order by time) as delta from (select root,time from EVENT_RootScan union select 'flip',time from EVENT_TraceFlipBegin) R) group by root order by avg(delta) ;

I get this:

label           avg(delta)        min(delta)  max(delta)  count
--------------  ----------------  ----------  ----------  -----
"exact-ptr      675.666666666667  462         914         3    
"rdstack        987.0             903         1113        3    
"xpalloc-exact  1130.33333333333  1029        1186        3    
"dump-pins      1680.0            1554        1890        3    
"xzalloc-ambig  2723.0            2667        2761        3    
"main-thread    3940.66666666667  2656        4798        3    
"pure           15088.6666666667  12800       17010       3    
"exact          16992.6666666667  16527       17346       3    
"terminal-list  28983.6666666667  3076        78950       3    
"specpdl        41100.3333333333  11046       76744       3    
"buffer         44033.3333333333  21934       87843       3    
"bc-stack       139762.0          124866      155557      3    
"create-thread  158259.333333333  150224      172525      3    
"charset-table  179802.0          85963       320555      3    
"buffer         468265.0          219009      628425      3    
"staticvec      539668.333333333  69006       798409      3    
"kdb-buffer     612549.0          373380      925365      3    
"lispsym        1778728.33333333  230528      2853050     3    

The numbers are the duration for scanning the root, in cycles; multiply
with 400 picoseconds (or whatever you think is appropriate for one
cycle) to get the time.  E.g.  for lispsym, the maximum was 2853050 *
400e-12 =~ 1.1 millisecond.

That's down from 10 milliseconds it used to take to scan the dump.

I expected that staticvec to be at the top, but I guess lispsym actually
makes sense.  It's strange though, that the maximum and minimum for
lispsym vary so much.

I general, ert-tests.el is quite strange.  To run all tests in there
with:

  make lisp/emacs-lisp/ert-tests

requires almost 4GB peak, but when running
ert-test-run-tests-batch-expensive alone, it requires much less than
that.

Here are the patches for this:


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

From b4e3eb5f8a72657cbe39dab8709fd4bf90d77129 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Wed, 19 Jun 2024 10:20:26 +0200
Subject: [PATCH 1/6] Introduce RELOC_BUFFER

Use the dump_relocs mechanism instead of relying on Vbuffer_alist to
find all existing buffers.

* src/pdumper.c (dump_buffer, dump_do_dump_relocation): Create a
RELOC_BUFFER.
* src/igc.c (igc_on_pdump_loaded): Remove the buffer related code.
---
 src/igc.c     |  9 ---------
 src/pdumper.c | 20 ++++++++++++++++++++
 2 files changed, 20 insertions(+), 9 deletions(-)

diff --git a/src/igc.c b/src/igc.c
index 4c688aa5ddb..9b909310e92 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -3952,15 +3952,6 @@ igc_on_pdump_loaded (void *dump_base, void *hot_start, void *hot_end,
   igc_root_create_ambig (pinned_objects_in_dump,
 			 (uint8_t *)pinned_objects_in_dump
 			     + sizeof pinned_objects_in_dump);
-
-  /* Copy to buffer text to out of pdump */
-  for (Lisp_Object l = Vbuffer_alist; !NILP (l); l = XCDR (l))
-    {
-      struct buffer *buf = XBUFFER (XCDR (XCAR (l)));
-      eassert (pdumper_object_p (buf->text->beg));
-      enlarge_buffer_text (buf, 0);
-      eassert (!pdumper_object_p (buf->text->beg));
-    }
 }
 
 void *
diff --git a/src/pdumper.c b/src/pdumper.c
index e0ff395fd94..27717eea9c8 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -181,6 +181,9 @@ #define dump_offsetof(type, member)                             \
     RELOC_NATIVE_COMP_UNIT,
     RELOC_NATIVE_SUBR,
     RELOC_BIGNUM,
+#ifdef HAVE_MPS
+    RELOC_BUFFER,
+#endif
     /* dump_lv = make_lisp_ptr (dump_lv + dump_base,
 				type - RELOC_DUMP_TO_DUMP_LV)
        (Special case for symbols: make_lisp_symbol)
@@ -2870,6 +2873,11 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
 	  dump_remember_cold_op (ctx, COLD_OP_BUFFER,
 				 make_lisp_ptr ((void *) in_buffer,
 						Lisp_Vectorlike));
+#ifdef HAVE_MPS
+	  dump_push (&ctx->dump_relocs[LATE_RELOCS],
+		     list2 (make_fixnum (RELOC_BUFFER),
+			    dump_off_to_lisp (ctx->obj_offset)));
+#endif
         }
       else
         eassert (buffer->own_text.beg == NULL);
@@ -5759,6 +5767,18 @@ dump_do_dump_relocation (const uintptr_t dump_base,
         mpz_roinit_n (bignum->value, limbs, reload_info.nlimbs);
         break;
       }
+#ifdef HAVE_MPS
+    case RELOC_BUFFER:
+      {
+	/* When resurrecting, copy the text out of the dump so that we
+	   can collect the dumped text. */
+        struct buffer *b = dump_ptr (dump_base, reloc_offset);
+	eassert (pdumper_object_p (b->text->beg));
+	enlarge_buffer_text (b, 0);
+	eassert (!pdumper_object_p (b->text->beg));
+      }
+      break;
+#endif
     default: /* Lisp_Object in the dump; precise type in reloc.type */
       {
         Lisp_Object lv = dump_make_lv_from_reloc (dump_base, reloc);
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Shrink-dump_public-after-the-dump-is-initialized.patch --]
[-- Type: text/x-diff, Size: 938 bytes --]

From 492d9698b411045c757b1e1d5cac59a0e3262957 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Wed, 19 Jun 2024 10:29:46 +0200
Subject: [PATCH 2/6] Shrink dump_public after the dump is initialized

* src/pdumper.c (pdumper_load): Set dump_public to the pinned region
from cold_user_data_start to heap_end.  This should reduce the
probability that pdumper_object_p is misused.
---
 src/pdumper.c | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/src/pdumper.c b/src/pdumper.c
index 27717eea9c8..27b84707fcc 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -6086,6 +6086,11 @@ pdumper_load (const char *dump_filename, char *argv0)
   for (int i = 0; i < nr_dump_late_hooks; ++i)
     dump_late_hooks[i] ();
 
+#ifdef HAVE_MPS
+  dump_public.start = (uintptr_t)cold_user_data_start;
+  dump_public.end = (uintptr_t)heap_end;
+#endif
+
   initialized = true;
 
   struct timespec load_timespec =
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Minor-changes.patch --]
[-- Type: text/x-diff, Size: 2119 bytes --]

From d7c51a03896a01bcac9d846139f8529d3ac6fdc2 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Wed, 19 Jun 2024 10:53:50 +0200
Subject: [PATCH 3/6] Minor changes

* src/igc.c (igc_alloc_dump): Let nbytes be the size without header.
(dump_mmap_contiguous_mps): Update accordingly.
(dump_field_fwd): Use &in_field->fwdptr instead of in_field.
---
 src/igc.c     | 7 ++++---
 src/pdumper.c | 4 ++--
 2 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/src/igc.c b/src/igc.c
index 9b909310e92..9eb55e06000 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -3959,15 +3959,16 @@ igc_alloc_dump (size_t nbytes)
 {
   igc_assert (global_igc->park_count > 0);
   mps_ap_t ap = thread_ap (IGC_OBJ_CONS);
+  size_t block_size = igc_header_size () + nbytes;
   mps_addr_t block;
   do
     {
-      mps_res_t res = mps_reserve (&block, ap, nbytes);
+      mps_res_t res = mps_reserve (&block, ap, block_size);
       if (res != MPS_RES_OK)
 	memory_full (0);
+      set_header (block, IGC_OBJ_INVALID, block_size, 0);
     }
-  while (!mps_commit (ap, block, nbytes));
-  set_header (block, IGC_OBJ_INVALID, nbytes, 0);
+  while (!mps_commit (ap, block, block_size));
   return base_to_client (block);
 }
 
diff --git a/src/pdumper.c b/src/pdumper.c
index 27b84707fcc..6f0ca3233bb 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2362,7 +2362,7 @@ dump_float (struct dump_context *ctx, const struct Lisp_Float *lfloat)
 dump_field_fwd (struct dump_context *ctx, void *out, const void *in_start,
 		const lispfwd *in_field)
 {
-  dump_field_emacs_ptr (ctx, out, in_start, in_field);
+  dump_field_emacs_ptr (ctx, out, in_start, &in_field->fwdptr);
   switch (XFWDTYPE (*in_field))
     {
     case Lisp_Fwd_Int:
@@ -5101,7 +5101,7 @@ dump_mmap_release_mps (struct dump_memory_map *map)
 dump_mmap_contiguous_mps (struct dump_memory_map *maps, int nr_maps,
 			  size_t total_size)
 {
-  uint8_t *p = igc_alloc_dump (igc_header_size () + total_size);
+  uint8_t *p = igc_alloc_dump (total_size);
   for (size_t i = 0; i < nr_maps; ++i)
     {
       struct dump_memory_map *map = &maps[i];
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-When-resurrecting-buffers-copy-markers-to-a-weak-vec.patch --]
[-- Type: text/x-diff, Size: 2479 bytes --]

From a1bbbc0c1328e1adda65ee7e5f074796069a2b1e Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Thu, 20 Jun 2024 08:47:56 +0200
Subject: [PATCH 4/6] When resurrecting buffers, copy markers to a weak vector

* src/igc.h (igc_resurrect_markers): New.
* src/igc.c (igc_resurrect_markers): Implementation.
(weak_vector_p): New helper.
* src/pdumper.c (dump_do_dump_relocation): Use igc_resurrect_markers.
---
 src/igc.c     | 29 +++++++++++++++++++++++++++++
 src/igc.h     |  1 +
 src/pdumper.c |  1 +
 3 files changed, 31 insertions(+)

diff --git a/src/igc.c b/src/igc.c
index 9eb55e06000..a464aee07c2 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -3522,6 +3522,35 @@ igc_remove_all_markers (struct buffer *b)
     }
 }
 
+static bool
+weak_vector_p (Lisp_Object x)
+{
+  if (VECTORP (x))
+    {
+      struct igc *igc = global_igc;
+      mps_pool_t pool = NULL;
+      mps_addr_pool (&pool, igc->arena, XVECTOR (x));
+      return pool == igc->weak_pool;
+    }
+  else
+    return false;
+}
+
+void
+igc_resurrect_markers (struct buffer *b)
+{
+  Lisp_Object old = BUF_MARKERS (b);
+  if (NILP (old))
+    return;
+  igc_assert (!weak_vector_p (old));
+  size_t len = ASIZE (old);
+  Lisp_Object new = alloc_vector_weak (len, Qnil);
+  memcpy (XVECTOR (new)->contents, XVECTOR (old)->contents,
+	  len * sizeof (Lisp_Object));
+  BUF_MARKERS (b) = new;
+  igc_assert (weak_vector_p (BUF_MARKERS (b)));
+}
+
 DEFUN ("igc-make-weak-vector", Figc_make_weak_vector, Sigc_make_weak_vector, 2, 2, 0,
        doc: /* Return a new weak vector of length LENGTH, with each element being INIT.
 See also the function `vector'.  */)
diff --git a/src/igc.h b/src/igc.h
index 55ef7d4d56c..cd782fca0ca 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -79,6 +79,7 @@ #define EMACS_IGC_H
 void igc_add_marker (struct buffer *b, struct Lisp_Marker *m);
 void igc_remove_marker (struct buffer *b, struct Lisp_Marker *m);
 void igc_remove_all_markers (struct buffer *b);
+void igc_resurrect_markers (struct buffer *b);
 Lisp_Object igc_alloc_symbol (void);
 void *igc_alloc_global_ref (void);
 
diff --git a/src/pdumper.c b/src/pdumper.c
index 6f0ca3233bb..e69a2b56f0b 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -5776,6 +5776,7 @@ dump_do_dump_relocation (const uintptr_t dump_base,
 	eassert (pdumper_object_p (b->text->beg));
 	enlarge_buffer_text (b, 0);
 	eassert (!pdumper_object_p (b->text->beg));
+	igc_resurrect_markers (b);
       }
       break;
 #endif
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0005-When-creating-roots-allow-to-record-a-debug-name.patch --]
[-- Type: text/x-diff, Size: 10900 bytes --]

From be160fc73f081824cea5f6ffd51d8702e0e93a72 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Thu, 20 Jun 2024 14:04:59 +0200
Subject: [PATCH 5/6] When creating roots, allow to record a debug-name

* src/igc.c (register_root): Create a telemetry label for the
debug_name.
(root_create, root_create_ambig, root_create_exact)
(igc_root_create_ambig): New debug_name argument.
(root_create_staticvec, root_create_lispsym, root_create_buffer)
(root_create_terminal_list, root_create_main_thread)
(igc_root_create_exact, igc_root_create_exact_ptr, root_create_specpdl)
(root_create_bc, root_create_charset_table, root_create_pure)
(root_create_thread, igc_grow_rdstack, root_create_exact_n)
(igc_xalloc_lisp_objs_exact, igc_xzalloc_ambig, igc_realloc_ambig)
(igc_xpalloc_ambig, igc_xpalloc_exact, igc_xnrealloc_ambig)
(igc_on_pdump_loaded): Set debug_name.
* src/igc.c (igc_root_create_ambig): New debug_name argument.
* src/keyboard.c (init_keyboard): Set debug_name.
---
 src/igc.c      | 82 ++++++++++++++++++++++++++++++--------------------
 src/igc.h      |  2 +-
 src/keyboard.c |  3 +-
 3 files changed, 53 insertions(+), 34 deletions(-)

diff --git a/src/igc.c b/src/igc.c
index a464aee07c2..627f88acf4d 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -581,10 +581,16 @@ arena_release (struct igc *gc)
 
 static struct igc_root_list *
 register_root (struct igc *gc, mps_root_t root, void *start, void *end,
-	       bool ambig)
+	       bool ambig, const char *debug_name)
 {
-  struct igc_root r
-    = { .gc = gc, .root = root, .start = start, .end = end, .ambig = ambig };
+  if (debug_name && (mps_telemetry_get () & (1 << 6)))
+    {
+      mps_label_t label = mps_telemetry_intern (debug_name);
+      mps_telemetry_label (root, label);
+    }
+  struct igc_root r = {
+    .gc = gc, .root = root, .start = start, .end = end, .ambig = ambig
+  };
   return igc_root_list_push (&gc->roots, &r);
 }
 
@@ -2101,48 +2107,52 @@ scan_cell_callback (struct igc_opaque *op, Lisp_Object *addr)
 
 static igc_root_list *
 root_create (struct igc *gc, void *start, void *end, mps_rank_t rank,
-	     mps_area_scan_t scan, void *closure, bool ambig)
+	     mps_area_scan_t scan, void *closure, bool ambig,
+	     const char *debug_name)
 {
   mps_root_t root;
   mps_res_t res
     = mps_root_create_area (&root, gc->arena, rank, 0, start, end, scan,
 			    closure);
   IGC_CHECK_RES (res);
-  return register_root (gc, root, start, end, ambig);
+  return register_root (gc, root, start, end, ambig, debug_name);
 }
 
 static igc_root_list *
-root_create_ambig (struct igc *gc, void *start, void *end)
+root_create_ambig (struct igc *gc, void *start, void *end,
+		   const char *debug_name)
 {
   return root_create (gc, start, end, mps_rank_ambig (), scan_ambig, NULL,
-		      true);
+		      true, debug_name ? debug_name : "ambig");
 }
 
 static igc_root_list *
 root_create_exact (struct igc *gc, void *start, void *end,
-		   mps_area_scan_t scan)
+		   mps_area_scan_t scan, const char *debug_name)
 {
-  return root_create (gc, start, end, mps_rank_exact (), scan, NULL, false);
+  return root_create (gc, start, end, mps_rank_exact (), scan, NULL, false,
+		      debug_name);
 }
 
 static void
 root_create_staticvec (struct igc *gc)
 {
   root_create_exact (gc, staticvec, staticvec + ARRAYELTS (staticvec),
-		     scan_staticvec);
+		     scan_staticvec, "staticvec");
 }
 
 static void
 root_create_lispsym (struct igc *gc)
 {
-  root_create_exact (gc, lispsym, lispsym + ARRAYELTS (lispsym), scan_lispsym);
+  root_create_exact (gc, lispsym, lispsym + ARRAYELTS (lispsym),
+		     scan_lispsym, "lispsym");
 }
 
 static void
 root_create_buffer (struct igc *gc, struct buffer *b)
 {
   void *start = &b->name_, *end = &b->own_text;
-  root_create_ambig (gc, start, end);
+  root_create_ambig (gc, start, end, "buffer");
 }
 
 static void
@@ -2150,7 +2160,7 @@ root_create_terminal_list (struct igc *gc)
 {
   void *start = &terminal_list;
   void *end = (char *) start + sizeof (terminal_list);
-  root_create_ambig (gc, start, end);
+  root_create_ambig (gc, start, end, "terminal-list");
 }
 
 static void
@@ -2158,19 +2168,19 @@ root_create_main_thread (struct igc *gc)
 {
   void *start = &main_thread;
   void *end = (char *) &main_thread + sizeof (main_thread);
-  root_create_exact (gc, start, end, scan_main_thread);
+  root_create_exact (gc, start, end, scan_main_thread, "main-thread");
 }
 
 void
-igc_root_create_ambig (void *start, void *end)
+igc_root_create_ambig (void *start, void *end, const char* debug_name)
 {
-  root_create_ambig (global_igc, start, end);
+  root_create_ambig (global_igc, start, end, debug_name);
 }
 
 void
 igc_root_create_exact (Lisp_Object *start, Lisp_Object *end)
 {
-  root_create_exact (global_igc, start, end, scan_exact);
+  root_create_exact (global_igc, start, end, scan_exact, "exact");
 }
 
 void
@@ -2178,7 +2188,7 @@ igc_root_create_exact_ptr (void *var_addr)
 {
   void *start = var_addr;
   void *end = (char *) start + sizeof (void *);
-  root_create_exact (global_igc, start, end, scan_ptr_exact);
+  root_create_exact (global_igc, start, end, scan_ptr_exact, "exact-ptr");
 }
 
 static void
@@ -2194,7 +2204,8 @@ root_create_specpdl (struct igc_thread_list *t)
 			    ts->m_specpdl, ts->m_specpdl_end, scan_specpdl, t);
   IGC_CHECK_RES (res);
   t->d.specpdl_root
-    = register_root (gc, root, ts->m_specpdl, ts->m_specpdl_end, false);
+    = register_root (gc, root, ts->m_specpdl, ts->m_specpdl_end, false,
+		     "specpdl");
 }
 
 static void
@@ -2208,14 +2219,16 @@ root_create_bc (struct igc_thread_list *t)
 					bc->stack, bc->stack_end, scan_bc, t);
   IGC_CHECK_RES (res);
   igc_assert (t->d.bc_root == NULL);
-  t->d.bc_root = register_root (gc, root, bc->stack, bc->stack_end, true);
+  t->d.bc_root = register_root (gc, root, bc->stack, bc->stack_end, true,
+				"bc-stack");
 }
 
 static void
 root_create_charset_table (struct igc *gc)
 {
   root_create_ambig (gc, charset_table_init,
-		     charset_table_init + ARRAYELTS (charset_table_init));
+		     charset_table_init + ARRAYELTS (charset_table_init),
+		     "charset-table");
 }
 
 #ifndef IN_MY_FORK
@@ -2224,7 +2237,8 @@ root_create_pure (struct igc *gc)
 {
   void *start = &pure[0];
   void *end = &pure[PURESIZE];
-  root_create (gc, start, end, mps_rank_ambig (), scan_pure, NULL, true);
+  root_create (gc, start, end, mps_rank_ambig (), scan_pure, NULL, true,
+	       "pure");
 }
 #endif
 
@@ -2238,7 +2252,7 @@ root_create_thread (struct igc_thread_list *t)
     = mps_root_create_thread_scanned (&root, gc->arena, mps_rank_ambig (), 0,
 				      t->d.thr, scan_ambig, 0, cold);
   IGC_CHECK_RES (res);
-  register_root (gc, root, cold, NULL, true);
+  register_root (gc, root, cold, NULL, true, "create-thread");
 }
 
 void
@@ -2269,7 +2283,8 @@ igc_grow_rdstack (struct read_stack *rs)
     for (ptrdiff_t i = old_nitems; i < rs->size; ++i)
       rs->stack[i].type = RE_free;
     gc->rdstack_root
-      = root_create_exact (gc, rs->stack, rs->stack + rs->size, scan_rdstack);
+      = root_create_exact (gc, rs->stack, rs->stack + rs->size, scan_rdstack,
+			   "rdstack");
   }
 }
 
@@ -2278,7 +2293,8 @@ 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);
+  return root_create_exact (global_igc, start, start + n, scan_exact,
+			    "exact-n");
 }
 
 void *
@@ -2424,7 +2440,8 @@ igc_xalloc_lisp_objs_exact (size_t n)
 {
   size_t size = n * sizeof (Lisp_Object);
   void *p = xzalloc (size);
-  root_create_exact (global_igc, p, (char *) p + size, scan_exact);
+  root_create_exact (global_igc, p, (char *) p + size, scan_exact,
+		     "xalloc-exact");
   return p;
 }
 
@@ -2443,7 +2460,7 @@ igc_xzalloc_ambig (size_t size)
   void *end = (char *) p + size;
   if (end == p)
     end = (char *) p + IGC_ALIGN_DFLT;
-  root_create_ambig (global_igc, p, end);
+  root_create_ambig (global_igc, p, end, "xzalloc-ambig");
   return p;
 }
 
@@ -2459,7 +2476,7 @@ igc_realloc_ambig (void *block, size_t size)
   size_t new_size = (size == 0 ? IGC_ALIGN_DFLT : size);
   void *p = xrealloc (block, new_size);
   void *end = (char *)p + new_size;
-  root_create_ambig (global_igc, p, end);
+  root_create_ambig (global_igc, p, end, "realloc-ambig");
   return p;
 }
 
@@ -2492,7 +2509,7 @@ igc_xpalloc_ambig (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
       }
     pa = xpalloc (pa, nitems, nitems_incr_min, nitems_max, item_size);
     char *end = (char *) pa + *nitems * item_size;
-    root_create_ambig (global_igc, pa, end);
+    root_create_ambig (global_igc, pa, end, "xpalloc-ambig");
   }
   return pa;
 }
@@ -2522,7 +2539,7 @@ igc_xpalloc_exact (void **pa_cell, ptrdiff_t *nitems,
     pa = xpalloc (pa, nitems, nitems_incr_min, nitems_max, item_size);
     char *end = (char *)pa + *nitems * item_size;
     root_create (global_igc, pa, end, mps_rank_exact (),
-		 scan_xpalloced, scan_area, false);
+		 scan_xpalloced, scan_area, false, "xpalloc-exact");
     *pa_cell = pa;
   }
 }
@@ -2540,7 +2557,7 @@ igc_xnrealloc_ambig (void *pa, ptrdiff_t nitems, ptrdiff_t item_size)
       }
     pa = xnrealloc (pa, nitems, item_size);
     char *end = (char *) pa + nitems * item_size;
-    root_create_ambig (global_igc, pa, end);
+    root_create_ambig (global_igc, pa, end, "xnrealloc-ambig");
   }
   return pa;
 }
@@ -3980,7 +3997,8 @@ igc_on_pdump_loaded (void *dump_base, void *hot_start, void *hot_end,
   memcpy (pinned_objects_in_dump, pinned_roots, sizeof pinned_roots);
   igc_root_create_ambig (pinned_objects_in_dump,
 			 (uint8_t *)pinned_objects_in_dump
-			     + sizeof pinned_objects_in_dump);
+			 + sizeof pinned_objects_in_dump,
+			 "dump-pins");
 }
 
 void *
diff --git a/src/igc.h b/src/igc.h
index cd782fca0ca..485f23090c2 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -145,7 +145,7 @@ #define EMACS_IGC_H
 void igc_on_alloc_main_thread_bc (void);
 void igc_begin_collecting (void);
 void igc_collect (void);
-void igc_root_create_ambig (void *start, void *end);
+void igc_root_create_ambig (void *start, void *end, const char *debug_name);
 void igc_root_create_exact (Lisp_Object *start, Lisp_Object *end);
 void igc_root_create_exact_ptr (void *var_addr);
 void igc_root_destroy_comp_unit (struct Lisp_Native_Comp_Unit *u);
diff --git a/src/keyboard.c b/src/keyboard.c
index 21c4bbd7b2f..e40447d4b39 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -12670,7 +12670,8 @@ delete_kboard (KBOARD *kb)
 init_keyboard (void)
 {
 #ifdef HAVE_MPS
-  igc_root_create_ambig (kbd_buffer, kbd_buffer + ARRAYELTS (kbd_buffer));
+  igc_root_create_ambig (kbd_buffer, kbd_buffer + ARRAYELTS (kbd_buffer),
+			 "kdb-buffer");
 #endif
   /* This is correct before outermost invocation of the editor loop.  */
   command_loop_level = -1;
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0006-Use-igc_assert-instead-of-eassert.patch --]
[-- Type: text/x-diff, Size: 2252 bytes --]

From d810517b678e920a45992f02138d688a7cb37df8 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Thu, 20 Jun 2024 15:08:55 +0200
Subject: [PATCH 6/6] Use igc_assert instead of eassert

* src/igc.c. (igc_on_pdump_loaded):
---
 src/igc.c | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/src/igc.c b/src/igc.c
index 627f88acf4d..b8f0c020847 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -3962,24 +3962,24 @@ igc_on_pdump_loaded (void *dump_base, void *hot_start, void *hot_end,
 		     void *cold_user_data_start, void *heap_end)
 {
   igc_assert (global_igc->park_count > 0);
-  eassert (base_to_client (hot_start) == charset_table);
-  eassert (((struct igc_header *)cold_start)->obj_type
-	   == IGC_OBJ_DUMPED_CODE_SPACE_MASKS);
-  eassert (((struct igc_header *)cold_user_data_start)->obj_type
-	   == IGC_OBJ_DUMPED_BYTES);
-  eassert (((struct igc_header *)heap_end)->obj_type == IGC_OBJ_DUMPED_BYTES);
-
+  igc_assert (base_to_client (hot_start) == charset_table);
+  igc_assert (((struct igc_header *)hot_start)->obj_type
+	      == IGC_OBJ_DUMPED_CHARSET_TABLE);
+  igc_assert (((struct igc_header *)cold_start)->obj_type
+	      == IGC_OBJ_DUMPED_CODE_SPACE_MASKS);
+  igc_assert (((struct igc_header *)cold_user_data_start)->obj_type
+	      == IGC_OBJ_DUMPED_BYTES);
+  igc_assert (((struct igc_header *)heap_end)->obj_type
+	      == IGC_OBJ_DUMPED_BYTES);
   size_t discardable_size = (uint8_t *)cold_start - (uint8_t *)hot_end;
   // size_t cold_size = (uint8_t *)cold_end - (uint8_t *)cold_start;
   size_t dump_header_size = (uint8_t *)hot_start - (uint8_t *)dump_base;
   size_t relocs_size = (uint8_t *)cold_end - (uint8_t *)heap_end;
   struct igc_header *h = client_to_base (dump_base);
   igc_assert (h->obj_type == IGC_OBJ_INVALID);
-#ifdef IGC_DEBUG
-  size_t dump_size = (uint8_t *)cold_end - (uint8_t *)dump_base;
-  igc_assert (obj_size (h) == sizeof *h + dump_size);
+  igc_assert (obj_size (h)
+	      == sizeof *h + (uint8_t *)cold_end - (uint8_t *)dump_base);
   igc_assert (discardable_size > 2 * sizeof *h);
-#endif
   /* Ignore dump_header */
   set_header (h, IGC_OBJ_PAD, sizeof *h + dump_header_size, 0);
   /* Ignore discardable section */
-- 
2.39.2

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> The numbers are the duration for scanning the root, in cycles; multiply
> with 400 picoseconds (or whatever you think is appropriate for one
> cycle) to get the time.  E.g.  for lispsym, the maximum was 2853050 *
> 400e-12 =~ 1.1 millisecond.
>
> That's down from 10 milliseconds it used to take to scan the dump.

Nice 👍!

> I expected that staticvec to be at the top, but I guess lispsym actually
> makes sense.  It's strange though, that the maximum and minimum for
> lispsym vary so much.

I find it quite unexpected that lispsym takes so long, compared to a
multi-megabyte dump. Hm. Is it an optimized build?

> I general, ert-tests.el is quite strange.  To run all tests in there
> with:
>
>   make lisp/emacs-lisp/ert-tests
>
> requires almost 4GB peak, but when running
> ert-test-run-tests-batch-expensive alone, it requires much less than
> that.
>
> Here are the patches for this:

Pushed.

Re: MPS: Forwording symbols

[Helmut Eller]

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

On Thu, Jun 20 2024, Gerd Möllmann wrote:

>> I expected that staticvec to be at the top, but I guess lispsym actually
>> makes sense.  It's strange though, that the maximum and minimum for
>> lispsym vary so much.
>
> I find it quite unexpected that lispsym takes so long, compared to a
> multi-megabyte dump.

Maybe ert-tests.el allocates tons of symbols?

> Hm. Is it an optimized build?

Yes, optimized build.  The script below should reproduce it.   


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: record-ert.sh --]
[-- Type: text/x-sh, Size: 777 bytes --]

#!/bin/bash

export MPS_TELEMETRY_FILENAME=/tmp/mpsio.log
export MPS_SQLITE=/tmp/mps.sqlite

MPS_TELEMETRY_CONTROL="all" \
../src/emacs -Q --batch -l lisp/emacs-lisp/ert-tests.el \
--eval '(ert-run-tests-batch-and-exit "ert-test-\\(parse\\|plist\\|record\\|run-tests-batch-exp\\)")'

mpseventcnv -f $MPS_TELEMETRY_FILENAME | mpseventsql -p -d -o $MPS_SQLITE

sqlite3 $MPS_SQLITE "select root,label,avg(delta),min(delta),max(delta),count(*) as count from (select root, (select I.string from  EVENT_Intern AS I,  EVENT_Label AS L where I.stringId = L.stringId and R.root=L.address) as label,time, time - lag(time) over (order by time) as delta from (select root,time from EVENT_RootScan union select 'flip',time from EVENT_TraceFlipBegin) R) group by root order by avg(delta) ;"

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Thu, Jun 20 2024, Gerd Möllmann wrote:
>
>>> I expected that staticvec to be at the top, but I guess lispsym actually
>>> makes sense.  It's strange though, that the maximum and minimum for
>>> lispsym vary so much.
>>
>> I find it quite unexpected that lispsym takes so long, compared to a
>> multi-megabyte dump.
>
> Maybe ert-tests.el allocates tons of symbols?

lispsym contains only the built-in symbols, i.e. the ones defined with
DEFSYM, AFAIK.

>> Hm. Is it an optimized build?
>
> Yes, optimized build.  The script below should reproduce it.   

Thanks!

Re: MPS: Forwording symbols

[Helmut Eller]

On Sun, Jun 16 2024, Gerd Möllmann wrote:

> Ok, I've looked a bit closer, and I think we can avoid dumping the
> the forwarding structs altogether.
>
> There are 5 types of forwarding structs
>
>  enum Lisp_Fwd_Type
>    {
>      Lisp_Fwd_Int,		/* Fwd to a C `int' variable.  */
>      Lisp_Fwd_Bool,		/* Fwd to a C boolean var.  */
>      Lisp_Fwd_Obj,		/* Fwd to a C Lisp_Object variable.  */
>      Lisp_Fwd_Buffer_Obj,	/* Fwd to a Lisp_Object field of buffers.  */
>      Lisp_Fwd_Kboard_Obj		/* Fwd to a Lisp_Object field of kboards.  */
>    };
>
> Four of them contain only the type and either integer offsets or
> pointers to variables in Emacs' data segment. The only interesting one
> is Lisp_Fwd_Buffer_Obj which looks like
>
>   struct Lisp_Buffer_Objfwd
>     {
>       enum Lisp_Fwd_Type type;	/* = Lisp_Fwd_Buffer_Obj */
>       int offset;
>       /* One of Qnil, Qintegerp, Qsymbolp, Qstringp, Qfloatp or Qnumberp.  */
>       Lisp_Object predicate;
>     };
>
> which has an additional member for the predicate. AFAICT, the comment is
> true, and thus predicate is also a constant because it is always from a
> DEFSYM, i.e. it is a symbol from lispsym.

Can we use similar reasoning to remove fix_fwd?  If predicate is
guaranteed to be a builtin symbol, then we don't need to do anything for
the Lisp_Buffer_Objfwd case.

Then only remains issue with DEFVAR_LISP_NOPRO.  We could simply make
DEFVAR_LISP_NOPRO an alias for the regular DEFVAR_LISP.

If fix_symbol needs to call fix_fwd, then so should fix_blv.  But nicer
would be to remove fix_fwd altogether.

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Sun, Jun 16 2024, Gerd Möllmann wrote:
>
>> Ok, I've looked a bit closer, and I think we can avoid dumping the
>> the forwarding structs altogether.
>>
>> There are 5 types of forwarding structs
>>
>>  enum Lisp_Fwd_Type
>>    {
>>      Lisp_Fwd_Int,		/* Fwd to a C `int' variable.  */
>>      Lisp_Fwd_Bool,		/* Fwd to a C boolean var.  */
>>      Lisp_Fwd_Obj,		/* Fwd to a C Lisp_Object variable.  */
>>      Lisp_Fwd_Buffer_Obj,	/* Fwd to a Lisp_Object field of buffers.  */
>>      Lisp_Fwd_Kboard_Obj		/* Fwd to a Lisp_Object field of kboards.  */
>>    };
>>
>> Four of them contain only the type and either integer offsets or
>> pointers to variables in Emacs' data segment. The only interesting one
>> is Lisp_Fwd_Buffer_Obj which looks like
>>
>>   struct Lisp_Buffer_Objfwd
>>     {
>>       enum Lisp_Fwd_Type type;	/* = Lisp_Fwd_Buffer_Obj */
>>       int offset;
>>       /* One of Qnil, Qintegerp, Qsymbolp, Qstringp, Qfloatp or Qnumberp.  */
>>       Lisp_Object predicate;
>>     };
>>
>> which has an additional member for the predicate. AFAICT, the comment is
>> true, and thus predicate is also a constant because it is always from a
>> DEFSYM, i.e. it is a symbol from lispsym.
>
> Can we use similar reasoning to remove fix_fwd?  If predicate is
> guaranteed to be a builtin symbol, then we don't need to do anything for
> the Lisp_Buffer_Objfwd case.
>
> Then only remains issue with DEFVAR_LISP_NOPRO.  We could simply make
> DEFVAR_LISP_NOPRO an alias for the regular DEFVAR_LISP.
>
> If fix_symbol needs to call fix_fwd, then so should fix_blv.  But nicer
> would be to remove fix_fwd altogether.

Sounds like a good plan to me.

Maybe we could also make predicate an enum at the same time? It need not
be a Lisp_Object, and replacing it with an enum would make that clearer.

Re: MPS: Forwording symbols

[Ihor Radchenko]

Helmut Eller <eller.helmut@gmail.com> writes:

> Can we use similar reasoning to remove fix_fwd?  If predicate is
> guaranteed to be a builtin symbol, then we don't need to do anything for
> the Lisp_Buffer_Objfwd case.

A side note: If some parts of the code now has to be careful about
handling built-in/non-builtin symbols, would it make sense to add some
relevant assertions to the debug build? Otherwise, future changes in
Emacs may accidentally introduce hard-to-debug crashes.

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: Forwording symbols

[Gerd Möllmann]

Gerd Möllmann <gerd.moellmann@gmail.com> writes:

> Sounds like a good plan to me.
>
> Maybe we could also make predicate an enum at the same time? It need not
> be a Lisp_Object, and replacing it with an enum would make that clearer.

And if I had a wish free, I'd want the lispfwd with the void *, and
the structs, to be one struct with a type and a union.

Re: MPS: Forwording symbols

[Gerd Möllmann]

Ihor Radchenko <yantar92@posteo.net> writes:

> Helmut Eller <eller.helmut@gmail.com> writes:
>
>> Can we use similar reasoning to remove fix_fwd?  If predicate is
>> guaranteed to be a builtin symbol, then we don't need to do anything for
>> the Lisp_Buffer_Objfwd case.
>
> A side note: If some parts of the code now has to be careful about
> handling built-in/non-builtin symbols, would it make sense to add some
> relevant assertions to the debug build? Otherwise, future changes in
> Emacs may accidentally introduce hard-to-debug crashes.

That's why I'd much prefer an enum.

Re: MPS: Forwording symbols

[Helmut Eller]

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

On Fri, Jun 21 2024, Gerd Möllmann wrote:

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>> Sounds like a good plan to me.

Some patches for this are below.

>> Maybe we could also make predicate an enum at the same time? It need not
>> be a Lisp_Object, and replacing it with an enum would make that clearer.

This would require translating symbols to enums and back.  Or do you
think about something else?

> And if I had a wish free, I'd want the lispfwd with the void *, and
> the structs, to be one struct with a type and a union.

You mean lispfwd would require two words instead of one?  Would that work
when swapping bindings in and out?

If we can use two words, then it would perhaps be possible to use
pointers to the values directly instead of pointers to fwd objects?



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Make-Lisp_Buffer_Objfwd-objects-const.patch --]
[-- Type: text/x-diff, Size: 28383 bytes --]

From c990892d40ccc55d3cafa576fb8261a3521ada38 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Sat, 22 Jun 2024 16:43:29 +0200
Subject: [PATCH] Make Lisp_Buffer_Objfwd objects const

The predicate field is always a builtin symbol.  That means we know the
bit pattern at compile-time and they don't change at runtime.

* src/buffer.c (DEFVAR_PER_BUFFER): Create a const struct.
(defvar_per_buffer): Remove predicate and address arguments.
(syms_of_buffer): Instead of &BVAR (current_buffer, foo) use a plain foo
as argument to DEFVAR_PER_BUFFER.

* src/pdumper.c (dump_field_fwd): No more relocs needed for
Lisp_Fwd_Buffer_Obj and we can't apply them in the .rodata section.
---
 src/buffer.c  | 157 +++++++++++++++++++++++++-------------------------
 src/pdumper.c |  21 ++-----
 2 files changed, 84 insertions(+), 94 deletions(-)

diff --git a/src/buffer.c b/src/buffer.c
index fcfb563ed4b..d864560ec85 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -5017,31 +5017,33 @@ init_buffer (void)
    that nil is allowed too).  DOC is a dummy where you write the doc
    string as a comment.  */
 
-#define DEFVAR_PER_BUFFER(lname, vname, predicate, doc)		\
-  do {								\
-    static struct Lisp_Buffer_Objfwd bo_fwd;			\
-    defvar_per_buffer (&bo_fwd, lname, vname, predicate);	\
-  } while (0)
+/* FIXME: use LISPSYM_INITIALLY instead of TAG_PTR_INITIALLY */
+#define DEFVAR_PER_BUFFER(lname, vname, predicate_, doc)		\
+do									\
+  {									\
+    const Lisp_Object sym = TAG_PTR_INITIALLY (				\
+	Lisp_Symbol, (intptr_t)((i##predicate_) * sizeof *lispsym));	\
+    static const struct Lisp_Buffer_Objfwd bo_fwd = {			\
+      .type = Lisp_Fwd_Buffer_Obj,					\
+      .offset = offsetof (struct buffer, vname##_),			\
+      .predicate = sym,							\
+    };									\
+    defvar_per_buffer (&bo_fwd, lname);					\
+  }									\
+while (0)
 
 static void
-defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring,
-		   Lisp_Object *address, Lisp_Object predicate)
+defvar_per_buffer (const struct Lisp_Buffer_Objfwd *bo_fwd,
+		   const char *namestring)
 {
-  struct Lisp_Symbol *sym;
-  int offset;
-
-  sym = XSYMBOL (intern (namestring));
-  offset = (char *)address - (char *)current_buffer;
+  struct Lisp_Symbol *sym = XSYMBOL (intern (namestring));
 
-  bo_fwd->type = Lisp_Fwd_Buffer_Obj;
-  bo_fwd->offset = offset;
-  bo_fwd->predicate = predicate;
   sym->u.s.declared_special = true;
   sym->u.s.redirect = SYMBOL_FORWARDED;
   SET_SYMBOL_FWD (sym, bo_fwd);
-  XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym);
+  XSETSYMBOL (PER_BUFFER_SYMBOL (bo_fwd->offset), sym);
 
-  if (PER_BUFFER_IDX (offset) == 0)
+  if (PER_BUFFER_IDX (bo_fwd->offset) == 0)
     /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
        slot of buffer_local_flags.  */
     emacs_abort ();
@@ -5141,14 +5143,14 @@ syms_of_buffer (void)
   DEFSYM (Qclone_indirect_buffer_hook, "clone-indirect-buffer-hook");
 
   DEFVAR_PER_BUFFER ("tab-line-format",
-		     &BVAR (current_buffer, tab_line_format),
+		     tab_line_format,
 		     Qnil,
 		     doc: /* Analogous to `mode-line-format', but controls the tab line.
 The tab line appears, optionally, at the top of a window;
 the mode line appears at the bottom.  */);
 
   DEFVAR_PER_BUFFER ("header-line-format",
-		     &BVAR (current_buffer, header_line_format),
+		     header_line_format,
 		     Qnil,
 		     doc: /* Analogous to `mode-line-format', but controls the header line.
 The header line appears, optionally, at the top of a window; the mode
@@ -5157,7 +5159,7 @@ syms_of_buffer (void)
 Also see `header-line-indent-mode' if `display-line-numbers-mode' is
 turned on and header-line text should be aligned with buffer text.  */);
 
-  DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format),
+  DEFVAR_PER_BUFFER ("mode-line-format", mode_line_format,
 		     Qnil,
 		     doc: /* Template for displaying mode line for a window's buffer.
 
@@ -5231,7 +5233,7 @@ syms_of_buffer (void)
   %% -- print %.
 Decimal digits after the % specify field width to which to pad.  */);
 
-  DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode),
+  DEFVAR_PER_BUFFER ("major-mode", major_mode,
 		     Qsymbolp,
 		     doc: /* Symbol for current buffer's major mode.
 The default value (normally `fundamental-mode') affects new buffers.
@@ -5239,26 +5241,26 @@ syms_of_buffer (void)
 it is not marked as "special".  */);
 
   DEFVAR_PER_BUFFER ("local-minor-modes",
-		     &BVAR (current_buffer, local_minor_modes),
+		     local_minor_modes,
 		     Qnil,
 		     doc: /* Minor modes currently active in the current buffer.
 This is a list of symbols, or nil if there are no minor modes active.  */);
 
-  DEFVAR_PER_BUFFER ("mode-name", &BVAR (current_buffer, mode_name),
+  DEFVAR_PER_BUFFER ("mode-name", mode_name,
                      Qnil,
 		     doc: /* Pretty name of current buffer's major mode.
 Usually a string, but can use any of the constructs for `mode-line-format',
 which see.
 Format with `format-mode-line' to produce a string value.  */);
 
-  DEFVAR_PER_BUFFER ("local-abbrev-table", &BVAR (current_buffer, abbrev_table), Qnil,
+  DEFVAR_PER_BUFFER ("local-abbrev-table", abbrev_table, Qnil,
 		     doc: /* Local (mode-specific) abbrev table of current buffer.  */);
 
-  DEFVAR_PER_BUFFER ("abbrev-mode", &BVAR (current_buffer, abbrev_mode), Qnil,
+  DEFVAR_PER_BUFFER ("abbrev-mode", abbrev_mode, Qnil,
 		     doc: /*  Non-nil if Abbrev mode is enabled.
 Use the command `abbrev-mode' to change this variable.  */);
 
-  DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column),
+  DEFVAR_PER_BUFFER ("fill-column", fill_column,
 		     Qintegerp,
 		     doc: /* Column beyond which automatic line-wrapping should happen.
 It is used by filling commands, such as `fill-region' and `fill-paragraph',
@@ -5266,12 +5268,12 @@ syms_of_buffer (void)
 See also `current-fill-column'.
 Interactively, you can set the buffer local value using \\[set-fill-column].  */);
 
-  DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin),
+  DEFVAR_PER_BUFFER ("left-margin", left_margin,
 		     Qintegerp,
 		     doc: /* Column for the default `indent-line-function' to indent to.
 Linefeed indents to this column in Fundamental mode.  */);
 
-  DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width),
+  DEFVAR_PER_BUFFER ("tab-width", tab_width,
 		     Qintegerp,
 		     doc: /* Distance between tab stops (for display of tab characters), in columns.
 This controls the width of a TAB character on display.
@@ -5281,14 +5283,14 @@ syms_of_buffer (void)
 inserts one or more TAB characters, this variable will affect the
 indentation step as well, even if `indent-tabs-mode' is non-nil.  */);
 
-  DEFVAR_PER_BUFFER ("ctl-arrow", &BVAR (current_buffer, ctl_arrow), Qnil,
+  DEFVAR_PER_BUFFER ("ctl-arrow", ctl_arrow, Qnil,
 		     doc: /* Non-nil means display control chars with uparrow `^'.
 A value of nil means use backslash `\\' and octal digits.
 This variable does not apply to characters whose display is specified in
 the current display table (if there is one; see `standard-display-table').  */);
 
   DEFVAR_PER_BUFFER ("enable-multibyte-characters",
-		     &BVAR (current_buffer, enable_multibyte_characters),
+		     enable_multibyte_characters,
 		     Qnil,
 		     doc: /* Non-nil means the buffer contents are regarded as multi-byte characters.
 Otherwise they are regarded as unibyte.  This affects the display,
@@ -5302,7 +5304,7 @@ syms_of_buffer (void)
   make_symbol_constant (intern_c_string ("enable-multibyte-characters"));
 
   DEFVAR_PER_BUFFER ("buffer-file-coding-system",
-		     &BVAR (current_buffer, buffer_file_coding_system), Qnil,
+		     buffer_file_coding_system, Qnil,
 		     doc: /* Coding system to be used for encoding the buffer contents on saving.
 This variable applies to saving the buffer, and also to `write-region'
 and other functions that use `write-region'.
@@ -5320,7 +5322,7 @@ syms_of_buffer (void)
 This variable is never applied to a way of decoding a file while reading it.  */);
 
   DEFVAR_PER_BUFFER ("bidi-display-reordering",
-		     &BVAR (current_buffer, bidi_display_reordering), Qnil,
+		     bidi_display_reordering, Qnil,
 		     doc: /* Non-nil means reorder bidirectional text for display in the visual order.
 Setting this to nil is intended for use in debugging the display code.
 Don't set to nil in normal sessions, as that is not supported.
@@ -5328,7 +5330,7 @@ syms_of_buffer (void)
 speed up redisplay.  */);
 
   DEFVAR_PER_BUFFER ("bidi-paragraph-start-re",
-		     &BVAR (current_buffer, bidi_paragraph_start_re), Qnil,
+		     bidi_paragraph_start_re, Qnil,
 		     doc: /* If non-nil, a regexp matching a line that starts OR separates paragraphs.
 
 The value of nil means to use empty lines as lines that start and
@@ -5350,7 +5352,7 @@ syms_of_buffer (void)
 See also `bidi-paragraph-direction'.  */);
 
   DEFVAR_PER_BUFFER ("bidi-paragraph-separate-re",
-		     &BVAR (current_buffer, bidi_paragraph_separate_re), Qnil,
+		     bidi_paragraph_separate_re, Qnil,
 		     doc: /* If non-nil, a regexp matching a line that separates paragraphs.
 
 The value of nil means to use empty lines as paragraph separators.
@@ -5371,7 +5373,7 @@ syms_of_buffer (void)
 See also `bidi-paragraph-direction'.  */);
 
   DEFVAR_PER_BUFFER ("bidi-paragraph-direction",
-		     &BVAR (current_buffer, bidi_paragraph_direction), Qnil,
+		     bidi_paragraph_direction, Qnil,
 		     doc: /* If non-nil, forces directionality of text paragraphs in the buffer.
 
 If this is nil (the default), the direction of each paragraph is
@@ -5382,7 +5384,7 @@ syms_of_buffer (void)
 This variable has no effect unless the buffer's value of
 `bidi-display-reordering' is non-nil.  */);
 
- DEFVAR_PER_BUFFER ("truncate-lines", &BVAR (current_buffer, truncate_lines), Qnil,
+ DEFVAR_PER_BUFFER ("truncate-lines", truncate_lines, Qnil,
 		     doc: /* Non-nil means do not display continuation lines.
 Instead, give each line of text just one screen line.
 
@@ -5395,7 +5397,7 @@ syms_of_buffer (void)
 Don't set this to a non-nil value when `visual-line-mode' is
 turned on, as it could produce confusing results.   */);
 
-  DEFVAR_PER_BUFFER ("word-wrap", &BVAR (current_buffer, word_wrap), Qnil,
+  DEFVAR_PER_BUFFER ("word-wrap", word_wrap, Qnil,
 		     doc: /* Non-nil means to use word-wrapping for continuation lines.
 When word-wrapping is on, continuation lines are wrapped at the space
 or tab character nearest to the right window edge.
@@ -5413,14 +5415,14 @@ syms_of_buffer (void)
 visual lines rather than logical lines.  See the documentation of
 `visual-line-mode'.  */);
 
-  DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory),
+  DEFVAR_PER_BUFFER ("default-directory", directory,
 		     Qstringp,
 		     doc: /* Name of default directory of current buffer.
 It should be an absolute directory name; on GNU and Unix systems,
 these names start with "/" or "~" and end with "/".
 To interactively change the default directory, use the command `cd'. */);
 
-  DEFVAR_PER_BUFFER ("auto-fill-function", &BVAR (current_buffer, auto_fill_function),
+  DEFVAR_PER_BUFFER ("auto-fill-function", auto_fill_function,
 		     Qnil,
 		     doc: /* Function called (if non-nil) to perform auto-fill.
 It is called after self-inserting any character specified in
@@ -5428,31 +5430,31 @@ syms_of_buffer (void)
 NOTE: This variable is not a hook;
 its value may not be a list of functions.  */);
 
-  DEFVAR_PER_BUFFER ("buffer-file-name", &BVAR (current_buffer, filename),
+  DEFVAR_PER_BUFFER ("buffer-file-name", filename,
 		     Qstringp,
 		     doc: /* Name of file visited in current buffer, or nil if not visiting a file.
 This should be an absolute file name.  */);
 
-  DEFVAR_PER_BUFFER ("buffer-file-truename", &BVAR (current_buffer, file_truename),
+  DEFVAR_PER_BUFFER ("buffer-file-truename", file_truename,
 		     Qstringp,
 		     doc: /* Abbreviated truename of file visited in current buffer, or nil if none.
 The truename of a file is calculated by `file-truename'
 and then abbreviated with `abbreviate-file-name'.  */);
 
   DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
-		     &BVAR (current_buffer, auto_save_file_name),
+		     auto_save_file_name,
 		     Qstringp,
 		     doc: /* Name of file for auto-saving current buffer.
 If it is nil, that means don't auto-save this buffer.  */);
 
-  DEFVAR_PER_BUFFER ("buffer-read-only", &BVAR (current_buffer, read_only), Qnil,
+  DEFVAR_PER_BUFFER ("buffer-read-only", read_only, Qnil,
 		     doc: /* Non-nil if this buffer is read-only.  */);
 
-  DEFVAR_PER_BUFFER ("buffer-backed-up", &BVAR (current_buffer, backed_up), Qnil,
+  DEFVAR_PER_BUFFER ("buffer-backed-up", backed_up, Qnil,
 		     doc: /* Non-nil if this buffer's file has been backed up.
 Backing up is done before the first time the file is saved.  */);
 
-  DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length),
+  DEFVAR_PER_BUFFER ("buffer-saved-size", save_length,
 		     Qintegerp,
 		     doc: /* Length of current buffer when last read in, saved or auto-saved.
 0 initially.
@@ -5462,7 +5464,7 @@ syms_of_buffer (void)
 if its text size shrinks.   If you use `buffer-swap-text' on a buffer,
 you probably should set this to -2 in that buffer.  */);
 
-  DEFVAR_PER_BUFFER ("selective-display", &BVAR (current_buffer, selective_display),
+  DEFVAR_PER_BUFFER ("selective-display", selective_display,
 		     Qnil,
 		     doc: /* Non-nil enables selective display.
 
@@ -5475,11 +5477,11 @@ syms_of_buffer (void)
 overlays or text properties instead.  */);
 
   DEFVAR_PER_BUFFER ("selective-display-ellipses",
-		     &BVAR (current_buffer, selective_display_ellipses),
+		     selective_display_ellipses,
 		     Qnil,
 		     doc: /* Non-nil means display ... on previous line when a line is invisible.  */);
 
-  DEFVAR_PER_BUFFER ("overwrite-mode", &BVAR (current_buffer, overwrite_mode),
+  DEFVAR_PER_BUFFER ("overwrite-mode", overwrite_mode,
 		     Qoverwrite_mode,
 		     doc: /* Non-nil if self-insertion should replace existing text.
 The value should be one of `overwrite-mode-textual',
@@ -5489,7 +5491,7 @@ syms_of_buffer (void)
 until the tab is filled in.
 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.  */);
 
-  DEFVAR_PER_BUFFER ("buffer-display-table", &BVAR (current_buffer, display_table),
+  DEFVAR_PER_BUFFER ("buffer-display-table", display_table,
 		     Qnil,
 		     doc: /* Display table that controls display of the contents of current buffer.
 
@@ -5526,7 +5528,7 @@ syms_of_buffer (void)
 
 See also the functions `display-table-slot' and `set-display-table-slot'.  */);
 
-  DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols),
+  DEFVAR_PER_BUFFER ("left-margin-width", left_margin_cols,
 		     Qintegerp,
 		     doc: /* Width in columns of left marginal area for display of a buffer.
 A value of nil means no marginal area.
@@ -5534,7 +5536,7 @@ syms_of_buffer (void)
 Setting this variable does not take effect until a new buffer is displayed
 in a window.  To make the change take effect, call `set-window-buffer'.  */);
 
-  DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols),
+  DEFVAR_PER_BUFFER ("right-margin-width", right_margin_cols,
 		     Qintegerp,
 		     doc: /* Width in columns of right marginal area for display of a buffer.
 A value of nil means no marginal area.
@@ -5542,7 +5544,7 @@ syms_of_buffer (void)
 Setting this variable does not take effect until a new buffer is displayed
 in a window.  To make the change take effect, call `set-window-buffer'.  */);
 
-  DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width),
+  DEFVAR_PER_BUFFER ("left-fringe-width", left_fringe_width,
 		     Qintegerp,
 		     doc: /* Width of this buffer's left fringe (in pixels).
 A value of 0 means no left fringe is shown in this buffer's window.
@@ -5551,7 +5553,7 @@ syms_of_buffer (void)
 Setting this variable does not take effect until a new buffer is displayed
 in a window.  To make the change take effect, call `set-window-buffer'.  */);
 
-  DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width),
+  DEFVAR_PER_BUFFER ("right-fringe-width", right_fringe_width,
 		     Qintegerp,
 		     doc: /* Width of this buffer's right fringe (in pixels).
 A value of 0 means no right fringe is shown in this buffer's window.
@@ -5560,7 +5562,7 @@ syms_of_buffer (void)
 Setting this variable does not take effect until a new buffer is displayed
 in a window.  To make the change take effect, call `set-window-buffer'.  */);
 
-  DEFVAR_PER_BUFFER ("fringes-outside-margins", &BVAR (current_buffer, fringes_outside_margins),
+  DEFVAR_PER_BUFFER ("fringes-outside-margins", fringes_outside_margins,
 		     Qnil,
 		     doc: /* Non-nil means to display fringes outside display margins.
 A value of nil means to display fringes between margins and buffer text.
@@ -5568,17 +5570,17 @@ syms_of_buffer (void)
 Setting this variable does not take effect until a new buffer is displayed
 in a window.  To make the change take effect, call `set-window-buffer'.  */);
 
-  DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width),
+  DEFVAR_PER_BUFFER ("scroll-bar-width", scroll_bar_width,
 		     Qintegerp,
 		     doc: /* Width of this buffer's vertical scroll bars in pixels.
 A value of nil means to use the scroll bar width from the window's frame.  */);
 
-  DEFVAR_PER_BUFFER ("scroll-bar-height", &BVAR (current_buffer, scroll_bar_height),
+  DEFVAR_PER_BUFFER ("scroll-bar-height", scroll_bar_height,
 		     Qintegerp,
 		     doc: /* Height of this buffer's horizontal scroll bars in pixels.
 A value of nil means to use the scroll bar height from the window's frame.  */);
 
-  DEFVAR_PER_BUFFER ("vertical-scroll-bar", &BVAR (current_buffer, vertical_scroll_bar_type),
+  DEFVAR_PER_BUFFER ("vertical-scroll-bar", vertical_scroll_bar_type,
 		     Qvertical_scroll_bar,
 		     doc: /* Position of this buffer's vertical scroll bar.
 The value takes effect whenever you tell a window to display this buffer;
@@ -5588,7 +5590,7 @@ syms_of_buffer (void)
 of the window; a value of nil means don't show any vertical scroll bars.
 A value of t (the default) means do whatever the window's frame specifies.  */);
 
-  DEFVAR_PER_BUFFER ("horizontal-scroll-bar", &BVAR (current_buffer, horizontal_scroll_bar_type),
+  DEFVAR_PER_BUFFER ("horizontal-scroll-bar", horizontal_scroll_bar_type,
 		     Qnil,
 		     doc: /* Position of this buffer's horizontal scroll bar.
 The value takes effect whenever you tell a window to display this buffer;
@@ -5600,14 +5602,14 @@ syms_of_buffer (void)
 specifies.  */);
 
   DEFVAR_PER_BUFFER ("indicate-empty-lines",
-		     &BVAR (current_buffer, indicate_empty_lines), Qnil,
+		     indicate_empty_lines, Qnil,
 		     doc: /* Visually indicate unused ("empty") screen lines after the buffer end.
 If non-nil, a bitmap is displayed in the left fringe of a window
 on graphical displays for each screen line that doesn't correspond
 to any buffer text.  */);
 
   DEFVAR_PER_BUFFER ("indicate-buffer-boundaries",
-		     &BVAR (current_buffer, indicate_buffer_boundaries), Qnil,
+		     indicate_buffer_boundaries, Qnil,
 		     doc: /* Visually indicate buffer boundaries and scrolling.
 If non-nil, the first and last line of the buffer are marked in the fringe
 of a window on graphical displays with angle bitmaps, or if the window can be
@@ -5632,7 +5634,7 @@ syms_of_buffer (void)
 fringe, but no arrow bitmaps, use ((top .  left) (bottom . left)).  */);
 
   DEFVAR_PER_BUFFER ("fringe-indicator-alist",
-		     &BVAR (current_buffer, fringe_indicator_alist), Qnil,
+		     fringe_indicator_alist, Qnil,
 		     doc: /* Mapping from logical to physical fringe indicator bitmaps.
 The value is an alist where each element (INDICATOR . BITMAPS)
 specifies the fringe bitmaps used to display a specific logical
@@ -5651,7 +5653,7 @@ last (only) line has no final newline.  BITMAPS may also be a single
 symbol which is used in both left and right fringes.  */);
 
   DEFVAR_PER_BUFFER ("fringe-cursor-alist",
-		     &BVAR (current_buffer, fringe_cursor_alist), Qnil,
+		     fringe_cursor_alist, Qnil,
 		     doc: /* Mapping from logical to physical fringe cursor bitmaps.
 The value is an alist where each element (CURSOR . BITMAP)
 specifies the fringe bitmaps used to display a specific logical
@@ -5666,7 +5668,7 @@ last (only) line has no final newline.  BITMAPS may also be a single
 cursor type.  */);
 
   DEFVAR_PER_BUFFER ("scroll-up-aggressively",
-		     &BVAR (current_buffer, scroll_up_aggressively), Qfraction,
+		     scroll_up_aggressively, Qfraction,
 		     doc: /* How far to scroll windows upward.
 If you move point off the bottom, the window scrolls automatically.
 This variable controls how far it scrolls.  The value nil, the default,
@@ -5679,7 +5681,7 @@ last (only) line has no final newline.  BITMAPS may also be a single
 between 0.0 and 1.0, inclusive.  */);
 
   DEFVAR_PER_BUFFER ("scroll-down-aggressively",
-		     &BVAR (current_buffer, scroll_down_aggressively), Qfraction,
+		     scroll_down_aggressively, Qfraction,
 		     doc: /* How far to scroll windows downward.
 If you move point off the top, the window scrolls automatically.
 This variable controls how far it scrolls.  The value nil, the default,
@@ -5730,7 +5732,7 @@ last (only) line has no final newline.  BITMAPS may also be a single
 The functions are run using the `run-hooks' function.  */);
   Vfirst_change_hook = Qnil;
 
-  DEFVAR_PER_BUFFER ("buffer-undo-list", &BVAR (current_buffer, undo_list), Qnil,
+  DEFVAR_PER_BUFFER ("buffer-undo-list", undo_list, Qnil,
 		     doc: /* List of undo entries in current buffer.
 Recent changes come first; older changes follow newer.
 
@@ -5776,10 +5778,10 @@ from (abs POSITION).  If POSITION is positive, point was at the front
 
 If the value of the variable is t, undo information is not recorded.  */);
 
-  DEFVAR_PER_BUFFER ("mark-active", &BVAR (current_buffer, mark_active), Qnil,
+  DEFVAR_PER_BUFFER ("mark-active", mark_active, Qnil,
 		     doc: /* Non-nil means the mark and region are currently active in this buffer.  */);
 
-  DEFVAR_PER_BUFFER ("cache-long-scans", &BVAR (current_buffer, cache_long_scans), Qnil,
+  DEFVAR_PER_BUFFER ("cache-long-scans", cache_long_scans, Qnil,
 		     doc: /* Non-nil means that Emacs should use caches in attempt to speedup buffer scans.
 
 There is no reason to set this to nil except for debugging purposes.
@@ -5815,23 +5817,23 @@ from (abs POSITION).  If POSITION is positive, point was at the front
 the cache should not affect the behavior of any of the motion
 functions; it should only affect their performance.  */);
 
-  DEFVAR_PER_BUFFER ("point-before-scroll", &BVAR (current_buffer, point_before_scroll), Qnil,
+  DEFVAR_PER_BUFFER ("point-before-scroll", point_before_scroll, Qnil,
 		     doc: /* Value of point before the last series of scroll operations, or nil.  */);
 
-  DEFVAR_PER_BUFFER ("buffer-file-format", &BVAR (current_buffer, file_format), Qnil,
+  DEFVAR_PER_BUFFER ("buffer-file-format", file_format, Qnil,
 		     doc: /* List of formats to use when saving this buffer.
 Formats are defined by `format-alist'.  This variable is
 set when a file is visited.  */);
 
   DEFVAR_PER_BUFFER ("buffer-auto-save-file-format",
-		     &BVAR (current_buffer, auto_save_file_format), Qnil,
+		     auto_save_file_format, Qnil,
 		     doc: /* Format in which to write auto-save files.
 Should be a list of symbols naming formats that are defined in `format-alist'.
 If it is t, which is the default, auto-save files are written in the
 same format as a regular save would use.  */);
 
   DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
-		     &BVAR (current_buffer, invisibility_spec), Qnil,
+		     invisibility_spec, Qnil,
 		     doc: /* Invisibility spec of this buffer.
 The default is t, which means that text is invisible if it has a non-nil
 `invisible' property.
@@ -5845,12 +5847,12 @@ from (abs POSITION).  If POSITION is positive, point was at the front
 the buffer looking for properties to change.  */);
 
   DEFVAR_PER_BUFFER ("buffer-display-count",
-		     &BVAR (current_buffer, display_count), Qintegerp,
+		     display_count, Qintegerp,
 		     doc: /* A number incremented each time this buffer is displayed in a window.
 The function `set-window-buffer' increments it.  */);
 
   DEFVAR_PER_BUFFER ("buffer-display-time",
-		     &BVAR (current_buffer, display_time), Qnil,
+		     display_time, Qnil,
 		     doc: /* Time stamp updated each time this buffer is displayed in a window.
 The function `set-window-buffer' updates this variable
 to the value obtained by calling `current-time'.
@@ -5886,7 +5888,7 @@ from (abs POSITION).  If POSITION is positive, point was at the front
 and all `read-only' text properties.  */);
   Vinhibit_read_only = Qnil;
 
-  DEFVAR_PER_BUFFER ("cursor-type", &BVAR (current_buffer, cursor_type), Qnil,
+  DEFVAR_PER_BUFFER ("cursor-type", cursor_type, Qnil,
 		     doc: /* Cursor to use when this buffer is in the selected window.
 Values are interpreted as follows:
 
@@ -5910,7 +5912,7 @@ from (abs POSITION).  If POSITION is positive, point was at the front
 `cursor-in-non-selected-windows'.  */);
 
   DEFVAR_PER_BUFFER ("line-spacing",
-		     &BVAR (current_buffer, extra_line_spacing), Qnumberp,
+		     extra_line_spacing, Qnumberp,
 		     doc: /* Additional space to put between lines when displaying a buffer.
 The space is measured in pixels, and put below lines on graphic displays,
 see `display-graphic-p'.
@@ -5918,7 +5920,7 @@ from (abs POSITION).  If POSITION is positive, point was at the front
 to the default frame line height.  A value of nil means add no extra space.  */);
 
   DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows",
-		     &BVAR (current_buffer, cursor_in_non_selected_windows), Qnil,
+		     cursor_in_non_selected_windows, Qnil,
 		     doc: /* Non-nil means show a cursor in non-selected windows.
 If nil, only shows a cursor in the selected window.
 If t, displays a cursor related to the usual cursor type
@@ -5929,8 +5931,7 @@ from (abs POSITION).  If POSITION is positive, point was at the front
   /* While this is defined here, each *term.c module must implement
      the logic itself.  */
 
-  DEFVAR_PER_BUFFER ("text-conversion-style", &BVAR (current_buffer,
-						     text_conversion_style),
+  DEFVAR_PER_BUFFER ("text-conversion-style", text_conversion_style,
 		     Qnil,
     doc: /* How the on screen keyboard's input method should insert in this buffer.
 
diff --git a/src/pdumper.c b/src/pdumper.c
index e69a2b56f0b..49357de1acb 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2370,13 +2370,13 @@ dump_field_fwd (struct dump_context *ctx, void *out, const void *in_start,
 	const struct Lisp_Intfwd *fwd = in_field->fwdptr;
 	dump_emacs_reloc_immediate_intmax_t (ctx, fwd->intvar, *fwd->intvar);
       }
-      break;
+      return;
     case Lisp_Fwd_Bool:
       {
 	const struct Lisp_Boolfwd *fwd = in_field->fwdptr;
 	dump_emacs_reloc_immediate_bool (ctx, fwd->boolvar, *fwd->boolvar);
       }
-      break;
+      return;
     case Lisp_Fwd_Obj:
       {
 	const struct Lisp_Objfwd *fwd = in_field->fwdptr;
@@ -2384,23 +2384,12 @@ dump_field_fwd (struct dump_context *ctx, void *out, const void *in_start,
 			    ctx->staticpro_table, Qnil)))
 	  dump_emacs_reloc_to_lv (ctx, fwd->objvar, *fwd->objvar);
       }
-      break;
+      return;
     case Lisp_Fwd_Kboard_Obj:
-      break;
     case Lisp_Fwd_Buffer_Obj:
-      {
-	const struct Lisp_Buffer_Objfwd *fwd = in_field->fwdptr;
-	dump_emacs_reloc_immediate (ctx, &fwd->type, &fwd->type,
-				    sizeof fwd->type);
-	dump_emacs_reloc_immediate (ctx, &fwd->offset, &fwd->offset,
-				    sizeof fwd->offset);
-	eassert (SYMBOLP (fwd->predicate));
-	/* FIXME: assumes symbols are represented as offsets from lispsym */
-	dump_emacs_reloc_immediate (ctx, &fwd->predicate, &fwd->predicate,
-				    sizeof fwd->predicate);
-      }
-      break;
+      return;
     }
+  emacs_abort ();
 }
 
 static dump_off
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-For-DEFVAR_LISP_NOPRO-do-the-same-as-for-DEFVAR_LISP.patch --]
[-- Type: text/x-diff, Size: 1215 bytes --]

From 8ea87414b2fc3dc21ce5bfe458a49f2f1c13165d Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Sat, 22 Jun 2024 17:23:54 +0200
Subject: [PATCH 1/2] For DEFVAR_LISP_NOPRO, do the same as for DEFVAR_LISP

* src/lisp.h (DEFVAR_LISP_NOPRO): This shortcut doesn't work with MPS.
---
 src/lisp.h | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/src/lisp.h b/src/lisp.h
index 23e250ff0d1..c7e47edb0cf 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3588,12 +3588,21 @@ #define DEFVAR_LISP(lname, vname, doc)		\
       = {Lisp_Fwd_Obj, &globals.f_##vname};	\
     defvar_lisp (&o_fwd, lname);		\
   } while (false)
+#ifdef HAVE_MPS
 #define DEFVAR_LISP_NOPRO(lname, vname, doc)	\
   do {						\
     static struct Lisp_Objfwd const o_fwd	\
       = {Lisp_Fwd_Obj, &globals.f_##vname};	\
+    defvar_lisp (&o_fwd, lname);		\
+  } while (false)
+#else
+#define DEFVAR_LISP_NOPRO(lname, vname, doc)	\
+  do {						\
+  static struct Lisp_Objfwd const o_fwd		\
+    = {Lisp_Fwd_Obj, &globals.f_##vname};	\
     defvar_lisp_nopro (&o_fwd, lname);		\
   } while (false)
+#endif
 #define DEFVAR_BOOL(lname, vname, doc)		\
   do {						\
     static struct Lisp_Boolfwd const b_fwd	\
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-Remove-fix_fwd.patch --]
[-- Type: text/x-diff, Size: 1531 bytes --]

From bb13044a9ca3e1e70dd5b2daa5cbff1d87493e44 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Sat, 22 Jun 2024 17:28:15 +0200
Subject: [PATCH 2/2] Remove fix_fwd

* src/igc.c (fix_fwd): Removed.  No longer needed.
(fix_symbol): Update accordingly.
---
 src/igc.c | 34 ----------------------------------
 1 file changed, 34 deletions(-)

diff --git a/src/igc.c b/src/igc.c
index 1d076706f7c..f03167fed4f 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -891,39 +891,6 @@ scan_staticvec (mps_ss_t ss, void *start, void *end, void *closure)
   return MPS_RES_OK;
 }
 
-static mps_res_t
-fix_fwd (mps_ss_t ss, lispfwd fwd)
-{
-  MPS_SCAN_BEGIN (ss)
-  {
-    switch (XFWDTYPE (fwd))
-      {
-      case Lisp_Fwd_Int:
-      case Lisp_Fwd_Bool:
-      case Lisp_Fwd_Kboard_Obj:
-	break;
-
-      case Lisp_Fwd_Obj:
-	{
-	  /* It is not guaranteed that we see all of these when
-	     scanning staticvec because of DEFVAR_LISP_NOPRO.  */
-	  struct Lisp_Objfwd *o = (void *) fwd.fwdptr;
-	  IGC_FIX12_OBJ (ss, o->objvar);
-	}
-	break;
-
-      case Lisp_Fwd_Buffer_Obj:
-	{
-	  struct Lisp_Buffer_Objfwd *b = (void *) fwd.fwdptr;
-	  IGC_FIX12_OBJ (ss, &b->predicate);
-	}
-	break;
-      }
-  }
-  MPS_SCAN_END (ss);
-  return MPS_RES_OK;
-}
-
 static mps_res_t
 fix_symbol (mps_ss_t ss, struct Lisp_Symbol *sym)
 {
@@ -952,7 +919,6 @@ fix_symbol (mps_ss_t ss, struct Lisp_Symbol *sym)
 	break;
 
       case SYMBOL_FORWARDED:
-	IGC_FIX_CALL (ss, fix_fwd (ss, sym->u.s.val.fwd));
 	break;
       }
   }
-- 
2.39.2

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Fri, Jun 21 2024, Gerd Möllmann wrote:
>
>> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>>
>>> Sounds like a good plan to me.
>
> Some patches for this are below.

Thanks, pushed.

>>> Maybe we could also make predicate an enum at the same time? It need not
>>> be a Lisp_Object, and replacing it with an enum would make that clearer.
>
> This would require translating symbols to enums and back.  Or do you
> think about something else?

I haven't looked at all places. Could you please explain where that is
needed?

>> And if I had a wish free, I'd want the lispfwd with the void *, and
>> the structs, to be one struct with a type and a union.
>
> You mean lispfwd would require two words instead of one?  Would that work
> when swapping bindings in and out?

I was thinking of using 1 struct instead of 4, like so

  enum Lisp_Fwd_Pred
  {
    /* Something with values for the Lisp_Object predicate ... */
    ...  
  };

  struct Lisp_Fwd
  {
    enum Lisp_Fwd_Type : 8;
    enum Lisp_Fwd_Predicate predicate : 8;
    union
    {
      intmax_t *intvar;
      bool *boolvar;
      Lisp_Object *objvar;
      int offset;
    } u;
  };

Then removing the Lisp_Fwd_Bool etc. structures that currently exist and
replace this

  typedef struct { void const *fwdptr; } lispfwd;

which is just a void * with ornaments, with const struct Lisp_Fwd *.

> If we can use two words, then it would perhaps be possible to use
> pointers to the values directly instead of pointers to fwd objects?

That would make each symbol 1 word bigger. I wouldn't mind, but I
guess someone might find that questionable, unless we can prove
some speed advantage or so :-).

Re: MPS: Forwording symbols

[Helmut Eller]

On Sat, Jun 22 2024, Gerd Möllmann wrote:

>> This would require translating symbols to enums and back.  Or do you
>> think about something else?
>
> I haven't looked at all places. Could you please explain where that is
> needed?

The symbol is needed in store_symval_forwarding.  It looks in the plist
for 'choice and 'range.  In addition to the five symbols mentioned in
the definition of Lisp_Buffer_Objfwd, predicate can also be
'overwrite-mode, 'vertical-scroll-bar and 'fraction.  I think those have
those properties; weird.

>>> And if I had a wish free, I'd want the lispfwd with the void *, and
>>> the structs, to be one struct with a type and a union.
>>
>> You mean lispfwd would require two words instead of one?  Would that work
>> when swapping bindings in and out?
>
> I was thinking of using 1 struct instead of 4, like so
>
>   enum Lisp_Fwd_Pred
>   {
>     /* Something with values for the Lisp_Object predicate ... */
>     ...  
>   };
>
>   struct Lisp_Fwd
>   {
>     enum Lisp_Fwd_Type : 8;
>     enum Lisp_Fwd_Predicate predicate : 8;
>     union
>     {
>       intmax_t *intvar;
>       bool *boolvar;
>       Lisp_Object *objvar;
>       int offset;
>     } u;
>   };
>
> Then removing the Lisp_Fwd_Bool etc. structures that currently exist and
> replace this
>
>   typedef struct { void const *fwdptr; } lispfwd;
>
> which is just a void * with ornaments, with const struct Lisp_Fwd *.

Ah, I see.

>> If we can use two words, then it would perhaps be possible to use
>> pointers to the values directly instead of pointers to fwd objects?
>
> That would make each symbol 1 word bigger.

Unless we can find some unused bits.

> I wouldn't mind, but I
> guess someone might find that questionable, unless we can prove
> some speed advantage or so :-).

Yes, probably.

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Sat, Jun 22 2024, Gerd Möllmann wrote:
>
>>> This would require translating symbols to enums and back.  Or do you
>>> think about something else?
>>
>> I haven't looked at all places. Could you please explain where that is
>> needed?
>
> The symbol is needed in store_symval_forwarding.  It looks in the plist
> for 'choice and 'range.  In addition to the five symbols mentioned in
> the definition of Lisp_Buffer_Objfwd, predicate can also be
> 'overwrite-mode, 'vertical-scroll-bar and 'fraction.  I think those have
> those properties; weird.

I guess then it's better to leave the enum part out. That seems to
become too much work. What an ugly corner.

Re: MPS: Forwording symbols

[Gerd Möllmann]

Gerd Möllmann <gerd.moellmann@gmail.com> writes:

> Helmut Eller <eller.helmut@gmail.com> writes:
>
>> On Sat, Jun 22 2024, Gerd Möllmann wrote:
>>
>>>> This would require translating symbols to enums and back.  Or do you
>>>> think about something else?
>>>
>>> I haven't looked at all places. Could you please explain where that is
>>> needed?
>>
>> The symbol is needed in store_symval_forwarding.  It looks in the plist
>> for 'choice and 'range.  In addition to the five symbols mentioned in
>> the definition of Lisp_Buffer_Objfwd, predicate can also be
>> 'overwrite-mode, 'vertical-scroll-bar and 'fraction.  I think those have
>> those properties; weird.
>
> I guess then it's better to leave the enum part out. That seems to
> become too much work. What an ugly corner.

BTW, the latest HEAD doesn't build with --enable-checking, maybe
something with DEFVAR_NOPRO. I'll try to fix that.

  rm -f bootstrap-emacs.pdmp
  ./temacs --batch  -l loadup --temacs=pbootstrap \
          --bin-dest /Users/gerd/emacs/github/tinker/nextstep/Emacs.app/Contents/MacOS/ --eln-dest /Users/gerd/emacs/github/tinker/nextstep/Emacs.app/Contents/Frameworks/

  alloc.c:6159: Emacs fatal error: assertion failed: staticvec[i] != varaddress

Re: MPS: Forwording symbols

[Gerd Möllmann]

Gerd Möllmann <gerd.moellmann@gmail.com> writes:

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>> Helmut Eller <eller.helmut@gmail.com> writes:
>>
>>> On Sat, Jun 22 2024, Gerd Möllmann wrote:
>>>
>>>>> This would require translating symbols to enums and back.  Or do you
>>>>> think about something else?
>>>>
>>>> I haven't looked at all places. Could you please explain where that is
>>>> needed?
>>>
>>> The symbol is needed in store_symval_forwarding.  It looks in the plist
>>> for 'choice and 'range.  In addition to the five symbols mentioned in
>>> the definition of Lisp_Buffer_Objfwd, predicate can also be
>>> 'overwrite-mode, 'vertical-scroll-bar and 'fraction.  I think those have
>>> those properties; weird.
>>
>> I guess then it's better to leave the enum part out. That seems to
>> become too much work. What an ugly corner.
>
> BTW, the latest HEAD doesn't build with --enable-checking, maybe
> something with DEFVAR_NOPRO. I'll try to fix that.
>
>   rm -f bootstrap-emacs.pdmp
>   ./temacs --batch  -l loadup --temacs=pbootstrap \
>           --bin-dest /Users/gerd/emacs/github/tinker/nextstep/Emacs.app/Contents/MacOS/ --eln-dest /Users/gerd/emacs/github/tinker/nextstep/Emacs.app/Contents/Frameworks/
>
>   alloc.c:6159: Emacs fatal error: assertion failed: staticvec[i] != varaddress

That was in my fork only. Reason is that I need CL packages very early
on to do anything interning symbol, of course. And *emacs-package* and
*package* and so on need to be variables, too, later.

I've made me a DEFVAR_NOPROX for such cases.

And pushed.

Re: MPS: Forwording symbols

[Helmut Eller]

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

On Sat, Jun 22 2024, Gerd Möllmann wrote:

> I was thinking of using 1 struct instead of 4, like so
>
>   enum Lisp_Fwd_Pred
>   {
>     /* Something with values for the Lisp_Object predicate ... */
>     ...  
>   };
>
>   struct Lisp_Fwd
>   {
>     enum Lisp_Fwd_Type : 8;
>     enum Lisp_Fwd_Predicate predicate : 8;
>     union
>     {
>       intmax_t *intvar;
>       bool *boolvar;
>       Lisp_Object *objvar;
>       int offset;
>     } u;
>   };
>
> Then removing the Lisp_Fwd_Bool etc. structures that currently exist and
> replace this
>
>   typedef struct { void const *fwdptr; } lispfwd;
>
> which is just a void * with ornaments, with const struct Lisp_Fwd *.

These patches do this; only that the predicate is still a Lisp_Object.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Introduce-a-struct-Lisp_Fwd.patch --]
[-- Type: text/x-diff, Size: 20407 bytes --]

From 3aae2499b62770364983a75e99c2fca2bba2bee6 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Sun, 23 Jun 2024 06:39:18 +0200
Subject: [PATCH 1/6] Introduce a struct Lisp_Fwd

This contains the type and an union of Lisp_Objfwd, Lisp_Intfwd etc.
lispfwd is now a pointer to a struct Lisp_Fwd; the fwdptr field is gone.

* src/lisp.h (struct Lisp_Fwd): New.
(Lisp_Intfwd, Lisp_Boolfwd, Lisp_Objfwd, Lisp_Buffer_Objfwd)
(Lisp_Kboard_Objfwd): The type is in in Lisp_Fwd.
(lispwfd): Is now a pointer to struct Lisp_Fwd.
(SYMBOL_BLV, SET_SYMBOL_FWD, XFWDTYPE, BUFFER_OBJFWDP): Update
accordingly.
(defvar_lisp, defvar_lisp_nopro, defvar_bool, defvar_int)
(defvar_kboard): These all take now a Lisp_Fwd.
(DEFVAR_LISP, DEFVAR_LISP_NOPRO, DEFVAR_BOOL, DEFVAR_INT)
(DEFVAR_KBOARD): Update for new types.
* src/lread.c (defvar_int, defvar_bool, defvar_lisp_nopro)
(defvar_lisp, defvar_kboard): Update for new types.
* src/pdumper.c (dump_field_fwd, dump_blv): Update accordingly.
* src/buffer.c (DEFVAR_PER_BUFFER, defvar_per_buffer, buffer_local_value)
(set_buffer_internal_1): Update accordingly for new types.
* src/data.c (XBOOLFWD, XKBOARD_OBJFWD, XFIXNUMFWD, XOBJFWD, boundp)
(store_symval_forwarding, swap_in_global_binding)
(swap_in_symval_forwarding, find_symbol_value, set_internal)
(default_value, set_default_internal, make_blv, Fmake_local_variable):
Update accordingly.
---
 src/buffer.c  |  17 +++++----
 src/data.c    |  39 ++++++++++---------
 src/lisp.h    | 104 +++++++++++++++++++++++++++-----------------------
 src/lread.c   |  17 ++++++---
 src/pdumper.c |  10 ++---
 5 files changed, 102 insertions(+), 85 deletions(-)

diff --git a/src/buffer.c b/src/buffer.c
index d864560ec85..e55560b1cd9 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1366,7 +1366,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
 	result = assq_no_quit (variable, BVAR (buf, local_var_alist));
 	if (!NILP (result))
 	  {
-	    if (blv->fwd.fwdptr)
+	    if (blv->fwd)
 	      { /* What binding is loaded right now?  */
 		Lisp_Object current_alist_element = blv->valcell;
 
@@ -2365,7 +2365,7 @@ set_buffer_internal_1 (register struct buffer *b)
 	  Lisp_Object var = XCAR (XCAR (tail));
 	  struct Lisp_Symbol *sym = XSYMBOL (var);
 	  if (sym->u.s.redirect == SYMBOL_LOCALIZED /* Just to be sure.  */
-	      && SYMBOL_BLV (sym)->fwd.fwdptr)
+	      && SYMBOL_BLV (sym)->fwd)
 	    /* Just reference the variable
 	       to cause it to become set for this buffer.  */
 	    Fsymbol_value (var);
@@ -5023,24 +5023,25 @@ #define DEFVAR_PER_BUFFER(lname, vname, predicate_, doc)		\
   {									\
     const Lisp_Object sym = TAG_PTR_INITIALLY (				\
 	Lisp_Symbol, (intptr_t)((i##predicate_) * sizeof *lispsym));	\
-    static const struct Lisp_Buffer_Objfwd bo_fwd = {			\
+    static const struct Lisp_Fwd bo_fwd = {				\
       .type = Lisp_Fwd_Buffer_Obj,					\
-      .offset = offsetof (struct buffer, vname##_),			\
-      .predicate = sym,							\
+      .u.bufobjfwd = { .offset = offsetof (struct buffer, vname##_),	\
+		       .predicate = sym },				\
     };									\
     defvar_per_buffer (&bo_fwd, lname);					\
   }									\
 while (0)
 
 static void
-defvar_per_buffer (const struct Lisp_Buffer_Objfwd *bo_fwd,
-		   const char *namestring)
+defvar_per_buffer (const struct Lisp_Fwd *fwd, const char *namestring)
 {
+  eassert (fwd->type == Lisp_Fwd_Buffer_Obj);
+  const struct Lisp_Buffer_Objfwd *bo_fwd = XBUFFER_OBJFWD (fwd);
   struct Lisp_Symbol *sym = XSYMBOL (intern (namestring));
 
   sym->u.s.declared_special = true;
   sym->u.s.redirect = SYMBOL_FORWARDED;
-  SET_SYMBOL_FWD (sym, bo_fwd);
+  SET_SYMBOL_FWD (sym, fwd);
   XSETSYMBOL (PER_BUFFER_SYMBOL (bo_fwd->offset), sym);
 
   if (PER_BUFFER_IDX (bo_fwd->offset) == 0)
diff --git a/src/data.c b/src/data.c
index efce262f8e6..4a6a247e89e 100644
--- a/src/data.c
+++ b/src/data.c
@@ -59,25 +59,25 @@ OBJFWDP (lispfwd a)
 XBOOLFWD (lispfwd a)
 {
   eassert (BOOLFWDP (a));
-  return a.fwdptr;
+  return &a->u.boolfwd;
 }
 static struct Lisp_Kboard_Objfwd const *
 XKBOARD_OBJFWD (lispfwd a)
 {
   eassert (KBOARD_OBJFWDP (a));
-  return a.fwdptr;
+  return &a->u.kboardobjfwd;
 }
 static struct Lisp_Intfwd const *
 XFIXNUMFWD (lispfwd a)
 {
   eassert (INTFWDP (a));
-  return a.fwdptr;
+  return &a->u.intfwd;
 }
 static struct Lisp_Objfwd const *
 XOBJFWD (lispfwd a)
 {
   eassert (OBJFWDP (a));
-  return a.fwdptr;
+  return &a->u.objfwd;
 }
 
 static void
@@ -731,7 +731,7 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
     case SYMBOL_LOCALIZED:
       {
 	struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
-	if (blv->fwd.fwdptr)
+	if (blv->fwd)
 	  /* In set_internal, we un-forward vars when their value is
 	     set to Qunbound.  */
     	  return Qt;
@@ -1458,8 +1458,9 @@ store_symval_forwarding (lispfwd valcontents, Lisp_Object newval,
 
     case Lisp_Fwd_Buffer_Obj:
       {
-	int offset = XBUFFER_OBJFWD (valcontents)->offset;
-	Lisp_Object predicate = XBUFFER_OBJFWD (valcontents)->predicate;
+	const struct Lisp_Buffer_Objfwd *fwd = XBUFFER_OBJFWD (valcontents);
+	int offset = fwd->offset;
+	Lisp_Object predicate = fwd->predicate;
 
 	if (!NILP (newval) && !NILP (predicate))
 	  {
@@ -1517,12 +1518,12 @@ swap_in_global_binding (struct Lisp_Symbol *symbol)
   struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (symbol);
 
   /* Unload the previously loaded binding.  */
-  if (blv->fwd.fwdptr)
+  if (blv->fwd)
     set_blv_value (blv, do_symval_forwarding (blv->fwd));
 
   /* Select the global binding in the symbol.  */
   set_blv_valcell (blv, blv->defcell);
-  if (blv->fwd.fwdptr)
+  if (blv->fwd)
     store_symval_forwarding (blv->fwd, XCDR (blv->defcell), NULL);
 
   /* Indicate that the global binding is set up now.  */
@@ -1552,7 +1553,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_
 
       /* Unload the previously loaded binding.  */
       tem1 = blv->valcell;
-      if (blv->fwd.fwdptr)
+      if (blv->fwd)
 	set_blv_value (blv, do_symval_forwarding (blv->fwd));
       /* Choose the new binding.  */
       {
@@ -1566,7 +1567,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_
 
       /* Load the new binding.  */
       set_blv_valcell (blv, tem1);
-      if (blv->fwd.fwdptr)
+      if (blv->fwd)
 	store_symval_forwarding (blv->fwd, blv_value (blv), NULL);
     }
 }
@@ -1599,7 +1600,7 @@ find_symbol_value (Lisp_Object symbol)
       {
 	struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
 	swap_in_symval_forwarding (sym, blv);
-	return (blv->fwd.fwdptr
+	return (blv->fwd
 		? do_symval_forwarding (blv->fwd)
 		: blv_value (blv));
       }
@@ -1700,7 +1701,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
 	       We need to unload it, and choose a new binding.  */
 
 	    /* Write out `realvalue' to the old loaded binding.  */
-	    if (blv->fwd.fwdptr)
+	    if (blv->fwd)
 	      set_blv_value (blv, do_symval_forwarding (blv->fwd));
 
 	    /* Find the new binding.  */
@@ -1748,12 +1749,12 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
 	/* Store the new value in the cons cell.  */
 	set_blv_value (blv, newval);
 
-	if (blv->fwd.fwdptr)
+	if (blv->fwd)
 	  {
 	    if (voide)
 	      /* If storing void (making the symbol void), forward only through
 		 buffer-local indicator, not through Lisp_Objfwd, etc.  */
-	      blv->fwd.fwdptr = NULL;
+	      blv->fwd = NULL;
 	    else
 	      store_symval_forwarding (blv->fwd, newval,
 				       BUFFERP (where)
@@ -1944,7 +1945,7 @@ default_value (Lisp_Object symbol)
 	   But the `realvalue' slot may be more up to date, since
 	   ordinary setq stores just that slot.  So use that.  */
 	struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
-	if (blv->fwd.fwdptr && EQ (blv->valcell, blv->defcell))
+	if (blv->fwd && EQ (blv->valcell, blv->defcell))
 	  return do_symval_forwarding (blv->fwd);
 	else
 	  return XCDR (blv->defcell);
@@ -2039,7 +2040,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
 	XSETCDR (blv->defcell, value);
 
 	/* If the default binding is now loaded, set the REALVALUE slot too.  */
-	if (blv->fwd.fwdptr && EQ (blv->defcell, blv->valcell))
+	if (blv->fwd && EQ (blv->defcell, blv->valcell))
 	  store_symval_forwarding (blv->fwd, value, NULL);
         return;
       }
@@ -2136,7 +2137,7 @@ make_blv (struct Lisp_Symbol *sym, bool forwarded,
   if (forwarded)
     blv->fwd = valcontents.fwd;
   else
-    blv->fwd.fwdptr = NULL;
+    blv->fwd = NULL;
   set_blv_where (blv, Qnil);
   blv->local_if_set = 0;
   set_blv_defcell (blv, tem);
@@ -2311,7 +2312,7 @@ DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable,
          Otherwise, if C code modifies the variable before we load the
          binding in, then that new value would clobber the default binding
          the next time we unload it.  See bug#34318.  */
-      if (blv->fwd.fwdptr)
+      if (blv->fwd)
         swap_in_symval_forwarding (sym, blv);
     }
 
diff --git a/src/lisp.h b/src/lisp.h
index f85dd348aa3..3ce5e2b4d66 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -799,7 +799,7 @@ #define XUNTAG(a, type, ctype) \
    union of the possible values (struct Lisp_Objfwd, struct
    Lisp_Intfwd, etc.).  The pointer is packaged inside a struct to
    help static checking.  */
-typedef struct { void const *fwdptr; } lispfwd;
+typedef const struct Lisp_Fwd *lispfwd;
 \f
 /* Interned state of a symbol.  */
 
@@ -2358,7 +2358,7 @@ SYMBOL_BLV (struct Lisp_Symbol *sym)
 INLINE lispfwd
 SYMBOL_FWD (struct Lisp_Symbol *sym)
 {
-  eassume (sym->u.s.redirect == SYMBOL_FORWARDED && sym->u.s.val.fwd.fwdptr);
+  eassume (sym->u.s.redirect == SYMBOL_FORWARDED && sym->u.s.val.fwd);
   return sym->u.s.val.fwd;
 }
 
@@ -2382,10 +2382,10 @@ SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v)
   sym->u.s.val.blv = v;
 }
 INLINE void
-SET_SYMBOL_FWD (struct Lisp_Symbol *sym, void const *v)
+SET_SYMBOL_FWD (struct Lisp_Symbol *sym, lispfwd fwd)
 {
-  eassume (sym->u.s.redirect == SYMBOL_FORWARDED && v);
-  sym->u.s.val.fwd.fwdptr = v;
+  eassume (sym->u.s.redirect == SYMBOL_FORWARDED && fwd);
+  sym->u.s.val.fwd = fwd;
 }
 
 INLINE Lisp_Object
@@ -3121,7 +3121,6 @@ #define INT_TO_INTEGER(expr) \
    specified int variable.  */
 struct Lisp_Intfwd
   {
-    enum Lisp_Fwd_Type type;	/* = Lisp_Fwd_Int */
     intmax_t *intvar;
   };
 
@@ -3131,7 +3130,6 @@ #define INT_TO_INTEGER(expr) \
    nil if it is false.  */
 struct Lisp_Boolfwd
   {
-    enum Lisp_Fwd_Type type;	/* = Lisp_Fwd_Bool */
     bool *boolvar;
   };
 
@@ -3141,7 +3139,6 @@ #define INT_TO_INTEGER(expr) \
    specified variable.  */
 struct Lisp_Objfwd
   {
-    enum Lisp_Fwd_Type type;	/* = Lisp_Fwd_Obj */
     Lisp_Object *objvar;
   };
 
@@ -3149,7 +3146,6 @@ #define INT_TO_INTEGER(expr) \
    current buffer.  Value is byte index of slot within buffer.  */
 struct Lisp_Buffer_Objfwd
   {
-    enum Lisp_Fwd_Type type;	/* = Lisp_Fwd_Buffer_Obj */
     int offset;
     /* One of Qnil, Qintegerp, Qsymbolp, Qstringp, Qfloatp or Qnumberp.  */
     Lisp_Object predicate;
@@ -3202,15 +3198,26 @@ #define INT_TO_INTEGER(expr) \
    current kboard.  */
 struct Lisp_Kboard_Objfwd
   {
-    enum Lisp_Fwd_Type type;	/* = Lisp_Fwd_Kboard_Obj */
     int offset;
   };
 
+struct Lisp_Fwd
+{
+  enum Lisp_Fwd_Type type;
+  union
+  {
+    struct Lisp_Intfwd intfwd;
+    struct Lisp_Boolfwd boolfwd;
+    struct Lisp_Objfwd objfwd;
+    struct Lisp_Buffer_Objfwd bufobjfwd;
+    struct Lisp_Kboard_Objfwd kboardobjfwd;
+  } u;
+};
+
 INLINE enum Lisp_Fwd_Type
 XFWDTYPE (lispfwd a)
 {
-  enum Lisp_Fwd_Type const *p = a.fwdptr;
-  return *p;
+  return a->type;
 }
 
 INLINE bool
@@ -3223,7 +3230,7 @@ BUFFER_OBJFWDP (lispfwd a)
 XBUFFER_OBJFWD (lispfwd a)
 {
   eassert (BUFFER_OBJFWDP (a));
-  return a.fwdptr;
+  return &a->u.bufobjfwd;
 }
 
 INLINE bool
@@ -3559,11 +3566,11 @@ call0 (Lisp_Object fn)
   return Ffuncall (1, &fn);
 }
 
-extern void defvar_lisp (struct Lisp_Objfwd const *, char const *);
-extern void defvar_lisp_nopro (struct Lisp_Objfwd const *, char const *);
-extern void defvar_bool (struct Lisp_Boolfwd const *, char const *);
-extern void defvar_int (struct Lisp_Intfwd const *, char const *);
-extern void defvar_kboard (struct Lisp_Kboard_Objfwd const *, char const *);
+extern void defvar_lisp (struct Lisp_Fwd const *, char const *);
+extern void defvar_lisp_nopro (struct Lisp_Fwd const *, char const *);
+extern void defvar_bool (struct Lisp_Fwd const *, char const *);
+extern void defvar_int (struct Lisp_Fwd const *, char const *);
+extern void defvar_kboard (struct Lisp_Fwd const *, char const *);
 
 /* Macros we use to define forwarded Lisp variables.
    These are used in the syms_of_FILENAME functions.
@@ -3582,18 +3589,18 @@ call0 (Lisp_Object fn)
    All C code uses the `cons_cells_consed' name.  This is all done
    this way to support indirection for multi-threaded Emacs.  */
 
-#define DEFVAR_LISP(lname, vname, doc)		\
-  do {						\
-    static struct Lisp_Objfwd const o_fwd	\
-      = {Lisp_Fwd_Obj, &globals.f_##vname};	\
-    defvar_lisp (&o_fwd, lname);		\
+#define DEFVAR_LISP(lname, vname, doc)				\
+  do {								\
+    static struct Lisp_Fwd const o_fwd				\
+      = {Lisp_Fwd_Obj, .u.objfwd = {&globals.f_##vname}};	\
+    defvar_lisp (&o_fwd, lname);				\
   } while (false)
 #ifdef HAVE_MPS
-#define DEFVAR_LISP_NOPRO(lname, vname, doc)	\
-  do {						\
-    static struct Lisp_Objfwd const o_fwd	\
-      = {Lisp_Fwd_Obj, &globals.f_##vname};	\
-    defvar_lisp (&o_fwd, lname);		\
+#define DEFVAR_LISP_NOPRO(lname, vname, doc)			\
+  do {								\
+    static struct Lisp_Fwd const o_fwd				\
+      = {Lisp_Fwd_Obj, .u.objfwd = {&globals.f_##vname}};	\
+    defvar_lisp (&o_fwd, lname);				\
   } while (false)
 #define DEFVAR_LISP_NOPROX(lname, vname, doc)	\
   do {						\
@@ -3602,11 +3609,11 @@ #define DEFVAR_LISP_NOPROX(lname, vname, doc)	\
     defvar_lisp_nopro (&o_fwd, lname);		\
   } while (false)
 #else
-#define DEFVAR_LISP_NOPRO(lname, vname, doc)	\
-  do {						\
-  static struct Lisp_Objfwd const o_fwd		\
-    = {Lisp_Fwd_Obj, &globals.f_##vname};	\
-    defvar_lisp_nopro (&o_fwd, lname);		\
+#define DEFVAR_LISP_NOPRO(lname, vname, doc)		\
+  do {							\
+  static struct Lisp_Fwd const o_fwd			\
+    = {Lisp_Fwd_Obj, .u.objfwd = {&globals.f_##vname}};	\
+    defvar_lisp_nopro (&o_fwd, lname);			\
   } while (false)
 #define DEFVAR_LISP_NOPROX(lname, vname, doc)	\
   do {						\
@@ -3615,25 +3622,28 @@ #define DEFVAR_LISP_NOPROX(lname, vname, doc)	\
     defvar_lisp_nopro (&o_fwd, lname);		\
   } while (false)
 #endif
-#define DEFVAR_BOOL(lname, vname, doc)		\
-  do {						\
-    static struct Lisp_Boolfwd const b_fwd	\
-      = {Lisp_Fwd_Bool, &globals.f_##vname};	\
-    defvar_bool (&b_fwd, lname);		\
+#define DEFVAR_BOOL(lname, vname, doc)				\
+  do {								\
+    static struct Lisp_Fwd const b_fwd				\
+      = {Lisp_Fwd_Bool, .u.boolfwd = {&globals.f_##vname}};	\
+    defvar_bool (&b_fwd, lname);				\
   } while (false)
-#define DEFVAR_INT(lname, vname, doc)		\
-  do {						\
-    static struct Lisp_Intfwd const i_fwd	\
-      = {Lisp_Fwd_Int, &globals.f_##vname};	\
-    defvar_int (&i_fwd, lname);			\
+#define DEFVAR_INT(lname, vname, doc)				\
+  do {								\
+    static struct Lisp_Fwd const i_fwd				\
+      = {Lisp_Fwd_Int, .u.intfwd = {&globals.f_##vname}};	\
+    defvar_int (&i_fwd, lname);					\
   } while (false)
 
 #define DEFVAR_KBOARD(lname, vname, doc)			\
-  do {								\
-    static struct Lisp_Kboard_Objfwd const ko_fwd		\
-      = {Lisp_Fwd_Kboard_Obj, offsetof (KBOARD, vname##_)};	\
+do								\
+  {								\
+    static struct Lisp_Fwd const ko_fwd				\
+	= { Lisp_Fwd_Kboard_Obj,				\
+	    .u.kboardobjfwd = {offsetof (KBOARD, vname##_)}};	\
     defvar_kboard (&ko_fwd, lname);				\
-  } while (false)
+  }								\
+while (false)
 
 \f
 /* Elisp uses multiple stacks:
diff --git a/src/lread.c b/src/lread.c
index 068ae1a4e4b..db3f520c020 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -5466,8 +5466,9 @@ defsubr (union Aligned_Lisp_Subr *aname)
    C variable of type intmax_t.  Sample call (with "xx" to fool make-docfile):
    DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation");  */
 void
-defvar_int (struct Lisp_Intfwd const *i_fwd, char const *namestring)
+defvar_int (struct Lisp_Fwd const *i_fwd, char const *namestring)
 {
+  eassert (i_fwd->type == Lisp_Fwd_Int);
   Lisp_Object sym = intern_c_string (namestring);
   XBARE_SYMBOL (sym)->u.s.declared_special = true;
   XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
@@ -5476,8 +5477,9 @@ defvar_int (struct Lisp_Intfwd const *i_fwd, char const *namestring)
 
 /* Similar but define a variable whose value is t if 1, nil if 0.  */
 void
-defvar_bool (struct Lisp_Boolfwd const *b_fwd, char const *namestring)
+defvar_bool (struct Lisp_Fwd const *b_fwd, char const *namestring)
 {
+  eassert (b_fwd->type == Lisp_Fwd_Bool);
   Lisp_Object sym = intern_c_string (namestring);
   XBARE_SYMBOL (sym)->u.s.declared_special = true;
   XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
@@ -5491,8 +5493,9 @@ defvar_bool (struct Lisp_Boolfwd const *b_fwd, char const *namestring)
    gc-marked for some other reason, since marking the same slot twice
    can cause trouble with strings.  */
 void
-defvar_lisp_nopro (struct Lisp_Objfwd const *o_fwd, char const *namestring)
+defvar_lisp_nopro (struct Lisp_Fwd const *o_fwd, char const *namestring)
 {
+  eassert (o_fwd->type == Lisp_Fwd_Obj);
   Lisp_Object sym = intern_c_string (namestring);
   XBARE_SYMBOL (sym)->u.s.declared_special = true;
   XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
@@ -5500,18 +5503,20 @@ defvar_lisp_nopro (struct Lisp_Objfwd const *o_fwd, char const *namestring)
 }
 
 void
-defvar_lisp (struct Lisp_Objfwd const *o_fwd, char const *namestring)
+defvar_lisp (struct Lisp_Fwd const *o_fwd, char const *namestring)
 {
+  eassert (o_fwd->type == Lisp_Fwd_Obj);
   defvar_lisp_nopro (o_fwd, namestring);
-  staticpro (o_fwd->objvar);
+  staticpro (o_fwd->u.objfwd.objvar);
 }
 
 /* Similar but define a variable whose value is the Lisp Object stored
    at a particular offset in the current kboard object.  */
 
 void
-defvar_kboard (struct Lisp_Kboard_Objfwd const *ko_fwd, char const *namestring)
+defvar_kboard (struct Lisp_Fwd const *ko_fwd, char const *namestring)
 {
+  eassert (ko_fwd->type == Lisp_Fwd_Kboard_Obj);
   Lisp_Object sym = intern_c_string (namestring);
   XBARE_SYMBOL (sym)->u.s.declared_special = true;
   XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
diff --git a/src/pdumper.c b/src/pdumper.c
index 21343d42082..d8e21b569f1 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2362,24 +2362,24 @@ dump_float (struct dump_context *ctx, const struct Lisp_Float *lfloat)
 dump_field_fwd (struct dump_context *ctx, void *out, const void *in_start,
 		const lispfwd *in_field)
 {
-  dump_field_emacs_ptr (ctx, out, in_start, &in_field->fwdptr);
+  dump_field_emacs_ptr (ctx, out, in_start, in_field);
   switch (XFWDTYPE (*in_field))
     {
     case Lisp_Fwd_Int:
       {
-	const struct Lisp_Intfwd *fwd = in_field->fwdptr;
+	const struct Lisp_Intfwd *fwd = &(*in_field)->u.intfwd;
 	dump_emacs_reloc_immediate_intmax_t (ctx, fwd->intvar, *fwd->intvar);
       }
       return;
     case Lisp_Fwd_Bool:
       {
-	const struct Lisp_Boolfwd *fwd = in_field->fwdptr;
+	const struct Lisp_Boolfwd *fwd = &(*in_field)->u.boolfwd;
 	dump_emacs_reloc_immediate_bool (ctx, fwd->boolvar, *fwd->boolvar);
       }
       return;
     case Lisp_Fwd_Obj:
       {
-	const struct Lisp_Objfwd *fwd = in_field->fwdptr;
+	const struct Lisp_Objfwd *fwd =  &(*in_field)->u.objfwd;
 	if (NILP (Fgethash (dump_off_to_lisp (emacs_offset (fwd->objvar)),
 			    ctx->staticpro_table, Qnil)))
 	  dump_emacs_reloc_to_lv (ctx, fwd->objvar, *fwd->objvar);
@@ -2403,7 +2403,7 @@ dump_blv (struct dump_context *ctx,
   dump_object_start (ctx, blv, IGC_OBJ_BLV, &out, sizeof (out));
   DUMP_FIELD_COPY (&out, blv, local_if_set);
   DUMP_FIELD_COPY (&out, blv, found);
-  if (blv->fwd.fwdptr)
+  if (blv->fwd)
     dump_field_fwd (ctx, &out, blv, &blv->fwd);
   dump_field_lv (ctx, &out, blv, &blv->where, WEIGHT_NORMAL);
   dump_field_lv (ctx, &out, blv, &blv->defcell, WEIGHT_STRONG);
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Remove-struct-Lisp_Intfwd.patch --]
[-- Type: text/x-diff, Size: 3867 bytes --]

From 67cb8dd5e597e3725f7adfccadc14ac18f2ec241 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Sun, 23 Jun 2024 11:25:35 +0200
Subject: [PATCH 2/6] Remove struct Lisp_Intfwd

It was a struct with a single field.

* src/lisp.h (struct Lisp_Intfwd): Deleted.
(struct Lisp_Fwd): Add an intvar field instead.
(DEFVAR_INT): Update accordingly.
* src/data.c (XINTVAR): Updated and renamed from XFIXNUMFWD.
(do_symval_forwarding, store_symval_forwarding): Use it.
---
 src/data.c    | 10 +++++-----
 src/lisp.h    | 22 ++++++----------------
 src/pdumper.c |  4 ++--
 3 files changed, 13 insertions(+), 23 deletions(-)

diff --git a/src/data.c b/src/data.c
index 4a6a247e89e..9b3984d80e6 100644
--- a/src/data.c
+++ b/src/data.c
@@ -67,11 +67,11 @@ XKBOARD_OBJFWD (lispfwd a)
   eassert (KBOARD_OBJFWDP (a));
   return &a->u.kboardobjfwd;
 }
-static struct Lisp_Intfwd const *
-XFIXNUMFWD (lispfwd a)
+static intmax_t *
+XINTVAR (lispfwd a)
 {
   eassert (INTFWDP (a));
-  return &a->u.intfwd;
+  return a->u.intvar;
 }
 static struct Lisp_Objfwd const *
 XOBJFWD (lispfwd a)
@@ -1333,7 +1333,7 @@ do_symval_forwarding (lispfwd valcontents)
   switch (XFWDTYPE (valcontents))
     {
     case Lisp_Fwd_Int:
-      return make_int (*XFIXNUMFWD (valcontents)->intvar);
+      return make_int (*XINTVAR (valcontents));
 
     case Lisp_Fwd_Bool:
       return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
@@ -1419,7 +1419,7 @@ store_symval_forwarding (lispfwd valcontents, Lisp_Object newval,
 	CHECK_INTEGER (newval);
 	if (! integer_to_intmax (newval, &i))
 	  xsignal1 (Qoverflow_error, newval);
-	*XFIXNUMFWD (valcontents)->intvar = i;
+	*XINTVAR (valcontents) = i;
       }
       break;
 
diff --git a/src/lisp.h b/src/lisp.h
index 3ce5e2b4d66..bfbf2447635 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3115,15 +3115,6 @@ #define INT_TO_INTEGER(expr) \
   (EXPR_SIGNED (expr) ? make_int (expr) : make_uint (expr))
 
 \f
-/* Forwarding pointer to an int variable.
-   This is allowed only in the value cell of a symbol,
-   and it means that the symbol's value really lives in the
-   specified int variable.  */
-struct Lisp_Intfwd
-  {
-    intmax_t *intvar;
-  };
-
 /* Boolean forwarding pointer to an int variable.
    This is like Lisp_Intfwd except that the ostensible
    "value" of the symbol is t if the bool variable is true,
@@ -3206,7 +3197,7 @@ #define INT_TO_INTEGER(expr) \
   enum Lisp_Fwd_Type type;
   union
   {
-    struct Lisp_Intfwd intfwd;
+    intmax_t *intvar;
     struct Lisp_Boolfwd boolfwd;
     struct Lisp_Objfwd objfwd;
     struct Lisp_Buffer_Objfwd bufobjfwd;
@@ -3628,13 +3619,12 @@ #define DEFVAR_BOOL(lname, vname, doc)				\
       = {Lisp_Fwd_Bool, .u.boolfwd = {&globals.f_##vname}};	\
     defvar_bool (&b_fwd, lname);				\
   } while (false)
-#define DEFVAR_INT(lname, vname, doc)				\
-  do {								\
-    static struct Lisp_Fwd const i_fwd				\
-      = {Lisp_Fwd_Int, .u.intfwd = {&globals.f_##vname}};	\
-    defvar_int (&i_fwd, lname);					\
+#define DEFVAR_INT(lname, vname, doc)			\
+  do {							\
+    static struct Lisp_Fwd const i_fwd			\
+      = {Lisp_Fwd_Int, .u.intvar = &globals.f_##vname};	\
+    defvar_int (&i_fwd, lname);				\
   } while (false)
-
 #define DEFVAR_KBOARD(lname, vname, doc)			\
 do								\
   {								\
diff --git a/src/pdumper.c b/src/pdumper.c
index d8e21b569f1..84175ea9a2c 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2367,8 +2367,8 @@ dump_field_fwd (struct dump_context *ctx, void *out, const void *in_start,
     {
     case Lisp_Fwd_Int:
       {
-	const struct Lisp_Intfwd *fwd = &(*in_field)->u.intfwd;
-	dump_emacs_reloc_immediate_intmax_t (ctx, fwd->intvar, *fwd->intvar);
+	const intmax_t *intvar = (*in_field)->u.intvar;
+	dump_emacs_reloc_immediate_intmax_t (ctx, intvar, *intvar);
       }
       return;
     case Lisp_Fwd_Bool:
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Remove-struct-Lisp_Boolfwd.patch --]
[-- Type: text/x-diff, Size: 3547 bytes --]

From 26b43b4b58e62ab2c6c0ce438d9b17a2abce0ef9 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Sun, 23 Jun 2024 11:37:58 +0200
Subject: [PATCH 3/6] Remove struct Lisp_Boolfwd

* src/lisp.h (struct Lisp Boolfwd): Deleted
(struct Lisp_Fwd): Replaced it with a boolvar field.
(DEFVAR_BOOL): Update.
* src/data.c (XBOOLVAR): Renamed from XBOOLFWD.
(do_symval_forwarding, store_symval_forwarding): Use it.
* src/pdumper.c (dump_field_fwd): Use boolvar field.
---
 src/data.c    | 10 +++++-----
 src/lisp.h    | 13 ++-----------
 src/pdumper.c |  4 ++--
 3 files changed, 9 insertions(+), 18 deletions(-)

diff --git a/src/data.c b/src/data.c
index 9b3984d80e6..292a2f2cf06 100644
--- a/src/data.c
+++ b/src/data.c
@@ -55,11 +55,11 @@ OBJFWDP (lispfwd a)
   return XFWDTYPE (a) == Lisp_Fwd_Obj;
 }
 
-static struct Lisp_Boolfwd const *
-XBOOLFWD (lispfwd a)
+static bool *
+XBOOLVAR (lispfwd a)
 {
   eassert (BOOLFWDP (a));
-  return &a->u.boolfwd;
+  return a->u.boolvar;
 }
 static struct Lisp_Kboard_Objfwd const *
 XKBOARD_OBJFWD (lispfwd a)
@@ -1336,7 +1336,7 @@ do_symval_forwarding (lispfwd valcontents)
       return make_int (*XINTVAR (valcontents));
 
     case Lisp_Fwd_Bool:
-      return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
+      return (*XBOOLVAR (valcontents) ? Qt : Qnil);
 
     case Lisp_Fwd_Obj:
       return *XOBJFWD (valcontents)->objvar;
@@ -1424,7 +1424,7 @@ store_symval_forwarding (lispfwd valcontents, Lisp_Object newval,
       break;
 
     case Lisp_Fwd_Bool:
-      *XBOOLFWD (valcontents)->boolvar = !NILP (newval);
+      *XBOOLVAR (valcontents) = !NILP (newval);
       break;
 
     case Lisp_Fwd_Obj:
diff --git a/src/lisp.h b/src/lisp.h
index bfbf2447635..a31079ad4bd 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3115,15 +3115,6 @@ #define INT_TO_INTEGER(expr) \
   (EXPR_SIGNED (expr) ? make_int (expr) : make_uint (expr))
 
 \f
-/* Boolean forwarding pointer to an int variable.
-   This is like Lisp_Intfwd except that the ostensible
-   "value" of the symbol is t if the bool variable is true,
-   nil if it is false.  */
-struct Lisp_Boolfwd
-  {
-    bool *boolvar;
-  };
-
 /* Forwarding pointer to a Lisp_Object variable.
    This is allowed only in the value cell of a symbol,
    and it means that the symbol's value really lives in the
@@ -3198,7 +3189,7 @@ #define INT_TO_INTEGER(expr) \
   union
   {
     intmax_t *intvar;
-    struct Lisp_Boolfwd boolfwd;
+    bool *boolvar;
     struct Lisp_Objfwd objfwd;
     struct Lisp_Buffer_Objfwd bufobjfwd;
     struct Lisp_Kboard_Objfwd kboardobjfwd;
@@ -3616,7 +3607,7 @@ #define DEFVAR_LISP_NOPROX(lname, vname, doc)	\
 #define DEFVAR_BOOL(lname, vname, doc)				\
   do {								\
     static struct Lisp_Fwd const b_fwd				\
-      = {Lisp_Fwd_Bool, .u.boolfwd = {&globals.f_##vname}};	\
+      = {Lisp_Fwd_Bool, .u.boolvar = &globals.f_##vname};	\
     defvar_bool (&b_fwd, lname);				\
   } while (false)
 #define DEFVAR_INT(lname, vname, doc)			\
diff --git a/src/pdumper.c b/src/pdumper.c
index 84175ea9a2c..7bb7ecc7a07 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2373,8 +2373,8 @@ dump_field_fwd (struct dump_context *ctx, void *out, const void *in_start,
       return;
     case Lisp_Fwd_Bool:
       {
-	const struct Lisp_Boolfwd *fwd = &(*in_field)->u.boolfwd;
-	dump_emacs_reloc_immediate_bool (ctx, fwd->boolvar, *fwd->boolvar);
+	const bool *boolvar = (*in_field)->u.boolvar;
+	dump_emacs_reloc_immediate_bool (ctx, boolvar, *boolvar);
       }
       return;
     case Lisp_Fwd_Obj:
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-Remove-struct-Lisp_Objfwd.patch --]
[-- Type: text/x-diff, Size: 6707 bytes --]

From 26e61c573801f3fde32446c704b2c2b72da6fdc7 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Sun, 23 Jun 2024 15:34:55 +0200
Subject: [PATCH 4/6] Remove struct Lisp_Objfwd

* src/lisp.h (struct Lisp_Objfwd): Deleted.
(struct Lisp_Fwd): Replace it with objvar field.
(DEFVAR_LISP, DEFVAR_LISP_NOPRO, DEFVAR_LISP_NOPROX): Use the field.
* src/lread.c (defvar_lisp): Updated as needed.
* src/pdumper.c (dump_field_fwd): Use the field.
* src/data.c (XOBJVAR): Renamed and updated from XOBJFWD.
(do_symval_forwarding, store_symval_forwarding): Use it.
---
 src/data.c    | 16 ++++++++--------
 src/lisp.h    | 53 +++++++++++++++++++++------------------------------
 src/lread.c   |  2 +-
 src/pdumper.c |  6 +++---
 4 files changed, 34 insertions(+), 43 deletions(-)

diff --git a/src/data.c b/src/data.c
index 292a2f2cf06..af4802f54a0 100644
--- a/src/data.c
+++ b/src/data.c
@@ -73,11 +73,11 @@ XINTVAR (lispfwd a)
   eassert (INTFWDP (a));
   return a->u.intvar;
 }
-static struct Lisp_Objfwd const *
-XOBJFWD (lispfwd a)
+static Lisp_Object *
+XOBJVAR (lispfwd a)
 {
   eassert (OBJFWDP (a));
-  return &a->u.objfwd;
+  return a->u.objvar;
 }
 
 static void
@@ -1339,7 +1339,7 @@ do_symval_forwarding (lispfwd valcontents)
       return (*XBOOLVAR (valcontents) ? Qt : Qnil);
 
     case Lisp_Fwd_Obj:
-      return *XOBJFWD (valcontents)->objvar;
+      return *XOBJVAR (valcontents);
 
     case Lisp_Fwd_Buffer_Obj:
       return per_buffer_value (current_buffer,
@@ -1428,16 +1428,16 @@ store_symval_forwarding (lispfwd valcontents, Lisp_Object newval,
       break;
 
     case Lisp_Fwd_Obj:
-      *XOBJFWD (valcontents)->objvar = newval;
+      *XOBJVAR (valcontents) = newval;
 
       /* If this variable is a default for something stored
 	 in the buffer itself, such as default-fill-column,
 	 find the buffers that don't have local values for it
 	 and update them.  */
-      if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults
-	  && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1))
+      if (XOBJVAR (valcontents) > (Lisp_Object *) &buffer_defaults
+	  && XOBJVAR (valcontents) < (Lisp_Object *) (&buffer_defaults + 1))
 	{
-	  int offset = ((char *) XOBJFWD (valcontents)->objvar
+	  int offset = ((char *) XOBJVAR (valcontents)
 			- (char *) &buffer_defaults);
 	  int idx = PER_BUFFER_IDX (offset);
 
diff --git a/src/lisp.h b/src/lisp.h
index a31079ad4bd..d0eef3e4aa1 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3115,15 +3115,6 @@ #define INT_TO_INTEGER(expr) \
   (EXPR_SIGNED (expr) ? make_int (expr) : make_uint (expr))
 
 \f
-/* Forwarding pointer to a Lisp_Object variable.
-   This is allowed only in the value cell of a symbol,
-   and it means that the symbol's value really lives in the
-   specified variable.  */
-struct Lisp_Objfwd
-  {
-    Lisp_Object *objvar;
-  };
-
 /* Like Lisp_Objfwd except that value lives in a slot in the
    current buffer.  Value is byte index of slot within buffer.  */
 struct Lisp_Buffer_Objfwd
@@ -3190,7 +3181,7 @@ #define INT_TO_INTEGER(expr) \
   {
     intmax_t *intvar;
     bool *boolvar;
-    struct Lisp_Objfwd objfwd;
+    Lisp_Object *objvar;
     struct Lisp_Buffer_Objfwd bufobjfwd;
     struct Lisp_Kboard_Objfwd kboardobjfwd;
   } u;
@@ -3571,37 +3562,37 @@ call0 (Lisp_Object fn)
    All C code uses the `cons_cells_consed' name.  This is all done
    this way to support indirection for multi-threaded Emacs.  */
 
-#define DEFVAR_LISP(lname, vname, doc)				\
-  do {								\
-    static struct Lisp_Fwd const o_fwd				\
-      = {Lisp_Fwd_Obj, .u.objfwd = {&globals.f_##vname}};	\
-    defvar_lisp (&o_fwd, lname);				\
+#define DEFVAR_LISP(lname, vname, doc)			\
+  do {							\
+    static struct Lisp_Fwd const o_fwd			\
+      = {Lisp_Fwd_Obj, .u.objvar = &globals.f_##vname};	\
+    defvar_lisp (&o_fwd, lname);			\
   } while (false)
 #ifdef HAVE_MPS
-#define DEFVAR_LISP_NOPRO(lname, vname, doc)			\
-  do {								\
-    static struct Lisp_Fwd const o_fwd				\
-      = {Lisp_Fwd_Obj, .u.objfwd = {&globals.f_##vname}};	\
-    defvar_lisp (&o_fwd, lname);				\
+#define DEFVAR_LISP_NOPRO(lname, vname, doc)		\
+  do {							\
+    static struct Lisp_Fwd const o_fwd			\
+      = {Lisp_Fwd_Obj, .u.objvar = &globals.f_##vname};	\
+    defvar_lisp (&o_fwd, lname);			\
   } while (false)
-#define DEFVAR_LISP_NOPROX(lname, vname, doc)	\
-  do {						\
-  static struct Lisp_Objfwd const o_fwd		\
-    = {Lisp_Fwd_Obj, &globals.f_##vname};	\
-    defvar_lisp_nopro (&o_fwd, lname);		\
+#define DEFVAR_LISP_NOPROX(lname, vname, doc)		\
+  do {							\
+  static struct Lisp_Fwd const o_fwd			\
+    = {Lisp_Fwd_Obj, .u.objvar = &globals.f_##vname};	\
+    defvar_lisp_nopro (&o_fwd, lname);			\
   } while (false)
 #else
 #define DEFVAR_LISP_NOPRO(lname, vname, doc)		\
   do {							\
   static struct Lisp_Fwd const o_fwd			\
-    = {Lisp_Fwd_Obj, .u.objfwd = {&globals.f_##vname}};	\
+    = {Lisp_Fwd_Obj, .u.objvar = &globals.f_##vname};	\
     defvar_lisp_nopro (&o_fwd, lname);			\
   } while (false)
-#define DEFVAR_LISP_NOPROX(lname, vname, doc)	\
-  do {						\
-  static struct Lisp_Objfwd const o_fwd		\
-    = {Lisp_Fwd_Obj, &globals.f_##vname};	\
-    defvar_lisp_nopro (&o_fwd, lname);		\
+#define DEFVAR_LISP_NOPROX(lname, vname, doc)		\
+  do {							\
+  static struct Lisp_Fwd const o_fwd			\
+    = {Lisp_Fwd_Obj, u.objvar = &globals.f_##vname};	\
+    defvar_lisp_nopro (&o_fwd, lname);			\
   } while (false)
 #endif
 #define DEFVAR_BOOL(lname, vname, doc)				\
diff --git a/src/lread.c b/src/lread.c
index db3f520c020..188922516ea 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -5507,7 +5507,7 @@ defvar_lisp (struct Lisp_Fwd const *o_fwd, char const *namestring)
 {
   eassert (o_fwd->type == Lisp_Fwd_Obj);
   defvar_lisp_nopro (o_fwd, namestring);
-  staticpro (o_fwd->u.objfwd.objvar);
+  staticpro (o_fwd->u.objvar);
 }
 
 /* Similar but define a variable whose value is the Lisp Object stored
diff --git a/src/pdumper.c b/src/pdumper.c
index 7bb7ecc7a07..d975c65ed59 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2379,10 +2379,10 @@ dump_field_fwd (struct dump_context *ctx, void *out, const void *in_start,
       return;
     case Lisp_Fwd_Obj:
       {
-	const struct Lisp_Objfwd *fwd =  &(*in_field)->u.objfwd;
-	if (NILP (Fgethash (dump_off_to_lisp (emacs_offset (fwd->objvar)),
+	const Lisp_Object *objvar =  (*in_field)->u.objvar;
+	if (NILP (Fgethash (dump_off_to_lisp (emacs_offset (objvar)),
 			    ctx->staticpro_table, Qnil)))
-	  dump_emacs_reloc_to_lv (ctx, fwd->objvar, *fwd->objvar);
+	  dump_emacs_reloc_to_lv (ctx, objvar, *objvar);
       }
       return;
     case Lisp_Fwd_Kboard_Obj:
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0005-Remove-struct-Lisp_Kboard_Objfwd.patch --]
[-- Type: text/x-diff, Size: 3234 bytes --]

From 6d42135f0ef647a41de26577dc62c3aca23c0865 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Sun, 23 Jun 2024 16:36:13 +0200
Subject: [PATCH 5/6] Remove struct Lisp_Kboard_Objfwd

* src/lisp.h (struct Lisp_Kboard_Objfwd): Deleted ...
(struct Lisp_Fwd): ... replaced with field kbdoffset.
(DEFVAR_KBOARD): Use new field.
* src/data.c (XKBOARD_OFFSET): Renamed from XKBOARD_OBJFWD.
(do_symval_forwarding, store_symval_forwarding
(set_default_internal): Use it .
---
 src/data.c | 12 ++++++------
 src/lisp.h | 17 ++++-------------
 2 files changed, 10 insertions(+), 19 deletions(-)

diff --git a/src/data.c b/src/data.c
index af4802f54a0..9f344474692 100644
--- a/src/data.c
+++ b/src/data.c
@@ -61,11 +61,11 @@ XBOOLVAR (lispfwd a)
   eassert (BOOLFWDP (a));
   return a->u.boolvar;
 }
-static struct Lisp_Kboard_Objfwd const *
-XKBOARD_OBJFWD (lispfwd a)
+static int
+XKBOARD_OFFSET (lispfwd a)
 {
   eassert (KBOARD_OBJFWDP (a));
-  return &a->u.kboardobjfwd;
+  return a->u.kbdoffset;
 }
 static intmax_t *
 XINTVAR (lispfwd a)
@@ -1346,7 +1346,7 @@ do_symval_forwarding (lispfwd valcontents)
 			       XBUFFER_OBJFWD (valcontents)->offset);
 
     case Lisp_Fwd_Kboard_Obj:
-      return *(Lisp_Object *) (XKBOARD_OBJFWD (valcontents)->offset
+      return *(Lisp_Object *) (XKBOARD_OFFSET (valcontents)
 			       + (char *) kboard_for_bindings ());
     default: emacs_abort ();
     }
@@ -1497,7 +1497,7 @@ store_symval_forwarding (lispfwd valcontents, Lisp_Object newval,
     case Lisp_Fwd_Kboard_Obj:
       {
 	char *base = (char *) kboard_for_bindings ();
-	char *p = base + XKBOARD_OBJFWD (valcontents)->offset;
+	char *p = base + XKBOARD_OFFSET (valcontents);
 	*(Lisp_Object *) p = newval;
       }
       break;
@@ -2083,7 +2083,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
 	  {
 	    char *base = (char *) (where ? where
 				   : kboard_for_bindings ());
-	    char *p = base + XKBOARD_OBJFWD (valcontents)->offset;
+	    char *p = base + XKBOARD_OFFSET (valcontents);
 	    *(Lisp_Object *) p = value;
 	  }
 	else
diff --git a/src/lisp.h b/src/lisp.h
index d0eef3e4aa1..2dc3530337b 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3167,13 +3167,6 @@ #define INT_TO_INTEGER(expr) \
     Lisp_Object valcell;
   };
 
-/* Like Lisp_Objfwd except that value lives in a slot in the
-   current kboard.  */
-struct Lisp_Kboard_Objfwd
-  {
-    int offset;
-  };
-
 struct Lisp_Fwd
 {
   enum Lisp_Fwd_Type type;
@@ -3183,7 +3176,7 @@ #define INT_TO_INTEGER(expr) \
     bool *boolvar;
     Lisp_Object *objvar;
     struct Lisp_Buffer_Objfwd bufobjfwd;
-    struct Lisp_Kboard_Objfwd kboardobjfwd;
+    int kbdoffset;
   } u;
 };
 
@@ -3608,14 +3601,12 @@ #define DEFVAR_INT(lname, vname, doc)			\
     defvar_int (&i_fwd, lname);				\
   } while (false)
 #define DEFVAR_KBOARD(lname, vname, doc)			\
-do								\
-  {								\
+  do {								\
     static struct Lisp_Fwd const ko_fwd				\
 	= { Lisp_Fwd_Kboard_Obj,				\
-	    .u.kboardobjfwd = {offsetof (KBOARD, vname##_)}};	\
+	    .u.kbdoffset = offsetof (KBOARD, vname##_)};	\
     defvar_kboard (&ko_fwd, lname);				\
-  }								\
-while (false)
+  } while (false)
 
 \f
 /* Elisp uses multiple stacks:
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0006-Remove-struct-Lisp_Buffer_Objfwd.patch --]
[-- Type: text/x-diff, Size: 8272 bytes --]

From 9a9c36d8fdf54039540c44d27ee91063e835500c Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Sun, 23 Jun 2024 17:25:21 +0200
Subject: [PATCH 6/6] Remove struct Lisp_Buffer_Objfwd

* src/lisp.h (struct Lisp_Buffer_Objfwd): Deleted.
(struct Lisp_Fwd): Add the fields bufoffset and bufpredicate.
Make the type a 1-byte bitfield so that the entire struct still
fits in two words.
(XBUFFER_OFFSET): Renamed from XBUFFER_OBJFWD.
* src/buffer.c (DEFVAR_PER_BUFFER, defvar_per_buffer)
(buffer_local_value): Update accordingly.
* src/data.c (do_symval_forwarding, store_symval_forwarding)
(set_internal, default_value, set_default_internal)
(Fmake_local_variable, Fkill_local_variable, Flocal_variable_): Use
XBUFFER_OFFSET.
---
 src/buffer.c | 29 ++++++++++++++---------------
 src/data.c   | 19 +++++++++----------
 src/lisp.h   | 30 ++++++++++++++++--------------
 3 files changed, 39 insertions(+), 39 deletions(-)

diff --git a/src/buffer.c b/src/buffer.c
index e55560b1cd9..ae5016df50e 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1389,7 +1389,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
       {
 	lispfwd fwd = SYMBOL_FWD (sym);
 	if (BUFFER_OBJFWDP (fwd))
-	  result = per_buffer_value (buf, XBUFFER_OBJFWD (fwd)->offset);
+	  result = per_buffer_value (buf, XBUFFER_OFFSET (fwd));
 	else
 	  result = Fdefault_value (variable);
 	break;
@@ -5019,32 +5019,31 @@ init_buffer (void)
 
 /* FIXME: use LISPSYM_INITIALLY instead of TAG_PTR_INITIALLY */
 #define DEFVAR_PER_BUFFER(lname, vname, predicate_, doc)		\
-do									\
-  {									\
-    const Lisp_Object sym = TAG_PTR_INITIALLY (				\
-	Lisp_Symbol, (intptr_t)((i##predicate_) * sizeof *lispsym));	\
-    static const struct Lisp_Fwd bo_fwd = {				\
-      .type = Lisp_Fwd_Buffer_Obj,					\
-      .u.bufobjfwd = { .offset = offsetof (struct buffer, vname##_),	\
-		       .predicate = sym },				\
-    };									\
+  do {									\
+    const Lisp_Object sym						\
+      = TAG_PTR_INITIALLY (Lisp_Symbol, (intptr_t)((i##predicate_)	\
+						   * sizeof *lispsym));	\
+    static const struct Lisp_Fwd bo_fwd					\
+	= { .type = Lisp_Fwd_Buffer_Obj,				\
+	    .bufoffset = offsetof (struct buffer, vname##_),		\
+	    .u.bufpredicate = sym };					\
+    static_assert (offsetof (struct buffer, vname##_)			\
+		   < (1 << 8 * sizeof bo_fwd.bufoffset));		\
     defvar_per_buffer (&bo_fwd, lname);					\
-  }									\
-while (0)
+  } while (0)
 
 static void
 defvar_per_buffer (const struct Lisp_Fwd *fwd, const char *namestring)
 {
   eassert (fwd->type == Lisp_Fwd_Buffer_Obj);
-  const struct Lisp_Buffer_Objfwd *bo_fwd = XBUFFER_OBJFWD (fwd);
   struct Lisp_Symbol *sym = XSYMBOL (intern (namestring));
 
   sym->u.s.declared_special = true;
   sym->u.s.redirect = SYMBOL_FORWARDED;
   SET_SYMBOL_FWD (sym, fwd);
-  XSETSYMBOL (PER_BUFFER_SYMBOL (bo_fwd->offset), sym);
+  XSETSYMBOL (PER_BUFFER_SYMBOL (XBUFFER_OFFSET (fwd)), sym);
 
-  if (PER_BUFFER_IDX (bo_fwd->offset) == 0)
+  if (PER_BUFFER_IDX (XBUFFER_OFFSET (fwd)) == 0)
     /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
        slot of buffer_local_flags.  */
     emacs_abort ();
diff --git a/src/data.c b/src/data.c
index 9f344474692..e0133d81771 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1343,7 +1343,7 @@ do_symval_forwarding (lispfwd valcontents)
 
     case Lisp_Fwd_Buffer_Obj:
       return per_buffer_value (current_buffer,
-			       XBUFFER_OBJFWD (valcontents)->offset);
+			       XBUFFER_OFFSET (valcontents));
 
     case Lisp_Fwd_Kboard_Obj:
       return *(Lisp_Object *) (XKBOARD_OFFSET (valcontents)
@@ -1458,9 +1458,8 @@ store_symval_forwarding (lispfwd valcontents, Lisp_Object newval,
 
     case Lisp_Fwd_Buffer_Obj:
       {
-	const struct Lisp_Buffer_Objfwd *fwd = XBUFFER_OBJFWD (valcontents);
-	int offset = fwd->offset;
-	Lisp_Object predicate = fwd->predicate;
+	int offset = XBUFFER_OFFSET (valcontents);
+	Lisp_Object predicate = valcontents->u.bufpredicate;
 
 	if (!NILP (newval) && !NILP (predicate))
 	  {
@@ -1769,7 +1768,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
 	lispfwd innercontents = SYMBOL_FWD (sym);
 	if (BUFFER_OBJFWDP (innercontents))
 	  {
-	    int offset = XBUFFER_OBJFWD (innercontents)->offset;
+	    int offset = XBUFFER_OFFSET (innercontents);
 	    int idx = PER_BUFFER_IDX (offset);
 	    if (idx > 0 && bindflag == SET_INTERNAL_SET
 	        && !PER_BUFFER_VALUE_P (buf, idx))
@@ -1958,7 +1957,7 @@ default_value (Lisp_Object symbol)
 	   rather than letting do_symval_forwarding get the current value.  */
 	if (BUFFER_OBJFWDP (valcontents))
 	  {
-	    int offset = XBUFFER_OBJFWD (valcontents)->offset;
+	    int offset = XBUFFER_OFFSET (valcontents);
 	    if (PER_BUFFER_IDX (offset) != 0)
 	      return per_buffer_default (offset);
 	  }
@@ -2053,7 +2052,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
 	   Make them work apparently like Lisp_Buffer_Local_Value variables.  */
 	if (BUFFER_OBJFWDP (valcontents))
 	  {
-	    int offset = XBUFFER_OBJFWD (valcontents)->offset;
+	    int offset = XBUFFER_OFFSET (valcontents);
 	    int idx = PER_BUFFER_IDX (offset);
 
 	    set_per_buffer_default (offset, value);
@@ -2270,7 +2269,7 @@ DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable,
     {
       if (forwarded && BUFFER_OBJFWDP (valcontents.fwd))
         {
-          int offset = XBUFFER_OBJFWD (valcontents.fwd)->offset;
+          int offset = XBUFFER_OFFSET (valcontents.fwd);
           int idx = PER_BUFFER_IDX (offset);
           eassert (idx);
           if (idx > 0)
@@ -2342,7 +2341,7 @@ DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable,
 	lispfwd valcontents = SYMBOL_FWD (sym);
 	if (BUFFER_OBJFWDP (valcontents))
 	  {
-	    int offset = XBUFFER_OBJFWD (valcontents)->offset;
+	    int offset = XBUFFER_OFFSET (valcontents);
 	    int idx = PER_BUFFER_IDX (offset);
 
 	    if (idx > 0)
@@ -2423,7 +2422,7 @@ DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p,
 	lispfwd valcontents = SYMBOL_FWD (sym);
 	if (BUFFER_OBJFWDP (valcontents))
 	  {
-	    int offset = XBUFFER_OBJFWD (valcontents)->offset;
+	    int offset = XBUFFER_OFFSET (valcontents);
 	    int idx = PER_BUFFER_IDX (offset);
 	    if (idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
 	      return Qt;
diff --git a/src/lisp.h b/src/lisp.h
index 2dc3530337b..c20bc9aa76e 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3115,15 +3115,6 @@ #define INT_TO_INTEGER(expr) \
   (EXPR_SIGNED (expr) ? make_int (expr) : make_uint (expr))
 
 \f
-/* Like Lisp_Objfwd except that value lives in a slot in the
-   current buffer.  Value is byte index of slot within buffer.  */
-struct Lisp_Buffer_Objfwd
-  {
-    int offset;
-    /* One of Qnil, Qintegerp, Qsymbolp, Qstringp, Qfloatp or Qnumberp.  */
-    Lisp_Object predicate;
-  };
-
 /* struct Lisp_Buffer_Local_Value is used in a symbol value cell when
    the symbol has buffer-local bindings.  (Exception:
    some buffer-local variables are built-in, with their values stored
@@ -3167,15 +3158,26 @@ #define INT_TO_INTEGER(expr) \
     Lisp_Object valcell;
   };
 
+/* A struct Lisp_Fwd is used to locate a variable.  See Lisp_Fwd_Type
+   for the various types of variables.
+
+   Lisp_Fwd structs are created by macros like DEFVAR_INT, DEFVAR_BOOL etc.
+   and are always kept in static variables.  They are never allocated
+   dynamically. */
+
 struct Lisp_Fwd
 {
-  enum Lisp_Fwd_Type type;
+  enum Lisp_Fwd_Type type : 8;
+  uint16_t bufoffset;	       /* used if type == Lisp_Fwd_Buffer_Obj */
   union
   {
     intmax_t *intvar;
     bool *boolvar;
     Lisp_Object *objvar;
-    struct Lisp_Buffer_Objfwd bufobjfwd;
+    /* One of Qnil, Qintegerp, Qsymbolp, Qstringp, Qfloatp, Qnumberp,
+       Qfraction, Qvertical_scroll_bar, or Qoverwrite_mode.
+     */
+    Lisp_Object bufpredicate;
     int kbdoffset;
   } u;
 };
@@ -3192,11 +3194,11 @@ BUFFER_OBJFWDP (lispfwd a)
   return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj;
 }
 
-INLINE struct Lisp_Buffer_Objfwd const *
-XBUFFER_OBJFWD (lispfwd a)
+INLINE int
+XBUFFER_OFFSET (lispfwd a)
 {
   eassert (BUFFER_OBJFWDP (a));
-  return &a->u.bufobjfwd;
+  return a->bufoffset;
 }
 
 INLINE bool
-- 
2.39.2

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

>> Then removing the Lisp_Fwd_Bool etc. structures that currently exist and
>> replace this
>>
>>   typedef struct { void const *fwdptr; } lispfwd;
>>
>> which is just a void * with ornaments, with const struct Lisp_Fwd *.
>
> These patches do this; only that the predicate is still a Lisp_Object.

Thanks, that's much less obscure! Pushed.

Re: MPS: Forwording symbols

[Helmut Eller]

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

On Sat, Jun 22 2024, Gerd Möllmann wrote:

>> The symbol is needed in store_symval_forwarding.  It looks in the plist
>> for 'choice and 'range.  In addition to the five symbols mentioned in
>> the definition of Lisp_Buffer_Objfwd, predicate can also be
>> 'overwrite-mode, 'vertical-scroll-bar and 'fraction.  I think those have
>> those properties; weird.
>
> I guess then it's better to leave the enum part out. That seems to
> become too much work. What an ugly corner.

Here is an attempt to use an enum.  I'm not sure that it's easier to
read and the enum constants have odd names.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Introduce-an-enum-Lisp_Fwd_Predicate.patch --]
[-- Type: text/x-diff, Size: 5946 bytes --]

From ad356aea9eb894baec5541d2203e97a0f42e382e Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Sun, 23 Jun 2024 21:46:16 +0200
Subject: [PATCH] Introduce an enum Lisp_Fwd_Predicate

Using an enum instead of a symbol makes it obvious that this field is
of no concern to the GC.

* src/lisp.h (enum Lisp_Fwd_Predicate): New.
(struct Lisp_Fwd): Use it instead of a symbol.
* src/buffer.c (DEFVAR_PER_BUFFER): Create the necessary enum constant
instead of a symbol.
* src/data.c (check_fwd_predicate, check_choice): New helpers.
(store_symval_forwarding): Use it.
---
 src/buffer.c | 22 ++++++--------
 src/data.c   | 83 ++++++++++++++++++++++++++++++++++------------------
 src/lisp.h   | 17 ++++++++---
 3 files changed, 77 insertions(+), 45 deletions(-)

diff --git a/src/buffer.c b/src/buffer.c
index ae5016df50e..39b5e29067a 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -5017,19 +5017,15 @@ init_buffer (void)
    that nil is allowed too).  DOC is a dummy where you write the doc
    string as a comment.  */
 
-/* FIXME: use LISPSYM_INITIALLY instead of TAG_PTR_INITIALLY */
-#define DEFVAR_PER_BUFFER(lname, vname, predicate_, doc)		\
-  do {									\
-    const Lisp_Object sym						\
-      = TAG_PTR_INITIALLY (Lisp_Symbol, (intptr_t)((i##predicate_)	\
-						   * sizeof *lispsym));	\
-    static const struct Lisp_Fwd bo_fwd					\
-	= { .type = Lisp_Fwd_Buffer_Obj,				\
-	    .bufoffset = offsetof (struct buffer, vname##_),		\
-	    .u.bufpredicate = sym };					\
-    static_assert (offsetof (struct buffer, vname##_)			\
-		   < (1 << 8 * sizeof bo_fwd.bufoffset));		\
-    defvar_per_buffer (&bo_fwd, lname);					\
+#define DEFVAR_PER_BUFFER(lname, vname, predicate, doc)		\
+  do {								\
+    static const struct Lisp_Fwd bo_fwd				\
+	= { .type = Lisp_Fwd_Buffer_Obj,			\
+	    .bufoffset = offsetof (struct buffer, vname##_),	\
+	    .u.bufpredicate = FWDPRED_##predicate };		\
+    static_assert (offsetof (struct buffer, vname##_)		\
+		   < (1 << 8 * sizeof bo_fwd.bufoffset));	\
+    defvar_per_buffer (&bo_fwd, lname);				\
   } while (0)
 
 static void
diff --git a/src/data.c b/src/data.c
index e0133d81771..9fd439e07b5 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1399,6 +1399,59 @@ wrong_range (Lisp_Object min, Lisp_Object max, Lisp_Object wrong)
 	    wrong);
 }
 
+static void
+check_choice (Lisp_Object choice, Lisp_Object val)
+{
+  eassert (CONSP (choice));
+  if (NILP (Fmemq (val, choice)))
+    wrong_choice (choice, val);
+}
+
+static void
+check_fwd_predicate (enum Lisp_Fwd_Predicate p, Lisp_Object val)
+{
+  switch (p)
+    {
+    case FWDPRED_Qnil:
+      return;
+    case FWDPRED_Qstringp:
+      if (!STRINGP (val))
+	wrong_type_argument (Qstringp, val);
+      return;
+    case FWDPRED_Qsymbolp:
+      if (!SYMBOLP (val))
+	wrong_type_argument (Qsymbolp, val);
+      return;
+    case FWDPRED_Qintegerp:
+      if (!INTEGERP (val))
+	wrong_type_argument (Qintegerp, val);
+      return;
+    case FWDPRED_Qnumberp:
+      if (!NUMBERP (val))
+	wrong_type_argument (Qnumberp, val);
+      return;
+    case FWDPRED_Qfraction:
+      {
+	if (!NUMBERP (val))
+	  wrong_type_argument (Qnumberp, val);
+	Lisp_Object range = Fget (Qfraction, Qrange);
+	eassert (CONSP (range));
+	Lisp_Object min = XCAR (range);
+	Lisp_Object max = XCDR (range);
+	if (NILP (CALLN (Fleq, min, val, max)))
+	  wrong_range (min, max, val);
+      }
+      return;
+    case FWDPRED_Qvertical_scroll_bar:
+      check_choice (Fget (Qvertical_scroll_bar, Qchoice), val);
+      return;
+    case FWDPRED_Qoverwrite_mode:
+      check_choice (Fget (Qoverwrite_mode, Qchoice), val);
+      return;
+    }
+  emacs_abort ();
+}
+
 /* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell
    of SYMBOL.  If SYMBOL is buffer-local, VALCONTENTS should be the
    buffer-independent contents of the value cell: forwarded just one
@@ -1459,34 +1512,8 @@ store_symval_forwarding (lispfwd valcontents, Lisp_Object newval,
     case Lisp_Fwd_Buffer_Obj:
       {
 	int offset = XBUFFER_OFFSET (valcontents);
-	Lisp_Object predicate = valcontents->u.bufpredicate;
-
-	if (!NILP (newval) && !NILP (predicate))
-	  {
-	    eassert (SYMBOLP (predicate));
-	    Lisp_Object choiceprop = Fget (predicate, Qchoice);
-	    if (!NILP (choiceprop))
-	      {
-		if (NILP (Fmemq (newval, choiceprop)))
-		  wrong_choice (choiceprop, newval);
-	      }
-	    else
-	      {
-		Lisp_Object rangeprop = Fget (predicate, Qrange);
-		if (CONSP (rangeprop))
-		  {
-		    Lisp_Object min = XCAR (rangeprop), max = XCDR (rangeprop);
-		    if (! NUMBERP (newval)
-			|| NILP (CALLN (Fleq, min, newval, max)))
-		      wrong_range (min, max, newval);
-		  }
-		else if (FUNCTIONP (predicate))
-		  {
-		    if (NILP (call1 (predicate, newval)))
-		      wrong_type_argument (predicate, newval);
-		  }
-	      }
-	  }
+	if (!NILP (newval))
+	  check_fwd_predicate (valcontents->u.bufpredicate, newval);
 	if (buf == NULL)
 	  buf = current_buffer;
 	set_per_buffer_value (buf, offset, newval);
diff --git a/src/lisp.h b/src/lisp.h
index c20bc9aa76e..e3c2dce7df0 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3158,6 +3158,18 @@ #define INT_TO_INTEGER(expr) \
     Lisp_Object valcell;
   };
 
+enum Lisp_Fwd_Predicate
+{
+  FWDPRED_Qnil,
+  FWDPRED_Qintegerp,
+  FWDPRED_Qsymbolp,
+  FWDPRED_Qstringp,
+  FWDPRED_Qnumberp,
+  FWDPRED_Qfraction,
+  FWDPRED_Qvertical_scroll_bar,
+  FWDPRED_Qoverwrite_mode,
+};
+
 /* A struct Lisp_Fwd is used to locate a variable.  See Lisp_Fwd_Type
    for the various types of variables.
 
@@ -3174,10 +3186,7 @@ #define INT_TO_INTEGER(expr) \
     intmax_t *intvar;
     bool *boolvar;
     Lisp_Object *objvar;
-    /* One of Qnil, Qintegerp, Qsymbolp, Qstringp, Qfloatp, Qnumberp,
-       Qfraction, Qvertical_scroll_bar, or Qoverwrite_mode.
-     */
-    Lisp_Object bufpredicate;
+    enum Lisp_Fwd_Predicate bufpredicate;
     int kbdoffset;
   } u;
 };
-- 
2.39.2

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Sat, Jun 22 2024, Gerd Möllmann wrote:
>
>>> The symbol is needed in store_symval_forwarding.  It looks in the plist
>>> for 'choice and 'range.  In addition to the five symbols mentioned in
>>> the definition of Lisp_Buffer_Objfwd, predicate can also be
>>> 'overwrite-mode, 'vertical-scroll-bar and 'fraction.  I think those have
>>> those properties; weird.
>>
>> I guess then it's better to leave the enum part out. That seems to
>> become too much work. What an ugly corner.
>
> Here is an attempt to use an enum.  I'm not sure that it's easier to
> read and the enum constants have odd names.

Pushed!

I find that so much better, easier to understand and maintain. There is
no question anymore what that predicate can possibly be (and the comment
was wrong, I'm tempted to say of course), we have compile-time support
with an exhaustive switch. We got rid of that void * before that. And so
on. We even spared a word in the struct :-).

Thanks for doing that!

Re: MPS: Forwording symbols

[Helmut Eller]

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

On Mon, Jun 24 2024, Gerd Möllmann wrote:

>> Here is an attempt to use an enum.  I'm not sure that it's easier to
>> read and the enum constants have odd names.
>
> Pushed!

I have one more patch: it moves the bufoffset field back to the union.
I think that's a bit nicer; and with the predicate enum there is enough
room to do it.

There other patch, sets some fields in a popped handler to nil to avoid
a potential leak.

> We even spared a word in the struct :-).

Right, I haven't even noticed that.  Now the union only needs one word
and the type fields could be packed in 3 bits.  That would probably be
small enough to store it in a symbol.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Move-the-Lisp_Fwd.bufoffset-field-back-to-the-union.patch --]
[-- Type: text/x-diff, Size: 2947 bytes --]

From 770aaffe0ae52fb9305f9e2b646803ab2c4c0f84 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Mon, 24 Jun 2024 10:06:54 +0200
Subject: [PATCH 1/2] Move the Lisp_Fwd.bufoffset field back to the union

* src/lisp.h (struct Lisp_Fwd): With the predicate enum, we can now pack
the offset and the predicate into a one-word struct.
(XBUFFER_OFFSET): Use the new field name.
* src/buffer.c (DEFVAR_PER_BUFFER): Create the one-word struct.
* src/data.c (store_symval_forwarding): Use the new field name.
---
 src/buffer.c | 15 +++++++++------
 src/data.c   |  2 +-
 src/lisp.h   |  9 ++++++---
 3 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/src/buffer.c b/src/buffer.c
index 39b5e29067a..a69a9a3bbd8 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -5017,14 +5017,17 @@ init_buffer (void)
    that nil is allowed too).  DOC is a dummy where you write the doc
    string as a comment.  */
 
-#define DEFVAR_PER_BUFFER(lname, vname, predicate, doc)		\
+#define DEFVAR_PER_BUFFER(lname, vname, predicate_, doc)	\
   do {								\
-    static const struct Lisp_Fwd bo_fwd				\
-	= { .type = Lisp_Fwd_Buffer_Obj,			\
-	    .bufoffset = offsetof (struct buffer, vname##_),	\
-	    .u.bufpredicate = FWDPRED_##predicate };		\
+    static const struct Lisp_Fwd bo_fwd = {			\
+      .type = Lisp_Fwd_Buffer_Obj,				\
+      .u.buf = {						\
+	.offset = offsetof (struct buffer, vname##_),		\
+	.predicate = FWDPRED_##predicate_			\
+      }								\
+    };								\
     static_assert (offsetof (struct buffer, vname##_)		\
-		   < (1 << 8 * sizeof bo_fwd.bufoffset));	\
+		   < (1 << 8 * sizeof bo_fwd.u.buf.offset));	\
     defvar_per_buffer (&bo_fwd, lname);				\
   } while (0)
 
diff --git a/src/data.c b/src/data.c
index 9fd439e07b5..dcf869c1a0e 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1513,7 +1513,7 @@ store_symval_forwarding (lispfwd valcontents, Lisp_Object newval,
       {
 	int offset = XBUFFER_OFFSET (valcontents);
 	if (!NILP (newval))
-	  check_fwd_predicate (valcontents->u.bufpredicate, newval);
+	  check_fwd_predicate (valcontents->u.buf.predicate, newval);
 	if (buf == NULL)
 	  buf = current_buffer;
 	set_per_buffer_value (buf, offset, newval);
diff --git a/src/lisp.h b/src/lisp.h
index e3c2dce7df0..912b208a213 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3180,13 +3180,16 @@ #define INT_TO_INTEGER(expr) \
 struct Lisp_Fwd
 {
   enum Lisp_Fwd_Type type : 8;
-  uint16_t bufoffset;	       /* used if type == Lisp_Fwd_Buffer_Obj */
   union
   {
     intmax_t *intvar;
     bool *boolvar;
     Lisp_Object *objvar;
-    enum Lisp_Fwd_Predicate bufpredicate;
+    struct
+    {
+      uint16_t offset;
+      enum Lisp_Fwd_Predicate predicate : 8;
+    } buf;
     int kbdoffset;
   } u;
 };
@@ -3207,7 +3210,7 @@ BUFFER_OBJFWDP (lispfwd a)
 XBUFFER_OFFSET (lispfwd a)
 {
   eassert (BUFFER_OBJFWDP (a));
-  return a->bufoffset;
+  return a->u.buf.offset;
 }
 
 INLINE bool
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-In-pop_handler-clear-references-in-the-dropped-handl.patch --]
[-- Type: text/x-diff, Size: 999 bytes --]

From 5b927463be1ee9055ef18ed654307699f5d17fea Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Mon, 24 Jun 2024 16:49:09 +0200
Subject: [PATCH 2/2] In pop_handler, clear references in the dropped handler

* src/eval.c (pop_handler): Set the val and tag_or_ch fields to nil.
Without this, the referenced objects can't be collected until a new
handler is pushed.
---
 src/eval.c | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/src/eval.c b/src/eval.c
index 6f008804e10..40c3c6394b0 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1281,7 +1281,14 @@ #define clobbered_eassert(E) verify (sizeof (E) != 0)
 void
 pop_handler (void)
 {
-  handlerlist = handlerlist->next;
+  struct handler *old = handlerlist;
+  struct handler *new = old->next;
+  handlerlist = new;
+#ifdef HAVE_MPS
+  eassert (new->nextfree == old);
+  old->val = Qnil;
+  old->tag_or_ch = Qnil;
+#endif
 }
 
 /* Set up a catch, then call C function FUNC on argument ARG.
-- 
2.39.2

Re: MPS: Forwording symbols

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Mon, Jun 24 2024, Gerd Möllmann wrote:
>
>>> Here is an attempt to use an enum.  I'm not sure that it's easier to
>>> read and the enum constants have odd names.
>>
>> Pushed!
>
> I have one more patch: it moves the bufoffset field back to the union.
> I think that's a bit nicer; and with the predicate enum there is enough
> room to do it.
>
> There other patch, sets some fields in a popped handler to nil to avoid
> a potential leak.
>

Thanks and pushed.

(Wonder what that is

c5f180ff596 Merge branch 'scratch/igc' of
git.savannah.gnu.org:/srv/git/emacs into scratch/igc

Whtever...)

>> We even spared a word in the struct :-).
>
> Right, I haven't even noticed that.  Now the union only needs one word
> and the type fields could be packed in 3 bits.  That would probably be
> small enough to store it in a symbol.

:-)

Re: MPS: Forwording symbols

[Eli Zaretskii]

> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: Emacs Devel <emacs-devel@gnu.org>,  Eli Zaretskii <eliz@gnu.org>
> Date: Mon, 24 Jun 2024 18:14:31 +0200
> 
> (Wonder what that is
> 
> c5f180ff596 Merge branch 'scratch/igc' of
> git.savannah.gnu.org:/srv/git/emacs into scratch/igc
> 
> Whtever...)

That's my bad, sorry: I committed Windows-specific changes several
days ago and evidently forgot to push then.

Re: MPS: Forwording symbols

[Gerd Möllmann]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
>> Cc: Emacs Devel <emacs-devel@gnu.org>,  Eli Zaretskii <eliz@gnu.org>
>> Date: Mon, 24 Jun 2024 18:14:31 +0200
>> 
>> (Wonder what that is
>> 
>> c5f180ff596 Merge branch 'scratch/igc' of
>> git.savannah.gnu.org:/srv/git/emacs into scratch/igc
>> 
>> Whtever...)
>
> That's my bad, sorry: I committed Windows-specific changes several
> days ago and evidently forgot to push then.

No problem, I was wondering if it might have been something happening
automatically or so because of the repo on savannah.

BTW, I've now implemented something that hopefulls improves the error
handling when MPS asserts, or we with an igc_assert. Works for n = 0 and
n = 1, so for all n by induction :-). n = 1 was a webkit xwidget.