scratch/igc f330b6876ae 2/2: Correct for some incorrect pseudoheader sizes in igc.c

[Pip Cet]

branch: scratch/igc
commit f330b6876ae482bc2780bb5d024ad6864a13d61c
Author: Pip Cet <pipcet@protonmail.com>
Commit: Pip Cet <pipcet@protonmail.com>

    Correct for some incorrect pseudoheader sizes in igc.c
    
    Arguably, these are bugs that should be fixed in lisp.h (along with the
    comment describing the pvec header for subrs) and thread.c, by
    initializing pseudovector headers so they actually describe the
    pseudovectors in static memory, but the traditional GC doesn't care.
    
    * src/alloc.c (make_pure_bignum): Call 'igc_init_header' after setting
    the pvec header, not before.
    * src/igc.c (gc_init_header): Catch PVEC_SUBR and PVEC_THREAD, which
    sometimes have incorrect headers
    * src/lisp.h (DEFUN) [HAVE_MPS]: Set pseudovector flag for subrs.
---
 src/alloc.c |  2 +-
 src/igc.c   | 22 +++++++++++++++++++---
 src/lisp.h  | 14 +++++++++++++-
 3 files changed, 33 insertions(+), 5 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index 34d4850ca32..320a5adaf0b 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6128,8 +6128,8 @@ make_pure_bignum (Lisp_Object value)
   mp_size_t new_size;
 
   struct Lisp_Bignum *b = pure_alloc (sizeof *b, Lisp_Vectorlike);
-  gc_init_header (&b->header.gc_header, IGC_OBJ_VECTOR);
   XSETPVECTYPESIZE (b, PVEC_BIGNUM, 0, VECSIZE (struct Lisp_Bignum));
+  gc_init_header (&b->header.gc_header, IGC_OBJ_VECTOR);
 
   int limb_alignment = alignof (mp_limb_t);
   pure_limbs = pure_alloc (nbytes, - limb_alignment);
diff --git a/src/igc.c b/src/igc.c
index 21b5a42915d..ad5f7cc3e7a 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -641,11 +641,27 @@ void gc_init_header (union gc_header *header, 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 ());
+         {
+           /* Correct some incorrect pseudovector headers:
+            * - lisp.h sets the pseudovector tag of builtin subrs to
+            *   PVEC_SUBR, but doesn't set the pseudovector flag or the
+            *   lispsize/restsize fields.
+            * - thread.c uses VECSIZE (struct thread_state) for the
+            *   restsize without subtracting the lispsize.
+            */
+           if (PSEUDOVECTOR_TYPE ((struct Lisp_Vector *)header) == PVEC_SUBR)
+             nbytes = sizeof (struct Lisp_Subr);
+           else if (PSEUDOVECTOR_TYPE ((struct Lisp_Vector *)header) == 
PVEC_THREAD)
+             nbytes = sizeof (struct thread_state);
+           else
+             nbytes = vectorlike_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..bb650111821 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1,3 +1,4 @@
+
 /* Fundamental definitions for GNU Emacs Lisp interpreter. -*- coding: utf-8 
-*-
 
 Copyright (C) 1985-2024 Free Software Foundation, Inc.
@@ -3696,13 +3697,24 @@ CHECK_SUBR (Lisp_Object x)
 
 /* This version of DEFUN declares a function prototype with the right
    arguments, so we can catch errors with maxargs at compile-time.  */
+#ifdef HAVE_MPS
+#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc)    \
+  SUBR_SECTION_ATTRIBUTE                                               \
+  static union Aligned_Lisp_Subr sname =                               \
+    { {        { GC_HEADER_INIT                                                
\
+         (PSEUDOVECTOR_FLAG | PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },  \
+        { .a ## maxargs = fnname },                                    \
+       minargs, maxargs, lname, {intspec}, lisp_h_Qnil}};              \
+   Lisp_Object fnname
+#else
 #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 PVEC_SUBR << PSEUDOVECTOR_AREA_BITS },         
\
         { .a ## maxargs = fnname },                                    \
        minargs, maxargs, lname, {intspec}, lisp_h_Qnil}};              \
    Lisp_Object fnname
+#endif
 
 /* defsubr (Sname);
    is how we define the symbol for function `name' at start-up time.  */