Subject: Re: bug#78898: Make read/readevalloop reentrant

From: Lynn Winebarger <[email-masked]>
Date: Wed, 30 Jul 2025 09:08:45 -0400

On Mon, Jul 28, 2025 at 8:09 PM Lynn Winebarger <[email-masked]> wrote:
> If you look at the code after applying all three patches, I think the
> code is actually simpler, and possibly faster.  I can add guard rails
> for dealing with the risk of stack overflow.  If you really need to
> support unbounded expression depth, I can special case allocation of
> stack to handle extraordinarily deep expressions.  However, I'm not
> sure how much benefit there is to being able to process an ELC file
> that has a correct header followed by, say  a million left parentheses
> and then the EOF.  If a user wants to handle such outliers, I think
> they can be handled without the level of performance provided for more
> realistic cases.   For example, by allocating a memory segment with
> one read stack entry for every byte of the input file to use as the
> read stack.

I reviewed the material on storage duration in C on cppreference.com.
Except for variable length arrays, the storage of objects in variables
is determined on block entry, not at the declaration.  As long as no
VLAs are declared in the function scope past the read_obj label, the
block scope wrapping the code from that label to the end is
unnecessary.  So I removed that, reverted the whitespace changes, and
squashed it all into one change.

Without the added block scope, the change becomes very simple.   No
new test failures (relative to the baseline commit of master) have
been added.  I can add a slow path for the case where the stack is
almost overflowing or the input is just ridiculously complicated.  For
files being loaded, I'd prefer to add a different source type that
either memory maps the file or slurps it into memory so we can safely
gauge a worst-case size for the slow path.  A similar approach would
apply to buffers, since they are already in memory.  For other stream
types being read, I think erroring out on expressions that would
overflow the stack is reasonable, given I can build emacs and run all
the tests without an overflow.  Stefan's preferred benchmark technique
would be problematic though.  It would almost certainly either
overflow or take the slow path.

I haven't rebased my development branch to the updates in lread.c on
master this morning.  I evidently don't understand how to maintain the
bare clone I made of the emacs repo to let myself use multiple local
working trees.
From 6cecf49ade1f088b25c7cc1ef19788f5c35c9a33 Mon Sep 17 00:00:00 2001
From: owinebar <[email-masked]>
Date: Wed, 30 Jul 2025 01:30:49 -0400
Subject: [PATCH] Simplify the read stack.

Incremental step in improving re-entrancy of lisp reader routines
(Bug#78898).  The read stack used by read0 is allocated on the C stack.
The read stack is extended downward as needed when control transfers to
the read_obj label. This eliminates the need to copy the stack when it
is extended.  The operations managing the stack are strength-reduced.
The constants used for the size of incremental read stack allocation
are not tuned.
* src/lread.c (read0): Allocate the read stack with alloca.  Extend the
stack on entry to read_obj label if the stack is full.
* src/lread.c (read_stack_top, read_stack_pop, read_stack_empty_p)
(read_stack_push): First argument is pointer to read stack.  All callers
changed.  Reflect direction of stack growth downward.
* src/lread.c (current_read_stack_reset): Unwind protect handler to pop
the stack of read stacks.
---
 src/lread.c | 184 ++++++++++++++++++++++++++++------------------------
 1 file changed, 100 insertions(+), 84 deletions(-)

diff --git a/src/lread.c b/src/lread.c
index 54b74b18782..5c7fb17814f 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3841,7 +3841,7 @@ skip_space_and_comments (source_t *source)
   RE_numbered,			/* "#" (+ DIGIT) "=" */
 };
 
-struct read_stack_entry
+typedef struct read_stack_entry
 {
   enum read_entry_type type;
   union {
@@ -3869,24 +3869,24 @@ skip_space_and_comments (source_t *source)
       Lisp_Object placeholder;	/* placeholder object */
     } numbered;
   } u;
-};
+} read_stack_entry_t;
 
-struct read_stack
+typedef struct read_stack
 {
-  struct read_stack_entry *stack;  /* base of stack */
-  ptrdiff_t size;		   /* allocated size in entries */
-  ptrdiff_t sp;			   /* current number of entries */
-};
+  read_stack_entry_t *bottom;  /* base of stack */
+  read_stack_entry_t *end  ;  /* boundary of stack allocation */
+  read_stack_entry_t *top;	   /* top item of stack */
+  struct read_stack *prev;         /* stack of previous read0 activation */
+} read_stack_t;
 
-static struct read_stack rdstack = {NULL, 0, 0};
+/* This is solely for the benefit of the GC */
+static read_stack_t *current_rdstack = NULL;
 
-void
-mark_lread (void)
+static void
+mark_read_stack (read_stack_t *rdstack)
 {
-  /* Mark the read stack, which may contain data not otherwise traced */
-  for (ptrdiff_t i = 0; i < rdstack.sp; i++)
+  for (struct read_stack_entry *e = rdstack->top - 1; e <= rdstack->bottom; e++)
     {
-      struct read_stack_entry *e = &rdstack.stack[i];
       switch (e->type)
 	{
 	case RE_list_start:
@@ -3915,48 +3915,44 @@ mark_lread (void)
     }
 }
 
-static inline struct read_stack_entry *
-read_stack_top (void)
+void
+mark_lread (void)
 {
-  eassume (rdstack.sp > 0);
-  return &rdstack.stack[rdstack.sp - 1];
+  read_stack_t *stack = current_rdstack;
+  /* Mark the read stack, which may contain data not otherwise traced */
+  while (stack)
+    {
+      mark_read_stack (stack);
+      stack = stack->prev;
+    }
 }
 
-static inline struct read_stack_entry *
-read_stack_pop (void)
+static inline read_stack_entry_t *
+read_stack_top (read_stack_t *rdstack)
 {
-  eassume (rdstack.sp > 0);
-  return &rdstack.stack[--rdstack.sp];
+  eassume (rdstack->top < rdstack->bottom);
+  return rdstack->top + 1;
 }
 
-static inline bool
-read_stack_empty_p (ptrdiff_t base_sp)
+static inline read_stack_entry_t *
+read_stack_pop (read_stack_t *rdstack)
 {
-  return rdstack.sp <= base_sp;
+  eassume (rdstack->top < rdstack->bottom);
+  return ++rdstack->top;
 }
 
-NO_INLINE static void
-grow_read_stack (void)
+static inline bool
+read_stack_empty_p (read_stack_t *rdstack)
 {
-  struct read_stack *rs = &rdstack;
-  eassert (rs->sp == rs->size);
-  rs->stack = xpalloc (rs->stack, &rs->size, 1, -1, sizeof *rs->stack);
-  eassert (rs->sp < rs->size);
+  eassume (rdstack->top <= rdstack->bottom);
+  return rdstack->top >= rdstack->bottom;
 }
 
 static inline void
-read_stack_push (struct read_stack_entry e)
+read_stack_push (read_stack_t *rdstack, read_stack_entry_t e)
 {
-  if (rdstack.sp >= rdstack.size)
-    grow_read_stack ();
-  rdstack.stack[rdstack.sp++] = e;
-}
-
-static void
-read_stack_reset (intmax_t sp)
-{
-  eassert (sp <= rdstack.sp);
-  rdstack.sp = sp;
+  eassume (rdstack->top > rdstack->end);
+  *(rdstack->top--) = e;
 }
 
 typedef struct {
@@ -4006,6 +4002,19 @@ read_and_buffer (readbuf_t *rb, source_t *source)
   return c;
 }
 
+enum read_stack_increment
+{
+  RSI_initial = 40,
+  RSI_incr = 20,
+  RSI_min = 1,
+};
+
+static void
+current_read_stack_reset (void *prev)
+{
+  current_rdstack = (read_stack_t *) prev;
+}
+
 /* Read a Lisp object.
    If LOCATE_SYMS is true, symbols are read with position.  */
 static Lisp_Object
@@ -4014,19 +4023,26 @@ read0 (source_t *source, bool locate_syms)
   char stackbuf[64];
 
   specpdl_ref base_pdl = SPECPDL_INDEX ();
-  ptrdiff_t base_sp = rdstack.sp;
-  record_unwind_protect_intmax (read_stack_reset, base_sp);
 
+  bool uninterned_symbol;
+  bool skip_shorthand;
+  read_stack_t rdstack = { NULL, NULL, NULL, current_rdstack };
+  record_unwind_protect_ptr (current_read_stack_reset, current_rdstack);
   readbuf_t rb = { .start = stackbuf,
 		   .end = stackbuf + sizeof stackbuf,
 		   .heapbuf = NULL,
 		   .count = SPECPDL_INDEX () };
 
-  bool uninterned_symbol;
-  bool skip_shorthand;
-
+  rdstack.end = ((read_stack_entry_t *) alloca (RSI_initial * sizeof (read_stack_entry_t))) - 1;
+  rdstack.bottom = rdstack.end + RSI_initial;
+  rdstack.top = rdstack.bottom;
+  eassume (((void *) rdstack.bottom) <= ((void *) (&rdstack - 1)));
+  eassume (rdstack.top >= rdstack.end);
+  current_rdstack = &rdstack;
   /* Read an object into `obj'.  */
  read_obj: ;
+  if ((rdstack.top - RSI_min) <= rdstack.end)
+    rdstack.end = ((read_stack_entry_t *) alloca (RSI_incr * sizeof (read_stack_entry_t))) - 1;
   Lisp_Object obj;
   int c = readchar (source);
   if (c < 0)
@@ -4035,25 +4051,25 @@ read0 (source_t *source, bool locate_syms)
   switch (c)
     {
     case '(':
-      read_stack_push ((struct read_stack_entry) {.type = RE_list_start});
+      read_stack_push (&rdstack, (struct read_stack_entry) {.type = RE_list_start});
       goto read_obj;
 
     case ')':
-      if (read_stack_empty_p (base_sp))
+      if (read_stack_empty_p (&rdstack))
 	invalid_syntax (")", source);
-      switch (read_stack_top ()->type)
+      switch (read_stack_top (&rdstack)->type)
 	{
 	case RE_list_start:
-	  read_stack_pop ();
+	  read_stack_pop (&rdstack);
 	  obj = Qnil;
 	  break;
 	case RE_list:
-	  obj = read_stack_pop ()->u.list.head;
+	  obj = read_stack_pop (&rdstack)->u.list.head;
 	  break;
 	case RE_record:
 	  {
-	    locate_syms = read_stack_top ()->u.vector.old_locate_syms;
-	    Lisp_Object elems = Fnreverse (read_stack_pop ()->u.vector.elems);
+	    locate_syms = read_stack_top (&rdstack)->u.vector.old_locate_syms;
+	    Lisp_Object elems = Fnreverse (read_stack_pop (&rdstack)->u.vector.elems);
 	    if (NILP (elems))
 	      invalid_syntax ("#s", source);
 
@@ -4064,8 +4080,8 @@ read0 (source_t *source, bool locate_syms)
 	    break;
 	  }
 	case RE_string_props:
-	  locate_syms = read_stack_top ()->u.vector.old_locate_syms;
-	  obj = string_props_from_rev_list (read_stack_pop () ->u.vector.elems,
+	  locate_syms = read_stack_top (&rdstack)->u.vector.old_locate_syms;
+	  obj = string_props_from_rev_list (read_stack_pop (&rdstack) ->u.vector.elems,
 					    source);
 	  break;
 	default:
@@ -4074,7 +4090,7 @@ read0 (source_t *source, bool locate_syms)
       break;
 
     case '[':
-      read_stack_push ((struct read_stack_entry) {
+      read_stack_push (&rdstack, (struct read_stack_entry) {
 	  .type = RE_vector,
 	  .u.vector.elems = Qnil,
 	  .u.vector.old_locate_syms = locate_syms,
@@ -4083,27 +4099,27 @@ read0 (source_t *source, bool locate_syms)
       goto read_obj;
 
     case ']':
-      if (read_stack_empty_p (base_sp))
+      if (read_stack_empty_p (&rdstack))
 	invalid_syntax ("]", source);
-      switch (read_stack_top ()->type)
+      switch (read_stack_top (&rdstack)->type)
 	{
 	case RE_vector:
-	  locate_syms = read_stack_top ()->u.vector.old_locate_syms;
-	  obj = vector_from_rev_list (read_stack_pop ()->u.vector.elems);
+	  locate_syms = read_stack_top (&rdstack)->u.vector.old_locate_syms;
+	  obj = vector_from_rev_list (read_stack_pop (&rdstack)->u.vector.elems);
 	  break;
 	case RE_byte_code:
-	  locate_syms = read_stack_top ()->u.vector.old_locate_syms;
-	  obj = bytecode_from_rev_list (read_stack_pop ()->u.vector.elems,
+	  locate_syms = read_stack_top (&rdstack)->u.vector.old_locate_syms;
+	  obj = bytecode_from_rev_list (read_stack_pop (&rdstack)->u.vector.elems,
 					source);
 	  break;
 	case RE_char_table:
-	  locate_syms = read_stack_top ()->u.vector.old_locate_syms;
-	  obj = char_table_from_rev_list (read_stack_pop ()->u.vector.elems,
+	  locate_syms = read_stack_top (&rdstack)->u.vector.old_locate_syms;
+	  obj = char_table_from_rev_list (read_stack_pop (&rdstack)->u.vector.elems,
 					  source);
 	  break;
 	case RE_sub_char_table:
-	  locate_syms = read_stack_top ()->u.vector.old_locate_syms;
-	  obj = sub_char_table_from_rev_list (read_stack_pop ()->u.vector.elems,
+	  locate_syms = read_stack_top (&rdstack)->u.vector.old_locate_syms;
+	  obj = sub_char_table_from_rev_list (read_stack_pop (&rdstack)->u.vector.elems,
 					      source);
 	  break;
 	default:
@@ -4121,7 +4137,7 @@ read0 (source_t *source, bool locate_syms)
 	  {
 	  case '\'':
 	    /* #'X -- special syntax for (function X) */
-	    read_stack_push ((struct read_stack_entry) {
+	    read_stack_push (&rdstack, (struct read_stack_entry) {
 		.type = RE_special,
 		.u.special.symbol = Qfunction,
 	      });
@@ -4140,7 +4156,7 @@ read0 (source_t *source, bool locate_syms)
 		unreadchar (source, ch);
 		invalid_syntax_with_buffer (&rb, source);
 	      }
-	    read_stack_push ((struct read_stack_entry) {
+	    read_stack_push (&rdstack, (struct read_stack_entry) {
 		.type = RE_record,
 		.u.vector.elems = Qnil,
 		.u.vector.old_locate_syms = locate_syms,
@@ -4157,7 +4173,7 @@ read0 (source_t *source, bool locate_syms)
 		ch = read_and_buffer (&rb, source);
 		if (ch == '[')
 		  {
-		    read_stack_push ((struct read_stack_entry) {
+		    read_stack_push (&rdstack, (struct read_stack_entry) {
 			.type = RE_sub_char_table,
 			.u.vector.elems = Qnil,
 			.u.vector.old_locate_syms = locate_syms,
@@ -4173,7 +4189,7 @@ read0 (source_t *source, bool locate_syms)
 	      }
 	    else if (ch == '[')
 	      {
-		read_stack_push ((struct read_stack_entry) {
+		read_stack_push (&rdstack, (struct read_stack_entry) {
 		    .type = RE_char_table,
 		    .u.vector.elems = Qnil,
 		    .u.vector.old_locate_syms = locate_syms,
@@ -4189,7 +4205,7 @@ read0 (source_t *source, bool locate_syms)
 
 	  case '(':
 	    /* #(...) -- string with properties */
-	    read_stack_push ((struct read_stack_entry) {
+	    read_stack_push (&rdstack, (struct read_stack_entry) {
 		.type = RE_string_props,
 		.u.vector.elems = Qnil,
 		.u.vector.old_locate_syms = locate_syms,
@@ -4199,7 +4215,7 @@ read0 (source_t *source, bool locate_syms)
 
 	  case '[':
 	    /* #[...] -- byte-code */
-	    read_stack_push ((struct read_stack_entry) {
+	    read_stack_push (&rdstack, (struct read_stack_entry) {
 		.type = RE_byte_code,
 		.u.vector.elems = Qnil,
 		.u.vector.old_locate_syms = locate_syms,
@@ -4326,7 +4342,7 @@ read0 (source_t *source, bool locate_syms)
 			  set_hash_value_slot (h, i, placeholder);
 			else
 			  hash_put (h, number, placeholder, hash);
-			read_stack_push ((struct read_stack_entry) {
+			read_stack_push (&rdstack, (struct read_stack_entry) {
 			    .type = RE_numbered,
 			    .u.numbered.number = number,
 			    .u.numbered.placeholder = placeholder,
@@ -4365,14 +4381,14 @@ read0 (source_t *source, bool locate_syms)
       break;
 
     case '\'':
-      read_stack_push ((struct read_stack_entry) {
+      read_stack_push (&rdstack, (struct read_stack_entry) {
 	  .type = RE_special,
 	  .u.special.symbol = Qquote,
 	});
       goto read_obj;
 
     case '`':
-      read_stack_push ((struct read_stack_entry) {
+      read_stack_push (&rdstack, (struct read_stack_entry) {
 	  .type = RE_special,
 	  .u.special.symbol = Qbackquote,
 	});
@@ -4390,7 +4406,7 @@ read0 (source_t *source, bool locate_syms)
 	      unreadchar (source, ch);
 	    sym = Qcomma;
 	  }
-	read_stack_push ((struct read_stack_entry) {
+	read_stack_push (&rdstack, (struct read_stack_entry) {
 	    .type = RE_special,
 	    .u.special.symbol = sym,
 	  });
@@ -4415,10 +4431,10 @@ read0 (source_t *source, bool locate_syms)
 	    || nch == '(' || nch == '[' || nch == '#'
 	    || nch == '?' || nch == '`' || nch == ',')
 	  {
-	    if (!read_stack_empty_p (base_sp)
-		&& read_stack_top ()->type ==  RE_list)
+	    if (!read_stack_empty_p (&rdstack)
+		&& read_stack_top (&rdstack)->type ==  RE_list)
 	      {
-		read_stack_top ()->type = RE_list_dot;
+		read_stack_top (&rdstack)->type = RE_list_dot;
 		goto read_obj;
 	      }
 	    invalid_syntax (".", source);
@@ -4545,9 +4561,9 @@ read0 (source_t *source, bool locate_syms)
 
   /* We have read an object in `obj'.  Use the stack to decide what to
      do with it.  */
-  while (rdstack.sp > base_sp)
+  while (rdstack.top < rdstack.bottom)
     {
-      struct read_stack_entry *e = read_stack_top ();
+      struct read_stack_entry *e = read_stack_top (&rdstack);
       switch (e->type)
 	{
 	case RE_list_start:
@@ -4570,7 +4586,7 @@ read0 (source_t *source, bool locate_syms)
 	    if (ch != ')')
 	      invalid_syntax ("expected )", source);
 	    XSETCDR (e->u.list.tail, obj);
-	    read_stack_pop ();
+	    read_stack_pop (&rdstack);
 	    obj = e->u.list.head;
 
 	    /* Hack: immediately convert (#$ . FIXNUM) to the corresponding
@@ -4594,13 +4610,13 @@ read0 (source_t *source, bool locate_syms)
 	  goto read_obj;
 
 	case RE_special:
-	  read_stack_pop ();
+	  read_stack_pop (&rdstack);
 	  obj = list2 (e->u.special.symbol, obj);
 	  break;
 
 	case RE_numbered:
 	  {
-	    read_stack_pop ();
+	    read_stack_pop (&rdstack);
 	    Lisp_Object placeholder = e->u.numbered.placeholder;
 	    if (CONSP (obj))
 	      {
-- 
2.50.1