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

From: Lynn Winebarger <[email-masked]>
Date: Mon, 28 Jul 2025 20:09:56 -0400

On Mon, Jul 28, 2025 at 7:57 AM Mattias Engdegård
<[email-masked]> wrote:
>
> 24 juli 2025 kl. 00.53 skrev Lynn Winebarger <[email-masked]>:
>
> > (1) Just reserve a conservatively large amount of stack space at the start and abort if it's exceeded.  A lisp variable could be used to let the user change the size of the reserved space between activations of read0, like the maximum lisp recursion depth.
> >
> > (2). Allocate an array in the C stack on entry to read0 for the reader stack.  During the parse, if all array entries are used, just use C recursion to call read0.
> >
> > (3) Reverse the order of call and return in the recursion of option (2).  Meaning, enter read0 with a trampoline that allocates the reader stack with alloca.  On entry to the read_obj label,  check that there is enough stack space for the maximum number of entries that can be pushed before control returns to read_obj.  If there is not enough space, return to the trampoline.  The trampoline calls read0 in a do...while loop as long as the stack is nonempty, then returns.  Since the read stack is implemented in a simple trampoline function, each alloca just extends the initial reader stack array, so growing that array never requires copying.
>
The attached patch set implements what I described as option (3') in
the original email.  I've tested the resulting code both with and
without native compilation at -O0, and without native compilation at
the default optimization level, and no new test failures are
introduced (versus commit e3380ed6db7a1c1574c4b39d58f9200a3ffab).  In
fact one test failure went away in one of the configurations, though I
have no idea why.  It implements

> Thank you, but it's not quite what we had in mind so I think we'll pass on that for now.
>
> More generally, it's not entirely clear what concrete problem you are actually trying to solve.

Well, this is the first time in my adult life I haven't had an
employer claiming to own every idea or even potential production of
intellectual property regardless of whether it is properly in the
course of employment, so I'm letting myself have some fun with a
program I've liked for most of that adult life.  So, there's no simple
concrete problem beyond the statement of the bug itself.  I think
Stefan had my number on that.

But, I do have a number of ideas for longer term projects to improve
my favorite editor, like making the lisp machine more concurrency
friendly.  For example, eliminating static variables/global state is
part of that, and the reader ecosystem seems like a good place for me
to start.  I also want to add lisp objects for capturing grammatical
structure at a more abstract level than tree-sitter (e.g. supporting
an updated Semantic framework), and integrating the construction of
such objects into the lisp reader would be one project.

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.

Lynn
From 44f3b61ed88841e100c539beb38b073e4ef5b9a9 Mon Sep 17 00:00:00 2001
From: owinebar <[email-masked]>
Date: Sun, 27 Jul 2025 23:48:35 -0400
Subject: [PATCH 1/3] Allocate reader stack on C stack

Incremental step in improving re-entrancy of lisp reader routines
(Bug#78898).  The read stack used by an entry to read0 is allocated for
that call on the C stack.  The read stack is extended downward as
needed using a trampoline function and reversing the order of
call/return ordinarily used for recursion.  The constants used for the
size of incremental read stack allocation are not tuned.
* src/lread.c (read0): First parameter is pointer to a read stack.
Must be entered by calling read0-trampoline. All callers changed. At
most one stack entry is pushed between entry to read_obj label.  If
there is not room on the read stack at the entry to read_obj, then
return to read0-trampoline, which will extend the stack and recurse back
to read0.
* src/lread.c (read0-trampoline): Entry point for read0 that manages the
read stack allocation.
* 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 | 198 ++++++++++++++++++++++++++++++----------------------
 1 file changed, 113 insertions(+), 85 deletions(-)

diff --git a/src/lread.c b/src/lread.c
index 54b74b18782..af10356fb0d 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -733,7 +733,7 @@ read_emacs_mule_char (source_t *src, int c)
 
 static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
                                         Lisp_Object, bool);
-static Lisp_Object read0 (source_t *source, bool locate_syms);
+static Lisp_Object read0_trampoline (source_t *source, bool locate_syms);
 
 static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object);
 static void substitute_in_interval (INTERVAL, void *);
@@ -2548,7 +2548,7 @@ readevalloop (Lisp_Object readcharfun,
 	read_objects_completed
 	  = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None);
       if (!NILP (Vpurify_flag) && c == '(')
-	val = read0 (&source, false);
+	val = read0_trampoline (&source, false);
       else
 	{
 	  if (!NILP (readfun))
@@ -2813,7 +2813,7 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end,
 
   source_t source;
   init_source (&source, stream);
-  retval = read0 (&source, locate_syms);
+  retval = read0_trampoline (&source, locate_syms);
   if (HASH_TABLE_P (read_objects_map)
       && XHASH_TABLE (read_objects_map)->count > 0)
     read_objects_map = Qnil;
@@ -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; 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)
-{
-  if (rdstack.sp >= rdstack.size)
-    grow_read_stack ();
-  rdstack.stack[rdstack.sp++] = e;
-}
-
-static void
-read_stack_reset (intmax_t sp)
+read_stack_push (read_stack_t *rdstack, read_stack_entry_t e)
 {
-  eassert (sp <= rdstack.sp);
-  rdstack.sp = sp;
+  eassume (rdstack->top > rdstack->end);
+  *(rdstack->top--) = e;
 }
 
 typedef struct {
@@ -4006,16 +4002,46 @@ 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 Lisp_Object read0 (read_stack_t *rdstack, source_t *source,
+			  bool locate_syms);
+
+static NO_INLINE Lisp_Object
+read0_trampoline (source_t *source, bool locate_syms)
+{
+  Lisp_Object rv = Qnil;
+  read_stack_t rdstack = { NULL, NULL, NULL, current_rdstack };
+  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)));
+  /* Using goto to ensure the stack is not unintentionally altered by
+     entry to a block scope */
+ call_read0:
+  eassume (rdstack.top >= rdstack.end);
+  rv = read0 (&rdstack, source, locate_syms);
+  /* This condition is true */
+  if ((rdstack.top == rdstack.bottom)
+      && ((current_rdstack = rdstack.prev) == rdstack.prev))
+    return rv;
+  rdstack.end = ((read_stack_entry_t *) alloca (RSI_incr * sizeof (read_stack_entry_t))) - 1;
+  goto call_read0;
+}
+
 /* Read a Lisp object.
    If LOCATE_SYMS is true, symbols are read with position.  */
 static Lisp_Object
-read0 (source_t *source, bool locate_syms)
+read0 (read_stack_t *rdstack, 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);
 
   readbuf_t rb = { .start = stackbuf,
 		   .end = stackbuf + sizeof stackbuf,
@@ -4027,6 +4053,8 @@ read0 (source_t *source, bool locate_syms)
 
   /* Read an object into `obj'.  */
  read_obj: ;
+  if ((rdstack->top - RSI_min) <= rdstack->end)
+    return Qnil;
   Lisp_Object obj;
   int c = readchar (source);
   if (c < 0)
@@ -4035,25 +4063,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 +4092,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 +4102,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 +4111,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 +4149,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 +4168,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 +4185,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 +4201,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 +4217,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 +4227,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 +4354,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 +4393,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 +4418,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 +4443,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 +4573,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 +4598,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 +4622,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

From a951bac93ee5c818158db6ae88b1789d3e6ae0a8 Mon Sep 17 00:00:00 2001
From: owinebar <[email-masked]>
Date: Mon, 28 Jul 2025 19:06:57 -0400
Subject: [PATCH 3/3] Manage GC root for read stack

Ensure GC root for the read stack is maintained.
* src/lread.c (current_read_stack_reset): Unwind protect handler to pop
the stack of read stacks.
* src/lread.c (read0): Push the new read stack on the GC root,
current_rdstack.
* src/lread.c (mark_lread): Correct an off-by-one error.
---
 src/lread.c | 19 +++++++++++++------
 1 file changed, 13 insertions(+), 6 deletions(-)

diff --git a/src/lread.c b/src/lread.c
index f891b72c2c9..5bee36c205d 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3885,7 +3885,7 @@ skip_space_and_comments (source_t *source)
 static void
 mark_read_stack (read_stack_t *rdstack)
 {
-  for (struct read_stack_entry *e = rdstack->top; e <= rdstack->bottom; e++)
+  for (struct read_stack_entry *e = rdstack->top - 1; e <= rdstack->bottom; e++)
     {
       switch (e->type)
 	{
@@ -4009,6 +4009,11 @@ read_and_buffer (readbuf_t *rb, source_t *source)
   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.  */
@@ -4019,28 +4024,30 @@ read0 (source_t *source, bool locate_syms)
 
   specpdl_ref base_pdl = SPECPDL_INDEX ();
 
+  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;
-  read_stack_t rdstack = { NULL, NULL, NULL, current_rdstack };
   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;
   goto read_obj;
  extend_rdstack:
   rdstack.end = ((read_stack_entry_t *) alloca (RSI_incr * sizeof (read_stack_entry_t))) - 1;
 
   /* Read an object into `obj'.  */
  read_obj: ;
+  if ((rdstack.top - RSI_min) <= rdstack.end)
+    goto extend_rdstack;
   {
-    if ((rdstack.top - RSI_min) <= rdstack.end)
-      goto extend_rdstack;
     Lisp_Object obj;
     int c = readchar (source);
     if (c < 0)
-- 
2.50.1

From d17398d4fd7dd6947ff339195c0a11f03cc5fa31 Mon Sep 17 00:00:00 2001
From: owinebar <[email-masked]>
Date: Mon, 28 Jul 2025 07:00:17 -0400
Subject: [PATCH 2/3] Inline read0_trampoline at return site

Eliminate return/call pattern by using block scope in read0.
* src/lread.c (read0): Wrap everything following read_obj label in a
lexical block.  Integrate read_trampoline code into labels preceding
read_obj. Eliminate first parameter and do not enter from
read0_trampoline.
* src/lread.c (read_trampoline): Eliminated.  Callers call read0
instead.  All callers changed.
---
 src/lread.c | 1205 +++++++++++++++++++++++++--------------------------
 1 file changed, 596 insertions(+), 609 deletions(-)

diff --git a/src/lread.c b/src/lread.c
index af10356fb0d..f891b72c2c9 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -733,7 +733,7 @@ read_emacs_mule_char (source_t *src, int c)
 
 static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
                                         Lisp_Object, bool);
-static Lisp_Object read0_trampoline (source_t *source, bool locate_syms);
+static Lisp_Object read0 (source_t *source, bool locate_syms);
 
 static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object);
 static void substitute_in_interval (INTERVAL, void *);
@@ -2548,7 +2548,7 @@ readevalloop (Lisp_Object readcharfun,
 	read_objects_completed
 	  = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None);
       if (!NILP (Vpurify_flag) && c == '(')
-	val = read0_trampoline (&source, false);
+	val = read0 (&source, false);
       else
 	{
 	  if (!NILP (readfun))
@@ -2813,7 +2813,7 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end,
 
   source_t source;
   init_source (&source, stream);
-  retval = read0_trampoline (&source, locate_syms);
+  retval = read0 (&source, locate_syms);
   if (HASH_TABLE_P (read_objects_map)
       && XHASH_TABLE (read_objects_map)->count > 0)
     read_objects_map = Qnil;
@@ -4009,35 +4009,11 @@ read_and_buffer (readbuf_t *rb, source_t *source)
   RSI_min = 1,
 };
 
-static Lisp_Object read0 (read_stack_t *rdstack, source_t *source,
-			  bool locate_syms);
-
-static NO_INLINE Lisp_Object
-read0_trampoline (source_t *source, bool locate_syms)
-{
-  Lisp_Object rv = Qnil;
-  read_stack_t rdstack = { NULL, NULL, NULL, current_rdstack };
-  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)));
-  /* Using goto to ensure the stack is not unintentionally altered by
-     entry to a block scope */
- call_read0:
-  eassume (rdstack.top >= rdstack.end);
-  rv = read0 (&rdstack, source, locate_syms);
-  /* This condition is true */
-  if ((rdstack.top == rdstack.bottom)
-      && ((current_rdstack = rdstack.prev) == rdstack.prev))
-    return rv;
-  rdstack.end = ((read_stack_entry_t *) alloca (RSI_incr * sizeof (read_stack_entry_t))) - 1;
-  goto call_read0;
-}
 
 /* Read a Lisp object.
    If LOCATE_SYMS is true, symbols are read with position.  */
 static Lisp_Object
-read0 (read_stack_t *rdstack, source_t *source, bool locate_syms)
+read0 (source_t *source, bool locate_syms)
 {
   char stackbuf[64];
 
@@ -4050,641 +4026,652 @@ read0 (read_stack_t *rdstack, source_t *source, bool locate_syms)
 
   bool uninterned_symbol;
   bool skip_shorthand;
+  read_stack_t rdstack = { NULL, NULL, NULL, current_rdstack };
+  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);
+  goto read_obj;
+ extend_rdstack:
+  rdstack.end = ((read_stack_entry_t *) alloca (RSI_incr * sizeof (read_stack_entry_t))) - 1;
 
   /* Read an object into `obj'.  */
  read_obj: ;
-  if ((rdstack->top - RSI_min) <= rdstack->end)
-    return Qnil;
-  Lisp_Object obj;
-  int c = readchar (source);
-  if (c < 0)
-    end_of_file_error ();
+  {
+    if ((rdstack.top - RSI_min) <= rdstack.end)
+      goto extend_rdstack;
+    Lisp_Object obj;
+    int c = readchar (source);
+    if (c < 0)
+      end_of_file_error ();
 
-  switch (c)
-    {
-    case '(':
-      read_stack_push (rdstack, (struct read_stack_entry) {.type = RE_list_start});
-      goto read_obj;
-
-    case ')':
-      if (read_stack_empty_p (rdstack))
-	invalid_syntax (")", source);
-      switch (read_stack_top (rdstack)->type)
-	{
-	case RE_list_start:
-	  read_stack_pop (rdstack);
-	  obj = Qnil;
-	  break;
-	case RE_list:
-	  obj = read_stack_pop (rdstack)->u.list.head;
-	  break;
-	case RE_record:
+    switch (c)
+      {
+      case '(':
+	read_stack_push (&rdstack, (struct read_stack_entry) {.type = RE_list_start});
+	goto read_obj;
+
+      case ')':
+	if (read_stack_empty_p (&rdstack))
+	  invalid_syntax (")", source);
+	switch (read_stack_top (&rdstack)->type)
 	  {
-	    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);
+	  case RE_list_start:
+	    read_stack_pop (&rdstack);
+	    obj = Qnil;
+	    break;
+	  case RE_list:
+	    obj = read_stack_pop (&rdstack)->u.list.head;
+	    break;
+	  case RE_record:
+	    {
+	      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);
 
-	    if (BASE_EQ (XCAR (elems), Qhash_table))
-	      obj = hash_table_from_plist (XCDR (elems));
-	    else
-	      obj = record_from_list (elems);
+	      if (BASE_EQ (XCAR (elems), Qhash_table))
+		obj = hash_table_from_plist (XCDR (elems));
+	      else
+		obj = record_from_list (elems);
+	      break;
+	    }
+	  case RE_string_props:
+	    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:
+	    invalid_syntax (")", source);
 	  }
-	case RE_string_props:
-	  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:
-	  invalid_syntax (")", source);
-	}
-      break;
+	break;
 
-    case '[':
-      read_stack_push (rdstack, (struct read_stack_entry) {
-	  .type = RE_vector,
-	  .u.vector.elems = Qnil,
-	  .u.vector.old_locate_syms = locate_syms,
-	});
-      /* FIXME: should vectors be read with locate_syms=false?  */
-      goto read_obj;
-
-    case ']':
-      if (read_stack_empty_p (rdstack))
-	invalid_syntax ("]", source);
-      switch (read_stack_top (rdstack)->type)
-	{
-	case RE_vector:
-	  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 (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 (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 (rdstack)->u.vector.old_locate_syms;
-	  obj = sub_char_table_from_rev_list (read_stack_pop (rdstack)->u.vector.elems,
-					      source);
-	  break;
-	default:
-	  invalid_syntax ("]", source);
-	  break;
-	}
-      break;
+      case '[':
+	read_stack_push (&rdstack, (struct read_stack_entry) {
+	    .type = RE_vector,
+	    .u.vector.elems = Qnil,
+	    .u.vector.old_locate_syms = locate_syms,
+	  });
+	/* FIXME: should vectors be read with locate_syms=false?  */
+	goto read_obj;
 
-    case '#':
-      {
-	rb.cur = rb.start;
-	*rb.cur++ = '#';
-	int ch = read_and_buffer (&rb, source);
-	switch (ch)
+      case ']':
+	if (read_stack_empty_p (&rdstack))
+	  invalid_syntax ("]", source);
+	switch (read_stack_top (&rdstack)->type)
 	  {
-	  case '\'':
-	    /* #'X -- special syntax for (function X) */
-	    read_stack_push (rdstack, (struct read_stack_entry) {
-		.type = RE_special,
-		.u.special.symbol = Qfunction,
-	      });
-	    goto read_obj;
-
-	  case '#':
-	    /* ## -- the empty symbol */
-	    obj = Fintern (empty_unibyte_string, Qnil);
+	  case RE_vector:
+	    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 's':
-	    /* #s(...) -- a record or hash-table */
-	    ch = read_and_buffer (&rb, source);
-	    if (ch != '(')
-	      {
-		unreadchar (source, ch);
-		invalid_syntax_with_buffer (&rb, source);
-	      }
-	    read_stack_push (rdstack, (struct read_stack_entry) {
-		.type = RE_record,
-		.u.vector.elems = Qnil,
-		.u.vector.old_locate_syms = locate_syms,
-	      });
-	    locate_syms = false;
-	    goto read_obj;
-
-	  case '^':
-	    /* #^[...]  -- char-table
-	       #^^[...] -- sub-char-table */
-	    ch = read_and_buffer (&rb, source);
-	    if (ch == '^')
-	      {
-		ch = read_and_buffer (&rb, source);
-		if (ch == '[')
-		  {
-		    read_stack_push (rdstack, (struct read_stack_entry) {
-			.type = RE_sub_char_table,
-			.u.vector.elems = Qnil,
-			.u.vector.old_locate_syms = locate_syms,
-		      });
-		    locate_syms = false;
-		    goto read_obj;
-		  }
-		else
-		  {
-		    unreadchar (source, ch);
-		    invalid_syntax_with_buffer (&rb, source);
-		  }
-	      }
-	    else if (ch == '[')
-	      {
-		read_stack_push (rdstack, (struct read_stack_entry) {
-		    .type = RE_char_table,
-		    .u.vector.elems = Qnil,
-		    .u.vector.old_locate_syms = locate_syms,
-		  });
-		locate_syms = false;
-		goto read_obj;
-	      }
-	    else
-	      {
-		unreadchar (source, ch);
-		invalid_syntax_with_buffer (&rb, source);
-	      }
-
-	  case '(':
-	    /* #(...) -- string with properties */
-	    read_stack_push (rdstack, (struct read_stack_entry) {
-		.type = RE_string_props,
-		.u.vector.elems = Qnil,
-		.u.vector.old_locate_syms = locate_syms,
-	      });
-	    locate_syms = false;
-	    goto read_obj;
-
-	  case '[':
-	    /* #[...] -- byte-code */
-	    read_stack_push (rdstack, (struct read_stack_entry) {
-		.type = RE_byte_code,
-		.u.vector.elems = Qnil,
-		.u.vector.old_locate_syms = locate_syms,
-	      });
-	    locate_syms = false;
-	    goto read_obj;
-
-	  case '&':
-	    /* #&N"..." -- bool-vector */
-	    obj = read_bool_vector (source);
+	  case RE_byte_code:
+	    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 (&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 (&rdstack)->u.vector.old_locate_syms;
+	    obj = sub_char_table_from_rev_list (read_stack_pop (&rdstack)->u.vector.elems,
+						source);
+	    break;
+	  default:
+	    invalid_syntax ("]", source);
+	    break;
+	  }
+	break;
 
-	  case '!':
-	    /* #! appears at the beginning of an executable file.
-	       Skip the rest of the line.  */
+      case '#':
+	{
+	  rb.cur = rb.start;
+	  *rb.cur++ = '#';
+	  int ch = read_and_buffer (&rb, source);
+	  switch (ch)
 	    {
-	      int c;
-	      do
-		c = readchar (source);
-	      while (c >= 0 && c != '\n');
+	    case '\'':
+	      /* #'X -- special syntax for (function X) */
+	      read_stack_push (&rdstack, (struct read_stack_entry) {
+		  .type = RE_special,
+		  .u.special.symbol = Qfunction,
+		});
 	      goto read_obj;
-	    }
 
-	  case 'x':
-	  case 'X':
-	    obj = read_integer (source, 16);
-	    break;
+	    case '#':
+	      /* ## -- the empty symbol */
+	      obj = Fintern (empty_unibyte_string, Qnil);
+	      break;
 
-	  case 'o':
-	  case 'O':
-	    obj = read_integer (source, 8);
-	    break;
+	    case 's':
+	      /* #s(...) -- a record or hash-table */
+	      ch = read_and_buffer (&rb, source);
+	      if (ch != '(')
+		{
+		  unreadchar (source, ch);
+		  invalid_syntax_with_buffer (&rb, source);
+		}
+	      read_stack_push (&rdstack, (struct read_stack_entry) {
+		  .type = RE_record,
+		  .u.vector.elems = Qnil,
+		  .u.vector.old_locate_syms = locate_syms,
+		});
+	      locate_syms = false;
+	      goto read_obj;
 
-	  case 'b':
-	  case 'B':
-	    obj = read_integer (source, 2);
-	    break;
+	    case '^':
+	      /* #^[...]  -- char-table
+		 #^^[...] -- sub-char-table */
+	      ch = read_and_buffer (&rb, source);
+	      if (ch == '^')
+		{
+		  ch = read_and_buffer (&rb, source);
+		  if (ch == '[')
+		    {
+		      read_stack_push (&rdstack, (struct read_stack_entry) {
+			  .type = RE_sub_char_table,
+			  .u.vector.elems = Qnil,
+			  .u.vector.old_locate_syms = locate_syms,
+			});
+		      locate_syms = false;
+		      goto read_obj;
+		    }
+		  else
+		    {
+		      unreadchar (source, ch);
+		      invalid_syntax_with_buffer (&rb, source);
+		    }
+		}
+	      else if (ch == '[')
+		{
+		  read_stack_push (&rdstack, (struct read_stack_entry) {
+		      .type = RE_char_table,
+		      .u.vector.elems = Qnil,
+		      .u.vector.old_locate_syms = locate_syms,
+		    });
+		  locate_syms = false;
+		  goto read_obj;
+		}
+	      else
+		{
+		  unreadchar (source, ch);
+		  invalid_syntax_with_buffer (&rb, source);
+		}
 
-	  case '@':
-	    /* #@NUMBER is used to skip NUMBER following bytes.
-	       That's used in .elc files to skip over doc strings
-	       and function definitions that can be loaded lazily.  */
-	    if (skip_lazy_string (source))
+	    case '(':
+	      /* #(...) -- string with properties */
+	      read_stack_push (&rdstack, (struct read_stack_entry) {
+		  .type = RE_string_props,
+		  .u.vector.elems = Qnil,
+		  .u.vector.old_locate_syms = locate_syms,
+		});
+	      locate_syms = false;
 	      goto read_obj;
-	    obj = Qnil;	      /* #@00 skips to EOB/EOF and yields nil.  */
-	    break;
 
-	  case '$':
-	    /* #$ -- reference to lazy-loaded string */
-	    obj = Vload_file_name;
-	    break;
+	    case '[':
+	      /* #[...] -- byte-code */
+	      read_stack_push (&rdstack, (struct read_stack_entry) {
+		  .type = RE_byte_code,
+		  .u.vector.elems = Qnil,
+		  .u.vector.old_locate_syms = locate_syms,
+		});
+	      locate_syms = false;
+	      goto read_obj;
 
-	  case ':':
-	    /* #:X -- uninterned symbol */
-	    c = readchar (source);
-	    if (c <= 32 || c == NO_BREAK_SPACE
-		|| c == '"' || c == '\'' || c == ';' || c == '#'
-		|| c == '(' || c == ')'  || c == '[' || c == ']'
-		|| c == '`' || c == ',')
-	      {
-		/* No symbol character follows: this is the empty symbol.  */
-		unreadchar (source, c);
-		obj = Fmake_symbol (empty_unibyte_string);
-		break;
-	      }
-	    uninterned_symbol = true;
-	    skip_shorthand = false;
-	    goto read_symbol;
+	    case '&':
+	      /* #&N"..." -- bool-vector */
+	      obj = read_bool_vector (source);
+	      break;
 
-	  case '_':
-	    /* #_X -- symbol without shorthand */
-	    c = readchar (source);
-	    if (c <= 32 || c == NO_BREAK_SPACE
-		|| c == '"' || c == '\'' || c == ';' || c == '#'
-		|| c == '(' || c == ')'  || c == '[' || c == ']'
-		|| c == '`' || c == ',')
+	    case '!':
+	      /* #! appears at the beginning of an executable file.
+		 Skip the rest of the line.  */
 	      {
-		/* No symbol character follows: this is the empty symbol.  */
-		unreadchar (source, c);
-		obj = Fintern (empty_unibyte_string, Qnil);
-		break;
+		int c;
+		do
+		  c = readchar (source);
+		while (c >= 0 && c != '\n');
+		goto read_obj;
 	      }
-	    uninterned_symbol = false;
-	    skip_shorthand = true;
-	    goto read_symbol;
 
-	  default:
-	    if (ch >= '0' && ch <= '9')
-	      {
-		/* #N=OBJ or #N# -- first read the number N */
-		EMACS_INT n = ch - '0';
-		int c;
-		for (;;)
-		  {
-		    c = read_and_buffer (&rb, source);
-		    if (c < '0' || c > '9')
-		      break;
-		    if (ckd_mul (&n, n, 10)
-			|| ckd_add (&n, n, c - '0'))
-		      invalid_syntax_with_buffer (&rb, source);
-		  }
-		if (c == 'r' || c == 'R')
-		  {
-		    /* #NrDIGITS -- radix-N number */
-		    if (n < 2 || n > 36)
-		      invalid_radix_integer (n, source);
-		    obj = read_integer (source, n);
-		    break;
-		  }
-		else if (n <= MOST_POSITIVE_FIXNUM && !NILP (Vread_circle))
-		  {
-		    if (c == '=')
-		      {
-			/* #N=OBJ -- assign number N to OBJ */
-			Lisp_Object placeholder = Fcons (Qnil, Qnil);
-
-			struct Lisp_Hash_Table *h
-			  = XHASH_TABLE (read_objects_map);
-			Lisp_Object number = make_fixnum (n);
-			hash_hash_t hash;
-			ptrdiff_t i = hash_find_get_hash (h, number, &hash);
-			if (i >= 0)
-			  /* Not normal, but input could be malformed.  */
-			  set_hash_value_slot (h, i, placeholder);
-			else
-			  hash_put (h, number, placeholder, hash);
-			read_stack_push (rdstack, (struct read_stack_entry) {
-			    .type = RE_numbered,
-			    .u.numbered.number = number,
-			    .u.numbered.placeholder = placeholder,
-			  });
-			goto read_obj;
-		      }
-		    else if (c == '#')
-		      {
-			/* #N# -- reference to numbered object */
-			struct Lisp_Hash_Table *h
-			  = XHASH_TABLE (read_objects_map);
-			ptrdiff_t i = hash_find (h, make_fixnum (n));
-			if (i < 0)
-			  invalid_syntax_with_buffer (&rb, source);
-			obj = HASH_VALUE (h, i);
+	    case 'x':
+	    case 'X':
+	      obj = read_integer (source, 16);
+	      break;
+
+	    case 'o':
+	    case 'O':
+	      obj = read_integer (source, 8);
+	      break;
+
+	    case 'b':
+	    case 'B':
+	      obj = read_integer (source, 2);
+	      break;
+
+	    case '@':
+	      /* #@NUMBER is used to skip NUMBER following bytes.
+		 That's used in .elc files to skip over doc strings
+		 and function definitions that can be loaded lazily.  */
+	      if (skip_lazy_string (source))
+		goto read_obj;
+	      obj = Qnil;	      /* #@00 skips to EOB/EOF and yields nil.  */
+	      break;
+
+	    case '$':
+	      /* #$ -- reference to lazy-loaded string */
+	      obj = Vload_file_name;
+	      break;
+
+	    case ':':
+	      /* #:X -- uninterned symbol */
+	      c = readchar (source);
+	      if (c <= 32 || c == NO_BREAK_SPACE
+		  || c == '"' || c == '\'' || c == ';' || c == '#'
+		  || c == '(' || c == ')'  || c == '[' || c == ']'
+		  || c == '`' || c == ',')
+		{
+		  /* No symbol character follows: this is the empty symbol.  */
+		  unreadchar (source, c);
+		  obj = Fmake_symbol (empty_unibyte_string);
+		  break;
+		}
+	      uninterned_symbol = true;
+	      skip_shorthand = false;
+	      goto read_symbol;
+
+	    case '_':
+	      /* #_X -- symbol without shorthand */
+	      c = readchar (source);
+	      if (c <= 32 || c == NO_BREAK_SPACE
+		  || c == '"' || c == '\'' || c == ';' || c == '#'
+		  || c == '(' || c == ')'  || c == '[' || c == ']'
+		  || c == '`' || c == ',')
+		{
+		  /* No symbol character follows: this is the empty symbol.  */
+		  unreadchar (source, c);
+		  obj = Fintern (empty_unibyte_string, Qnil);
+		  break;
+		}
+	      uninterned_symbol = false;
+	      skip_shorthand = true;
+	      goto read_symbol;
+
+	    default:
+	      if (ch >= '0' && ch <= '9')
+		{
+		  /* #N=OBJ or #N# -- first read the number N */
+		  EMACS_INT n = ch - '0';
+		  int c;
+		  for (;;)
+		    {
+		      c = read_and_buffer (&rb, source);
+		      if (c < '0' || c > '9')
 			break;
-		      }
-		    else
-		      invalid_syntax_with_buffer (&rb, source);
-		  }
-		else
-		  invalid_syntax_with_buffer (&rb, source);
-	      }
-	    else
-	      invalid_syntax_with_buffer (&rb, source);
-	  }
-	break;
-      }
+		      if (ckd_mul (&n, n, 10)
+			  || ckd_add (&n, n, c - '0'))
+			invalid_syntax_with_buffer (&rb, source);
+		    }
+		  if (c == 'r' || c == 'R')
+		    {
+		      /* #NrDIGITS -- radix-N number */
+		      if (n < 2 || n > 36)
+			invalid_radix_integer (n, source);
+		      obj = read_integer (source, n);
+		      break;
+		    }
+		  else if (n <= MOST_POSITIVE_FIXNUM && !NILP (Vread_circle))
+		    {
+		      if (c == '=')
+			{
+			  /* #N=OBJ -- assign number N to OBJ */
+			  Lisp_Object placeholder = Fcons (Qnil, Qnil);
+
+			  struct Lisp_Hash_Table *h
+			    = XHASH_TABLE (read_objects_map);
+			  Lisp_Object number = make_fixnum (n);
+			  hash_hash_t hash;
+			  ptrdiff_t i = hash_find_get_hash (h, number, &hash);
+			  if (i >= 0)
+			    /* Not normal, but input could be malformed.  */
+			    set_hash_value_slot (h, i, placeholder);
+			  else
+			    hash_put (h, number, placeholder, hash);
+			  read_stack_push (&rdstack, (struct read_stack_entry) {
+			      .type = RE_numbered,
+			      .u.numbered.number = number,
+			      .u.numbered.placeholder = placeholder,
+			    });
+			  goto read_obj;
+			}
+		      else if (c == '#')
+			{
+			  /* #N# -- reference to numbered object */
+			  struct Lisp_Hash_Table *h
+			    = XHASH_TABLE (read_objects_map);
+			  ptrdiff_t i = hash_find (h, make_fixnum (n));
+			  if (i < 0)
+			    invalid_syntax_with_buffer (&rb, source);
+			  obj = HASH_VALUE (h, i);
+			  break;
+			}
+		      else
+			invalid_syntax_with_buffer (&rb, source);
+		    }
+		  else
+		    invalid_syntax_with_buffer (&rb, source);
+		}
+	      else
+		invalid_syntax_with_buffer (&rb, source);
+	    }
+	  break;
+	}
 
-    case '?':
-      obj = read_char_literal (source);
-      break;
+      case '?':
+	obj = read_char_literal (source);
+	break;
 
-    case '"':
-      obj = read_string_literal (source);
-      break;
+      case '"':
+	obj = read_string_literal (source);
+	break;
 
-    case '\'':
-      read_stack_push (rdstack, (struct read_stack_entry) {
-	  .type = RE_special,
-	  .u.special.symbol = Qquote,
-	});
-      goto read_obj;
-
-    case '`':
-      read_stack_push (rdstack, (struct read_stack_entry) {
-	  .type = RE_special,
-	  .u.special.symbol = Qbackquote,
-	});
-      goto read_obj;
-
-    case ',':
-      {
-	int ch = readchar (source);
-	Lisp_Object sym;
-	if (ch == '@')
-	  sym = Qcomma_at;
-	else
-	  {
-	    if (ch >= 0)
-	      unreadchar (source, ch);
-	    sym = Qcomma;
-	  }
-	read_stack_push (rdstack, (struct read_stack_entry) {
+      case '\'':
+	read_stack_push (&rdstack, (struct read_stack_entry) {
 	    .type = RE_special,
-	    .u.special.symbol = sym,
+	    .u.special.symbol = Qquote,
 	  });
 	goto read_obj;
-      }
 
-    case ';':
-      {
-	int c;
-	do
-	  c = readchar (source);
-	while (c >= 0 && c != '\n');
+      case '`':
+	read_stack_push (&rdstack, (struct read_stack_entry) {
+	    .type = RE_special,
+	    .u.special.symbol = Qbackquote,
+	  });
 	goto read_obj;
-      }
 
-    case '.':
-      {
-	int nch = readchar (source);
-	unreadchar (source, nch);
-	if (nch <= 32 || nch == NO_BREAK_SPACE
-	    || nch == '"' || nch == '\'' || nch == ';'
-	    || nch == '(' || nch == '[' || nch == '#'
-	    || nch == '?' || nch == '`' || nch == ',')
-	  {
-	    if (!read_stack_empty_p (rdstack)
-		&& read_stack_top (rdstack)->type ==  RE_list)
-	      {
-		read_stack_top (rdstack)->type = RE_list_dot;
-		goto read_obj;
-	      }
-	    invalid_syntax (".", source);
-	  }
-      }
-      /* may be a number or symbol starting with a dot */
-      FALLTHROUGH;
+      case ',':
+	{
+	  int ch = readchar (source);
+	  Lisp_Object sym;
+	  if (ch == '@')
+	    sym = Qcomma_at;
+	  else
+	    {
+	      if (ch >= 0)
+		unreadchar (source, ch);
+	      sym = Qcomma;
+	    }
+	  read_stack_push (&rdstack, (struct read_stack_entry) {
+	      .type = RE_special,
+	      .u.special.symbol = sym,
+	    });
+	  goto read_obj;
+	}
 
-    default:
-      if (c <= 32 || c == NO_BREAK_SPACE)
-	goto read_obj;
+      case ';':
+	{
+	  int c;
+	  do
+	    c = readchar (source);
+	  while (c >= 0 && c != '\n');
+	  goto read_obj;
+	}
 
-      uninterned_symbol = false;
-      skip_shorthand = false;
-      /* symbol or number */
-    read_symbol:
-      {
-	rb.cur = rb.start;
-	bool quoted = false;
-	EMACS_INT start_position = readchar_offset - 1;
-	ptrdiff_t nchars = 0;
+      case '.':
+	{
+	  int nch = readchar (source);
+	  unreadchar (source, nch);
+	  if (nch <= 32 || nch == NO_BREAK_SPACE
+	      || nch == '"' || nch == '\'' || nch == ';'
+	      || nch == '(' || nch == '[' || nch == '#'
+	      || nch == '?' || nch == '`' || nch == ',')
+	    {
+	      if (!read_stack_empty_p (&rdstack)
+		  && read_stack_top (&rdstack)->type ==  RE_list)
+		{
+		  read_stack_top (&rdstack)->type = RE_list_dot;
+		  goto read_obj;
+		}
+	      invalid_syntax (".", source);
+	    }
+	}
+	/* may be a number or symbol starting with a dot */
+	FALLTHROUGH;
 
-	do
-	  {
-	    if (c == '\\')
-	      {
-		c = readchar (source);
-		if (c < 0)
-		  end_of_file_error ();
-		quoted = true;
-	      }
+      default:
+	if (c <= 32 || c == NO_BREAK_SPACE)
+	  goto read_obj;
 
-	    add_char_to_buffer (&rb, c, source->multibyte);
-	    nchars++;
-	    c = readchar (source);
-	  }
-	while (c > 32
-	       && c != NO_BREAK_SPACE
-	       && (c >= 128
-		   || !(   c == '"' || c == '\'' || c == ';' || c == '#'
-			|| c == '(' || c == ')'  || c == '[' || c == ']'
-			|| c == '`' || c == ',')));
-
-	*rb.cur = '\0';
-	ptrdiff_t nbytes = rb.cur - rb.start;
-	unreadchar (source, c);
-
-	/* Only attempt to parse the token as a number if it starts as one.  */
-	char c0 = rb.start[0];
-	if (((c0 >= '0' && c0 <= '9') || c0 == '.' || c0 == '-' || c0 == '+')
-	    && !quoted && !uninterned_symbol && !skip_shorthand)
-	  {
-	    ptrdiff_t len;
-	    Lisp_Object result = string_to_number (rb.start, 10, &len);
-	    if (!NILP (result) && len == nbytes)
-	      {
-		obj = result;
-		break;
-	      }
-	  }
+	uninterned_symbol = false;
+	skip_shorthand = false;
+	/* symbol or number */
+      read_symbol:
+	{
+	  rb.cur = rb.start;
+	  bool quoted = false;
+	  EMACS_INT start_position = readchar_offset - 1;
+	  ptrdiff_t nchars = 0;
 
-	/* symbol, possibly uninterned */
-	Lisp_Object result;
-	if (uninterned_symbol)
-	  {
-	    Lisp_Object name
-	      = make_specified_string (rb.start, nchars, nbytes,
-				       source->multibyte);
-	    result = Fmake_symbol (name);
-	  }
-	else
-	  {
-	    /* Don't create the string object for the name unless
-	       we're going to retain it in a new symbol.
-
-	       Like intern_1 but supports multibyte names.  */
-	    Lisp_Object obarray = check_obarray (Vobarray);
-
-	    char *longhand = NULL;
-	    ptrdiff_t longhand_chars = 0;
-	    ptrdiff_t longhand_bytes = 0;
-
-	    Lisp_Object found;
-	    if (skip_shorthand
-		/* We exempt characters used in the "core" Emacs Lisp
-		   symbols that are comprised entirely of characters
-		   that have the 'symbol constituent' syntax from
-		   transforming according to shorthands.  */
-		|| symbol_char_span (rb.start) >= nbytes)
-	      found = oblookup (obarray, rb.start, nchars, nbytes);
-	    else
-	      found = oblookup_considering_shorthand (obarray, rb.start,
-						      nchars, nbytes, &longhand,
-						      &longhand_chars,
-						      &longhand_bytes);
-
-	    if (BARE_SYMBOL_P (found))
-	      result = found;
-	    else if (longhand)
-	      {
-		Lisp_Object name = make_specified_string (longhand,
-							  longhand_chars,
-							  longhand_bytes,
-							  source->multibyte);
-		xfree (longhand);
-		result = intern_driver (name, obarray, found);
-	      }
-	    else
-	      {
-		Lisp_Object name = make_specified_string (rb.start, nchars,
-							  nbytes,
-							  source->multibyte);
-		result = intern_driver (name, obarray, found);
-	      }
-	  }
-	if (locate_syms && !NILP (result))
-	  result = build_symbol_with_pos (result,
-					  make_fixnum (start_position));
+	  do
+	    {
+	      if (c == '\\')
+		{
+		  c = readchar (source);
+		  if (c < 0)
+		    end_of_file_error ();
+		  quoted = true;
+		}
 
-	obj = result;
-	break;
-      }
-    }
+	      add_char_to_buffer (&rb, c, source->multibyte);
+	      nchars++;
+	      c = readchar (source);
+	    }
+	  while (c > 32
+		 && c != NO_BREAK_SPACE
+		 && (c >= 128
+		     || !(   c == '"' || c == '\'' || c == ';' || c == '#'
+			     || c == '(' || c == ')'  || c == '[' || c == ']'
+			     || c == '`' || c == ',')));
+
+	  *rb.cur = '\0';
+	  ptrdiff_t nbytes = rb.cur - rb.start;
+	  unreadchar (source, c);
+
+	  /* Only attempt to parse the token as a number if it starts as one.  */
+	  char c0 = rb.start[0];
+	  if (((c0 >= '0' && c0 <= '9') || c0 == '.' || c0 == '-' || c0 == '+')
+	      && !quoted && !uninterned_symbol && !skip_shorthand)
+	    {
+	      ptrdiff_t len;
+	      Lisp_Object result = string_to_number (rb.start, 10, &len);
+	      if (!NILP (result) && len == nbytes)
+		{
+		  obj = result;
+		  break;
+		}
+	    }
 
-  /* We have read an object in `obj'.  Use the stack to decide what to
-     do with it.  */
-  while (rdstack->top < rdstack->bottom)
-    {
-      struct read_stack_entry *e = read_stack_top (rdstack);
-      switch (e->type)
-	{
-	case RE_list_start:
-	  e->type = RE_list;
-	  e->u.list.head = e->u.list.tail = Fcons (obj, Qnil);
-	  goto read_obj;
+	  /* symbol, possibly uninterned */
+	  Lisp_Object result;
+	  if (uninterned_symbol)
+	    {
+	      Lisp_Object name
+		= make_specified_string (rb.start, nchars, nbytes,
+					 source->multibyte);
+	      result = Fmake_symbol (name);
+	    }
+	  else
+	    {
+	      /* Don't create the string object for the name unless
+		 we're going to retain it in a new symbol.
+
+		 Like intern_1 but supports multibyte names.  */
+	      Lisp_Object obarray = check_obarray (Vobarray);
+
+	      char *longhand = NULL;
+	      ptrdiff_t longhand_chars = 0;
+	      ptrdiff_t longhand_bytes = 0;
+
+	      Lisp_Object found;
+	      if (skip_shorthand
+		  /* We exempt characters used in the "core" Emacs Lisp
+		     symbols that are comprised entirely of characters
+		     that have the 'symbol constituent' syntax from
+		     transforming according to shorthands.  */
+		  || symbol_char_span (rb.start) >= nbytes)
+		found = oblookup (obarray, rb.start, nchars, nbytes);
+	      else
+		found = oblookup_considering_shorthand (obarray, rb.start,
+							nchars, nbytes, &longhand,
+							&longhand_chars,
+							&longhand_bytes);
+
+	      if (BARE_SYMBOL_P (found))
+		result = found;
+	      else if (longhand)
+		{
+		  Lisp_Object name = make_specified_string (longhand,
+							    longhand_chars,
+							    longhand_bytes,
+							    source->multibyte);
+		  xfree (longhand);
+		  result = intern_driver (name, obarray, found);
+		}
+	      else
+		{
+		  Lisp_Object name = make_specified_string (rb.start, nchars,
+							    nbytes,
+							    source->multibyte);
+		  result = intern_driver (name, obarray, found);
+		}
+	    }
+	  if (locate_syms && !NILP (result))
+	    result = build_symbol_with_pos (result,
+					    make_fixnum (start_position));
 
-	case RE_list:
-	  {
-	    Lisp_Object tl = Fcons (obj, Qnil);
-	    XSETCDR (e->u.list.tail, tl);
-	    e->u.list.tail = tl;
-	    goto read_obj;
-	  }
+	  obj = result;
+	  break;
+	}
+      }
 
-	case RE_list_dot:
+    /* We have read an object in `obj'.  Use the stack to decide what to
+       do with it.  */
+    while (rdstack.top < rdstack.bottom)
+      {
+	struct read_stack_entry *e = read_stack_top (&rdstack);
+	switch (e->type)
 	  {
-	    skip_space_and_comments (source);
-	    int ch = readchar (source);
-	    if (ch != ')')
-	      invalid_syntax ("expected )", source);
-	    XSETCDR (e->u.list.tail, obj);
-	    read_stack_pop (rdstack);
-	    obj = e->u.list.head;
-
-	    /* Hack: immediately convert (#$ . FIXNUM) to the corresponding
-	       string if load-force-doc-strings is set.  */
-	    if (load_force_doc_strings
-		&& BASE_EQ (XCAR (obj), Vload_file_name)
-		&& !NILP (XCAR (obj))
-		&& FIXNUMP (XCDR (obj)))
-	      obj = get_lazy_string (obj);
+	  case RE_list_start:
+	    e->type = RE_list;
+	    e->u.list.head = e->u.list.tail = Fcons (obj, Qnil);
+	    goto read_obj;
 
-	    break;
-	  }
+	  case RE_list:
+	    {
+	      Lisp_Object tl = Fcons (obj, Qnil);
+	      XSETCDR (e->u.list.tail, tl);
+	      e->u.list.tail = tl;
+	      goto read_obj;
+	    }
 
-	case RE_vector:
-	case RE_record:
-	case RE_char_table:
-	case RE_sub_char_table:
-	case RE_byte_code:
-	case RE_string_props:
-	  e->u.vector.elems = Fcons (obj, e->u.vector.elems);
-	  goto read_obj;
+	  case RE_list_dot:
+	    {
+	      skip_space_and_comments (source);
+	      int ch = readchar (source);
+	      if (ch != ')')
+		invalid_syntax ("expected )", source);
+	      XSETCDR (e->u.list.tail, obj);
+	      read_stack_pop (&rdstack);
+	      obj = e->u.list.head;
+
+	      /* Hack: immediately convert (#$ . FIXNUM) to the corresponding
+		 string if load-force-doc-strings is set.  */
+	      if (load_force_doc_strings
+		  && BASE_EQ (XCAR (obj), Vload_file_name)
+		  && !NILP (XCAR (obj))
+		  && FIXNUMP (XCDR (obj)))
+		obj = get_lazy_string (obj);
 
-	case RE_special:
-	  read_stack_pop (rdstack);
-	  obj = list2 (e->u.special.symbol, obj);
-	  break;
+	      break;
+	    }
 
-	case RE_numbered:
-	  {
-	    read_stack_pop (rdstack);
-	    Lisp_Object placeholder = e->u.numbered.placeholder;
-	    if (CONSP (obj))
-	      {
-		if (BASE_EQ (obj, placeholder))
-		  /* Catch silly games like #1=#1# */
-		  invalid_syntax ("nonsensical self-reference", source);
-
-		/* Optimization: since the placeholder is already
-		   a cons, repurpose it as the actual value.
-		   This allows us to skip the substitution below,
-		   since the placeholder is already referenced
-		   inside OBJ at the appropriate places.  */
-		Fsetcar (placeholder, XCAR (obj));
-		Fsetcdr (placeholder, XCDR (obj));
-
-		struct Lisp_Hash_Table *h2
-		  = XHASH_TABLE (read_objects_completed);
-		hash_hash_t hash;
-		ptrdiff_t i = hash_find_get_hash (h2, placeholder, &hash);
-		eassert (i < 0);
-		hash_put (h2, placeholder, Qnil, hash);
-		obj = placeholder;
-	      }
-	    else
-	      {
-		/* If it can be recursive, remember it for future
-		   substitutions.  */
-		if (!SYMBOLP (obj) && !NUMBERP (obj)
-		    && !(STRINGP (obj) && !string_intervals (obj)))
-		  {
-		    struct Lisp_Hash_Table *h2
-		      = XHASH_TABLE (read_objects_completed);
-		    hash_hash_t hash;
-		    ptrdiff_t i = hash_find_get_hash (h2, obj, &hash);
-		    eassert (i < 0);
-		    hash_put (h2, obj, Qnil, hash);
-		  }
+	  case RE_vector:
+	  case RE_record:
+	  case RE_char_table:
+	  case RE_sub_char_table:
+	  case RE_byte_code:
+	  case RE_string_props:
+	    e->u.vector.elems = Fcons (obj, e->u.vector.elems);
+	    goto read_obj;
 
-		/* Now put it everywhere the placeholder was...  */
-		Flread__substitute_object_in_subtree (obj, placeholder,
-						      read_objects_completed);
-
-		/* ...and #n# will use the real value from now on.  */
-		struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map);
-		hash_hash_t hash;
-		ptrdiff_t i = hash_find_get_hash (h, e->u.numbered.number,
-						  &hash);
-		eassert (i >= 0);
-		set_hash_value_slot (h, i, obj);
-	      }
+	  case RE_special:
+	    read_stack_pop (&rdstack);
+	    obj = list2 (e->u.special.symbol, obj);
 	    break;
-	  }
-	}
-    }
 
-  return unbind_to (base_pdl, obj);
+	  case RE_numbered:
+	    {
+	      read_stack_pop (&rdstack);
+	      Lisp_Object placeholder = e->u.numbered.placeholder;
+	      if (CONSP (obj))
+		{
+		  if (BASE_EQ (obj, placeholder))
+		    /* Catch silly games like #1=#1# */
+		    invalid_syntax ("nonsensical self-reference", source);
+
+		  /* Optimization: since the placeholder is already
+		     a cons, repurpose it as the actual value.
+		     This allows us to skip the substitution below,
+		     since the placeholder is already referenced
+		     inside OBJ at the appropriate places.  */
+		  Fsetcar (placeholder, XCAR (obj));
+		  Fsetcdr (placeholder, XCDR (obj));
+
+		  struct Lisp_Hash_Table *h2
+		    = XHASH_TABLE (read_objects_completed);
+		  hash_hash_t hash;
+		  ptrdiff_t i = hash_find_get_hash (h2, placeholder, &hash);
+		  eassert (i < 0);
+		  hash_put (h2, placeholder, Qnil, hash);
+		  obj = placeholder;
+		}
+	      else
+		{
+		  /* If it can be recursive, remember it for future
+		     substitutions.  */
+		  if (!SYMBOLP (obj) && !NUMBERP (obj)
+		      && !(STRINGP (obj) && !string_intervals (obj)))
+		    {
+		      struct Lisp_Hash_Table *h2
+			= XHASH_TABLE (read_objects_completed);
+		      hash_hash_t hash;
+		      ptrdiff_t i = hash_find_get_hash (h2, obj, &hash);
+		      eassert (i < 0);
+		      hash_put (h2, obj, Qnil, hash);
+		    }
+
+		  /* Now put it everywhere the placeholder was...  */
+		  Flread__substitute_object_in_subtree (obj, placeholder,
+							read_objects_completed);
+
+		  /* ...and #n# will use the real value from now on.  */
+		  struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map);
+		  hash_hash_t hash;
+		  ptrdiff_t i = hash_find_get_hash (h, e->u.numbered.number,
+						    &hash);
+		  eassert (i >= 0);
+		  set_hash_value_slot (h, i, obj);
+		}
+	      break;
+	    }
+	  }
+      }
+    return unbind_to (base_pdl, obj);
+  }
+  eassert (false);
 }
 
 
-- 
2.50.1