Re: scratch/igc 90e80a9a53e 6/6: Adjust igc.c code to header changes

[Pip Cet <pipcet@protonmail.com>]

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

On Sunday, July 21st, 2024 at 14:25, Eli Zaretskii <eliz@gnu.org> wrote:
> > Date: Sun, 21 Jul 2024 14:11:56 +0000
> 
> > From: Pip Cet pipcet@protonmail.com
> > Cc: emacs-devel@gnu.org
> > 
> > > Does the below help?
> > > 
> > > #4 dump_write (ctx=0x71ceb38, buf=0x71ce848, nbyte=8) at pdumper.c:792
> > > 792 dump_write (struct dump_context *ctx, const void *buf, dump_off nbyte)
> > > (gdb) p ctx->igc_obj_dumped
> > > 
> > > $1 = (void *) 0xc3f000 <Sinternal_show_cursor_p>
> > 
> > Thanks, that helps a lot! It's an internal subr, and those don't store their proper size in the pseudovector header, so we don't dump them properly as we trust the pseudovector header.
> > 
> > I've managed to reproduce something similar here, and the attached patch helps, but it probably breaks GC in the !HAVE_MPS case.
> 
> 
> Why cannot you identify this kind of object during dumping, and avoid
> applying whatever igc_dump_finish_obj does?

You mean you'd prefer to leave the pseudovector header for builtin subrs at its current value? We can do that, but I think the MPS header should still be valid. (It's not with the patch I had attached: that makes it claim an object size of 112 bytes when it's actually just 96 bytes, and that causes us to overwrite the first 16 bytes after the last subr; in my case, stdout... Anyway, next patch attached, which duplicates a bit of code unnecessarily.)

> There's the PVEC_SUBR in the struct, no?

Yes, there is.

Pip

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-mps-subr.patch --]
[-- Type: text/x-patch; name=0002-mps-subr.patch, Size: 3242 bytes --]

diff --git a/src/igc.c b/src/igc.c
index 6960e5267d2..7dd2715204a 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -619,6 +619,27 @@ set_header (struct igc_header *h, enum igc_obj_type type,
 static unsigned alloc_hash (void);
 static size_t igc_round (size_t nbytes, size_t align);
 
+#define COMMON_MULTIPLE(a, b) \
+  ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b))
+enum { LISP_ALIGNMENT = alignof (union { GCALIGNED_UNION_MEMBER }) };
+/* Vector size requests are a multiple of this.  */
+enum { roundup_size = COMMON_MULTIPLE (LISP_ALIGNMENT, word_size) };
+/* Round up X to nearest mult-of-ROUNDUP_SIZE --- use at compile time.  */
+#define vroundup_ct(x) ROUNDUP (x, roundup_size)
+/* Round up X to nearest mult-of-ROUNDUP_SIZE --- use at runtime.  */
+#define vroundup(x) (eassume ((x) >= 0), vroundup_ct (x))
+
+/* Memory footprint in bytes of a pseudovector other than a bool-vector.  */
+static ptrdiff_t
+pseudovector_nbytes (const struct vectorlike_header *hdr)
+{
+  eassert (!PSEUDOVECTOR_TYPEP (hdr, PVEC_BOOL_VECTOR));
+  ptrdiff_t nwords = ((hdr->size & PSEUDOVECTOR_SIZE_MASK)
+		      + ((hdr->size & PSEUDOVECTOR_REST_MASK)
+			 >> PSEUDOVECTOR_SIZE_BITS));
+  return vroundup (header_size + word_size * nwords);
+}
+
 /* Called throughout Emacs to initialize the GC header of an object
    which does not live in GC-managed memory, such as pure objects and
    builtin symbols.  */
@@ -641,11 +662,13 @@ set_header (struct igc_header *h, enum igc_obj_type type,
       break;
     case IGC_OBJ_VECTOR:
       {
+	ssize_t nbytes;
 	ptrdiff_t size = ((struct Lisp_Vector *)header)->header.size;
 	if (size & PSEUDOVECTOR_FLAG)
-	  size &= PSEUDOVECTOR_SIZE_MASK;
-	set_header (h, IGC_OBJ_VECTOR, sizeof (struct Lisp_Vector) +
-		    size * sizeof (Lisp_Object), alloc_hash ());
+	  nbytes = pseudovector_nbytes (&((struct Lisp_Vector *)header)->header);
+	else
+	  nbytes = size * sizeof (Lisp_Object) + header_size;
+	set_header (h, IGC_OBJ_VECTOR, nbytes, alloc_hash ());
 	break;
       }
     case IGC_OBJ_DUMPED_CHARSET_TABLE:
diff --git a/src/lisp.h b/src/lisp.h
index 5b555c62304..170490297e4 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3699,7 +3699,8 @@ CHECK_SUBR (Lisp_Object x)
 #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc)	\
   SUBR_SECTION_ATTRIBUTE						\
   static union Aligned_Lisp_Subr sname =				\
-    { {	{ GC_HEADER_INIT PVEC_SUBR << PSEUDOVECTOR_AREA_BITS },	\
+    { {	{ GC_HEADER_INIT						\
+	  PVECHEADERSIZE (PVEC_SUBR, 0, VECSIZE (union Aligned_Lisp_Subr)) }, \
         { .a ## maxargs = fnname },					\
 	minargs, maxargs, lname, {intspec}, lisp_h_Qnil}};		\
    Lisp_Object fnname
diff --git a/src/sfntfont.c b/src/sfntfont.c
index 9bc3fb3415e..dd21fba4776 100644
--- a/src/sfntfont.c
+++ b/src/sfntfont.c
@@ -1990,7 +1990,8 @@ sfntfont_compare_font_entities (Lisp_Object a, Lisp_Object b)
 static union Aligned_Lisp_Subr Scompare_font_entities =
   {
     {
-      { GC_HEADER_INIT PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS), },
+      { GC_HEADER_INIT
+	PVECHEADERSIZE (PVEC_SUBR, 0, VECSIZE (union Aligned_Lisp_Subr)) },
       { .a2 = sfntfont_compare_font_entities, },
       2, 2, "sfntfont_compare_font_entities", {0}, lisp_h_Qnil,
     },