Subject: Re: bug#76091: 31.0.50; festure/igc: buffer.h:829: Emacs fatal error: assertion failed: BUFFERP (a)

From: Pip Cet <[email-masked]>
Date: Fri, 07 Feb 2025 15:23:08 +0000

Pip Cet <[email-masked]> writes:

> Gerd Möllmann <[email-masked]> writes:
>
>> On 7. Feb 2025, at 11:41, Pip Cet <[email-masked]> wrote:
>>
>>  I have a patch, but I'd like to discuss whether this is a plausible
>>  theory first.  Gerd, if there's something that prevents this problem
>>  from happening, and I missed it, could you briefly yell at me here?
>>
>> Good catch!
>
> Thanks!
>
>> I think he idea I had with the igc_on_... is mistaken,
>
> I've rewritten the root resizing functions to always follow the
>
> 1. allocate new zeroed root
> 2. register new root
> 3. copy contents from old root
> 4. if this fails, try again
> 5. save new root
> 6. unregister old root
> 7. free old root
>
> pattern.  It's a bit complicated, but avoids the need for parking the
> arena in these cases.  And, yes, it'll waste some memory, but these are
> roots, and roots are supposed to be small.  I'd rather do it that way
> and turn them into non-roots than figure out how to use realloc() on an
> MPS root, TBH.

I should point out that the memory waste is temporary, only while we
simulate realloc by allocating a new area, then freeing the old one.

>> one must not free the memory of a root while the MPS is not parked.
>
> I think the surprising thing is that parking the arena will cause GC
> activity.  It's best to avoid parking it except when walking the pools,
> I think.

But if you think parking the area *more* is a solution, please let me
know!

> Still testing the patch...

Well, here it is:

It still needs more testing, thought, and comments.  All the volatile
stuff is needed because we can't copy a union with word atomicity: all
we have is memcpy, which might copy bytewise and result in an invalid
intermediate state.  OTOH, we don't know anything about the type in
igc_xpalloc_ambig and igc_xpalloc_exact, so we have to fake it and hope
mps_word_t alignment is good enough.

(Of course, with WIDE_EMACS_INT, mps_word_t is not good enough; unless
we carefully write the scan function not to assume that the two
half-words comprising a 64-bit Lisp_Object are in sync.  As Eli was very
opposed to the idea of removing WIDE_EMACS_INT again, we might have to
find a workaround there.)

Also, "scrans" should be "scans", but I'd rather not edit a patch I've
tested and am about to post :-)

Helmut, can you look over the larger_marker_vector changes?  While
testing, I hit easserts there, so I added some new ones to catch the
situation earlier.  I think the old code was fine, but the new one
should also be, right?

Pip

>From 8521107ab2a9033647082236517770a1604e53c9 Mon Sep 17 00:00:00 2001
From: Pip Cet <[email-masked]>
Subject: [PATCH] Bug#76091

---
 src/alloc.c |  67 +++++++++-------
 src/eval.c  |  26 +++++--
 src/igc.c   | 219 +++++++++++++++++++++++++++++++++++++++-------------
 src/igc.h   |   2 +
 src/lisp.h  |   3 +-
 src/print.c |   5 +-
 6 files changed, 233 insertions(+), 89 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index 8f24ca5e0f3..f0c0e0538b5 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -801,32 +801,13 @@ xnrealloc (void *pa, ptrdiff_t nitems, ptrdiff_t item_size)
 }

-/* Grow PA, which points to an array of *NITEMS items, and return the
-   location of the reallocated array, updating *NITEMS to reflect its
-   new size.  The new array will contain at least NITEMS_INCR_MIN more
-   items, but will not contain more than NITEMS_MAX items total.
-   ITEM_SIZE is the size of each item, in bytes.
+/* Calculate the new allocation size for xpalloc.  This needs to be a
+   separate function because MPS always allocates a new area, rather
+   than calling xrealloc as xpalloc does.  */
 
-   ITEM_SIZE and NITEMS_INCR_MIN must be positive.  *NITEMS must be
-   nonnegative.  If NITEMS_MAX is -1, it is treated as if it were
-   infinity.
-
-   If PA is null, then allocate a new array instead of reallocating
-   the old one.
-
-   Block interrupt input as needed.  If memory exhaustion occurs, set
-   *NITEMS to zero if PA is null, and signal an error (i.e., do not
-   return).
-
-   Thus, to grow an array A without saving its old contents, do
-   { xfree (A); A = NULL; A = xpalloc (NULL, &AITEMS, ...); }.
-   The A = NULL avoids a dangling pointer if xpalloc exhausts memory
-   and signals an error, and later this code is reexecuted and
-   attempts to free A.  */
-
-void *
-xpalloc (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
-	 ptrdiff_t nitems_max, ptrdiff_t item_size)
+ptrdiff_t
+xpalloc_nbytes (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
+		ptrdiff_t nitems_max, ptrdiff_t item_size)
 {
   ptrdiff_t n0 = *nitems;
   eassume (0 < item_size && 0 < nitems_incr_min && 0 <= n0 && -1 <= nitems_max);
@@ -864,8 +845,42 @@ xpalloc (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
 	  || (0 <= nitems_max && nitems_max < n)
 	  || ckd_mul (&nbytes, n, item_size)))
     memory_full (SIZE_MAX);
-  pa = xrealloc (pa, nbytes);
   *nitems = n;
+  return nbytes;
+}
+
+/* Grow PA, which points to an array of *NITEMS items, and return the
+   location of the reallocated array, updating *NITEMS to reflect its
+   new size.  The new array will contain at least NITEMS_INCR_MIN more
+   items, but will not contain more than NITEMS_MAX items total.
+   ITEM_SIZE is the size of each item, in bytes.
+
+   ITEM_SIZE and NITEMS_INCR_MIN must be positive.  *NITEMS must be
+   nonnegative.  If NITEMS_MAX is -1, it is treated as if it were
+   infinity.
+
+   If PA is null, then allocate a new array instead of reallocating
+   the old one.
+
+   Block interrupt input as needed.  If memory exhaustion occurs, set
+   *NITEMS to zero if PA is null, and signal an error (i.e., do not
+   return).
+
+   Thus, to grow an array A without saving its old contents, do
+   { xfree (A); A = NULL; A = xpalloc (NULL, &AITEMS, ...); }.
+   The A = NULL avoids a dangling pointer if xpalloc exhausts memory
+   and signals an error, and later this code is reexecuted and
+   attempts to free A.  */
+
+void *
+xpalloc (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
+	 ptrdiff_t nitems_max, ptrdiff_t item_size)
+{
+  ptrdiff_t nitems_new = *nitems;
+  ptrdiff_t nbytes = xpalloc_nbytes (pa, &nitems_new, nitems_incr_min,
+				     nitems_max, item_size);
+  pa = xrealloc (pa, nbytes);
+  *nitems = nitems_new;
   return pa;
 }
 
diff --git a/src/eval.c b/src/eval.c
index 1fbed2d96b9..e542efd9476 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -225,12 +225,15 @@ init_eval_once (void)
 init_eval_once_for_pdumper (void)
 {
   enum { size = 50 };
-  union specbinding *pdlvec = malloc ((size + 1) * sizeof *specpdl);
+  union specbinding *pdlvec = xzalloc ((size + 1) * sizeof *specpdl);
   specpdl = specpdl_ptr = pdlvec + 1;
   specpdl_end = specpdl + size;
 #ifdef HAVE_MPS
   for (int i = 0; i < size; ++i)
-    specpdl[i].kind = SPECPDL_FREE;
+    {
+      specpdl[i].kind = SPECPDL_FREE;
+      memset (&specpdl[i], 0, sizeof specpdl[i]);
+    }
   igc_on_alloc_main_thread_specpdl ();
 #endif
 }
@@ -2479,15 +2482,23 @@ grow_specpdl_allocation (void)
   ptrdiff_t size = specpdl_end - specpdl;
   ptrdiff_t pdlvecsize = size + 1;
   eassert (max_size > size);
+
+#ifdef HAVE_MPS
+  ptrdiff_t old_pdlvecsize = pdlvecsize;
+  ptrdiff_t nbytes = xpalloc_nbytes (pdlvec, &pdlvecsize, 1, max_size + 1,
+				     sizeof *specpdl);
+  union specbinding *new_pdlvec = xzalloc (nbytes);
+  igc_replace_specpdl (pdlvec, old_pdlvecsize,
+		       new_pdlvec, pdlvecsize);
+  union specbinding *old_pdlvec = pdlvec;
+  pdlvec = new_pdlvec;
+  xfree (old_pdlvec);
+#else
   pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl);
+#endif
   specpdl = pdlvec + 1;
   specpdl_end = specpdl + pdlvecsize - 1;
   specpdl_ptr = specpdl_ref_to_ptr (count);
-#ifdef HAVE_MPS
-  for (int i = size; i < pdlvecsize - 1; ++i)
-    specpdl[i].kind = SPECPDL_FREE;
-  igc_on_grow_specpdl ();
-#endif
 }
 
 /* Eval a sub-expression of the current expression (i.e. in the same
@@ -3847,6 +3858,7 @@ unbind_to (specpdl_ref count, Lisp_Object value)
       this_binding = *--specpdl_ptr;
 #ifdef HAVE_MPS
       specpdl_ptr->kind = SPECPDL_FREE;
+      memset (specpdl_ptr, 0, sizeof *specpdl_ptr);
 #endif
       do_one_unbind (&this_binding, true, SET_INTERNAL_UNBIND);
     }
diff --git a/src/igc.c b/src/igc.c
index af73406cecc..08e8f37387f 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -2986,6 +2986,59 @@ igc_on_grow_specpdl (void)
   }
 }
 
+void
+igc_replace_specpdl (volatile union specbinding *old_pdlvec, ptrdiff_t old_entries,
+		     volatile union specbinding *new_pdlvec, ptrdiff_t new_entries)
+{
+  struct igc *gc = global_igc;
+  mps_root_t root;
+  for (ptrdiff_t i = 0; i < new_entries; i++)
+    new_pdlvec[i].kind = SPECPDL_FREE;
+
+  volatile union specbinding *new_specpdl = new_pdlvec + 1;
+  struct igc_thread_list *t = current_thread->gc_info;
+  mps_res_t res
+    = mps_root_create_area (&root, gc->arena, mps_rank_exact (), 0,
+			    (void *)new_specpdl, (void *)(new_pdlvec + new_entries),
+			    scan_specpdl, t);
+  IGC_CHECK_RES (res);
+  struct igc_root_list *old_root = t->d.specpdl_root;
+  t->d.specpdl_root
+    = register_root (gc, root, (void *)new_specpdl, (void *)(new_pdlvec + new_entries),
+		     false, "specpdl");
+  volatile union specbinding orig;
+
+  for (ptrdiff_t i = 0; i < old_entries; i++)
+    {
+    try_again:;
+      orig = old_pdlvec[i];
+      if (memcmp ((void *)&orig, (void *)(&old_pdlvec[i]), sizeof orig))
+	{
+	  /* We tried to create a snapshot of old_pdlvec[i] on the
+	     stack, which would pin all pointers in old_pdlvec[i].  But
+	     we failed, because a pointer in old_pdlvec[i] was updated
+	     by GC while we were creating the copy.  Try again.  */
+	  goto try_again;
+	}
+      volatile union specbinding temp = orig;
+      temp.kind = SPECPDL_FREE;
+      new_pdlvec[i] = temp;
+      new_pdlvec[i].kind = orig.kind;
+      if (memcmp ((void *)(&new_pdlvec[i]), (void *)(&old_pdlvec[i]), sizeof orig))
+	{
+	  /* old_pdlvec[i] was updated by GC even though all of its
+	     references should have been pinned by the volatile "orig"
+	     copy on the stack!  This really shouldn't happen!  */
+	  emacs_abort ();
+	}
+    }
+
+  if (memcmp ((void *)new_pdlvec, (void *)old_pdlvec, old_entries * sizeof (old_pdlvec[0])))
+    emacs_abort ();
+
+  igc_destroy_root_with_start (old_root->d.start);
+}
+
 static igc_root_list *
 root_create_exact_n (Lisp_Object *start, size_t n)
 {
@@ -3193,16 +3246,42 @@ igc_park_arena (void)
 igc_grow_rdstack (struct read_stack *rs)
 {
   struct igc *gc = global_igc;
-  IGC_WITH_PARKED (gc)
-  {
-    igc_destroy_root_with_start (rs->stack);
-    ptrdiff_t old_nitems = rs->size;
-    rs->stack = xpalloc (rs->stack, &rs->size, 1, -1, sizeof *rs->stack);
-    for (ptrdiff_t i = old_nitems; i < rs->size; ++i)
-      rs->stack[i].type = RE_free;
-    root_create_exact (gc, rs->stack, rs->stack + rs->size, scan_rdstack,
-		       "rdstack");
-  }
+  ptrdiff_t old_nitems = rs->size;
+  ptrdiff_t nbytes = xpalloc_nbytes (rs->stack, &rs->size, 1, -1, sizeof *rs->stack);
+  struct read_stack_entry *new_stack = xzalloc (nbytes);
+  for (ptrdiff_t i = 0; i < rs->size; i++)
+    new_stack[i].type = RE_free;
+  volatile struct read_stack_entry orig;
+  struct read_stack *old_stack = rs;
+  root_create_exact (gc, new_stack, (char *)new_stack + nbytes, scan_rdstack,
+		     "rdstack");
+  for (ptrdiff_t i = 0; i < old_nitems; i++)
+    {
+    try_again:;
+      orig = old_stack->stack[i];
+      if (memcmp ((void *)&orig, (void *)(&old_stack->stack[i]), sizeof orig))
+	{
+	  /* We tried to create a snapshot of old_stack[i] on the
+	     stack, which would pin all pointers in old_stack[i].  But
+	     we failed, because a pointer in old_stack[i] was updated
+	     by GC while we were creating the copy.  Try again.  */
+	  goto try_again;
+	}
+      volatile struct read_stack_entry temp = orig;
+      temp.type = RE_free;
+      new_stack[i] = temp;
+      new_stack[i].type = orig.type;
+      if (memcmp ((void *)(&new_stack[i]), (void *)(&old_stack->stack[i]), sizeof orig))
+	{
+	  /* old_pdlvec[i] was updated by GC even though all of its
+	     references should have been pinned by the volatile "orig"
+	     copy on the stack!  This really shouldn't happen!  */
+	  emacs_abort ();
+	}
+    }
+
+  igc_xfree (rs->stack);
+  rs->stack = new_stack;
 }
 
 Lisp_Object *
@@ -3249,28 +3328,35 @@ igc_xzalloc_ambig (size_t size)
 void *
 igc_xnmalloc_ambig (ptrdiff_t nitems, ptrdiff_t item_size)
 {
-  return igc_xzalloc_ambig (nitems * item_size);
+  ptrdiff_t nbytes;
+  if (ckd_mul (&nbytes, nitems, item_size) || SIZE_MAX < nbytes)
+    memory_full (SIZE_MAX);
+  return igc_xzalloc_ambig (nbytes);
 }
 
 void *
 igc_realloc_ambig (void *block, size_t size)
 {
   struct igc *gc = global_igc;
-  void *p;
-  IGC_WITH_PARKED (gc)
-  {
-    igc_destroy_root_with_start (block);
-    /* Can't make a root that has zero length.  Want one to be able to
-       detect calling igc_free on something not having a root.  */
-    size_t new_size = (size == 0 ? IGC_ALIGN_DFLT : size);
-    p = xrealloc (block, new_size);
-    void *end = (char *)p + new_size;
-    root_create_ambig (global_igc, p, end, "realloc-ambig");
-  }
+  void *p = xzalloc (size);
+  struct igc_root_list *r = root_find (block);
+  ptrdiff_t old_size = (char *)r->d.end - (char *)r->d.start;
+  root_create_ambig (gc, p, (char *)p + size, "realloc-ambig");
+  mps_word_t *old_pw = block;
+  mps_word_t *new_pw = p;
+  for (ptrdiff_t i = 0; i < old_size / sizeof (mps_word_t); i++)
+    {
+      volatile mps_word_t word = old_pw[i];
+      if (memcmp ((void *)&word, old_pw + i, sizeof word))
+	emacs_abort ();
+      new_pw[i] = word;
+    }
+  memcpy (new_pw + (old_size / sizeof (mps_word_t)), old_pw + (old_size / sizeof (mps_word_t)),
+	  old_size % sizeof (mps_word_t));
+  igc_xfree (block);
   return p;
 }
 
-
 void
 igc_xfree (void *p)
 {
@@ -3284,17 +3370,23 @@ igc_xfree (void *p)
 }
 
 void *
-igc_xpalloc_ambig (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
+igc_xpalloc_ambig (void *old_pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
 		   ptrdiff_t nitems_max, ptrdiff_t item_size)
 {
-  IGC_WITH_PARKED (global_igc)
-  {
-    igc_destroy_root_with_start (pa);
-    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, "xpalloc-ambig");
-  }
-  return pa;
+  ptrdiff_t old_nitems = *nitems;
+  ptrdiff_t new_nitems = *nitems;
+  ptrdiff_t nbytes = xpalloc_nbytes (old_pa, &new_nitems, nitems_incr_min,
+				     nitems_max, item_size);
+  void *new_pa = xzalloc (nbytes);
+  char *end = (char *)new_pa + nbytes;
+  root_create_ambig (global_igc, new_pa, end, "xpalloc-ambig");
+  mps_word_t *old_word = old_pa;
+  mps_word_t *new_word = new_pa;
+  for (ptrdiff_t i = 0; i < (old_nitems * item_size) / sizeof (mps_word_t); i++)
+    new_word[i] = old_word[i];
+  *nitems = new_nitems;
+  igc_xfree (old_pa);
+  return new_pa;
 }
 
 void
@@ -3303,29 +3395,48 @@ igc_xpalloc_exact (void **pa_cell, ptrdiff_t *nitems,
 		   ptrdiff_t item_size, igc_scan_area_t scan_area,
 		   void *closure)
 {
-  IGC_WITH_PARKED (global_igc)
-  {
-    void *pa = *pa_cell;
-    igc_destroy_root_with_start (pa);
-    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 (), (mps_area_scan_t) scan_area,
-		 closure, false, "xpalloc-exact");
-    *pa_cell = pa;
-  }
+  void *old_pa = *pa_cell;
+  ptrdiff_t old_nitems = *nitems;
+  ptrdiff_t new_nitems = *nitems;
+  ptrdiff_t nbytes = xpalloc_nbytes (old_pa, &new_nitems, nitems_incr_min,
+				     nitems_max, item_size);
+  void *new_pa = xzalloc (nbytes);
+  char *end = (char *)new_pa + nbytes;
+  root_create (global_igc, new_pa, end, mps_rank_exact (), (mps_area_scan_t) scan_area,
+	       closure, false, "xpalloc-exact");
+  for (ptrdiff_t i = 0; i < (old_nitems); i++)
+    {
+      volatile mps_word_t area[(item_size + (sizeof (mps_word_t) - 1)) / (sizeof (mps_word_t))];
+      memcpy ((void *)area, (char *)old_pa + item_size * i, item_size);
+      if (memcmp ((void *)area, (char *)old_pa + item_size * i, item_size))
+	emacs_abort ();
+      memcpy ((char *)new_pa + item_size * i, (void *)area, item_size);
+    }
+  if (memcmp (old_pa, new_pa, old_nitems * item_size))
+    emacs_abort ();
+  eassert ((item_size) % sizeof (mps_word_t) == 0);
+  *pa_cell = new_pa;
+  *nitems = new_nitems;
+  igc_xfree (old_pa);
 }
 
 void *
-igc_xnrealloc_ambig (void *pa, ptrdiff_t nitems, ptrdiff_t item_size)
+igc_xnrealloc_ambig (void *old_pa, ptrdiff_t nitems, ptrdiff_t item_size)
 {
-  IGC_WITH_PARKED (global_igc)
-  {
-    igc_destroy_root_with_start (pa);
-    pa = xnrealloc (pa, nitems, item_size);
-    char *end = (char *) pa + nitems * item_size;
-    root_create_ambig (global_igc, pa, end, "xnrealloc-ambig");
-  }
-  return pa;
+  struct igc_root_list *r = root_find (old_pa);
+  ptrdiff_t old_nbytes = (char *)r->d.end - (char *)r->d.start;
+  ptrdiff_t nbytes;
+  if (ckd_mul (&nbytes, nitems, item_size) || SIZE_MAX < nbytes)
+    memory_full (SIZE_MAX);
+  void *new_pa = xzalloc (nbytes);
+  char *end = (char *) new_pa + nbytes;
+  root_create_ambig (global_igc, new_pa, end, "xnrealloc-ambig");
+  memcpy (new_pa, old_pa, old_nbytes);
+  if (memcmp (new_pa, old_pa, old_nbytes))
+    emacs_abort ();
+  igc_xfree (old_pa);
+
+  return new_pa;
 }
 
 static void
@@ -4408,9 +4519,9 @@ larger_marker_vector (Lisp_Object v)
   ptrdiff_t old_len = NILP (v) ? 0 : ASIZE (v);
   ptrdiff_t new_len = max (2, 2 * old_len);
   Lisp_Object new_v = alloc_marker_vector (new_len, Qnil);
-  ptrdiff_t i = 0;
+  ptrdiff_t i = 1;
   if (VECTORP (v))
-    for (i = 1; i < ASIZE (v); ++i)
+    for (; i < ASIZE (v); ++i)
       ASET (new_v, i, AREF (v, i));
   for (; i < ASIZE (new_v) - 1; ++i)
     ASET (new_v, i, make_fixnum (i + 1));
@@ -4430,6 +4541,8 @@ igc_add_marker (struct buffer *b, struct Lisp_Marker *m)
       v = BUF_MARKERS (b) = larger_marker_vector (v);
       next_free = XFIXNUM (AREF (v, 0));
     }
+  /* unrelated; triggered during testing */
+  eassert (FIXNUMP (AREF (v, next_free)));
   ASET (v, 0, AREF (v, next_free));
   ASET (v, next_free, make_lisp_ptr (m, Lisp_Vectorlike));
   m->index = next_free;
diff --git a/src/igc.h b/src/igc.h
index d4be8e4c03d..7ccb931550d 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -141,6 +141,8 @@ #define EMACS_IGC_H
 specpdl_ref igc_park_arena (void);
 void igc_postmortem (void);
 void igc_on_grow_specpdl (void);
+void igc_replace_specpdl (volatile union specbinding *old_specpdl, ptrdiff_t old_nitems,
+			  volatile union specbinding *new_specpdl, ptrdiff_t new_nitems);
 void igc_on_alloc_main_thread_specpdl (void);
 void igc_on_alloc_main_thread_bc (void);
 void igc_on_staticpros_complete (void);
diff --git a/src/lisp.h b/src/lisp.h
index 7dfcda223df..e48e1c5e121 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3799,7 +3799,7 @@ #define DEFVAR_KBOARD(lname, vname, doc)			\
 enum specbind_tag
 {
 # ifdef HAVE_MPS
-  SPECPDL_FREE,
+  SPECPDL_FREE = 0, /* must be 0 so xzalloc'd memory scrans without crashing */
 # endif
   SPECPDL_UNWIND,		/* An unwind_protect function on Lisp_Object.  */
   SPECPDL_UNWIND_ARRAY,		/* Likewise, on an array that needs freeing.
@@ -5903,6 +5903,7 @@ NATIVE_COMP_FUNCTION_DYNP (Lisp_Object a)
   ATTRIBUTE_MALLOC_SIZE ((1,2)) ATTRIBUTE_RETURNS_NONNULL;
 extern void *xnrealloc (void *, ptrdiff_t, ptrdiff_t)
   ATTRIBUTE_ALLOC_SIZE ((2,3)) ATTRIBUTE_RETURNS_NONNULL;
+extern ptrdiff_t xpalloc_nbytes (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t);
 extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t)
   ATTRIBUTE_RETURNS_NONNULL;
 
diff --git a/src/print.c b/src/print.c
index 6fc13d4dd39..fc689d11e7a 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1402,12 +1402,13 @@ pp_stack_push_values (Lisp_Object vectorlike, ptrdiff_t start, ptrdiff_t n)
     return;
   if (ppstack.sp >= ppstack.size)
     grow_pp_stack ();
+  memset (&ppstack.stack[ppstack.sp], 0, sizeof ppstack.stack[ppstack.sp]);
+  ppstack.stack[ppstack.sp].is_free = false;
   ppstack.stack[ppstack.sp++]
     = (struct print_pp_entry){.start = start,
 			      .n = n,
 			      .u.vectorlike = vectorlike
 			     };
-  ppstack.stack[ppstack.sp - 1].is_free = false;
 }
 #else
 static inline void
@@ -2222,7 +2223,7 @@ named_escape (int i)
 enum print_entry_type
 {
 #ifdef HAVE_MPS
-  PE_free,
+  PE_free = 0, /* must be zero so xzalloc'd memory scans without crashing */
 #endif
   PE_list,			/* print rest of list */
   PE_rbrac,			/* print ")" */
-- 
2.48.1