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

From: Lynn Winebarger <[email-masked]>
Date: Mon, 28 Jul 2025 07:15:34 -0400

On Mon, Jul 28, 2025 at 12:32 AM Lynn Winebarger <[email-masked]> wrote:
>
> On Sat, Jul 26, 2025 at 12:00 PM Stefan Monnier
> <[email-masked]> wrote:
> >
> > >> BTW memory that's not returned to the OS but that Emacs can reuse
> > >> later is generally not considered as a leak.  E.g., most `malloc`
> > >> implementations have the property of (virtually) never bothering to
> > >> return freed memory to the OS.
> > > Terminology aside, the memory used for the stack is never freed for
> > > use by other parts of Emacs.
> >
> > Yup.  Still not considered a leak.  🙁
> > It may be a waste of memory, of course, but we use similar approaches in
> > other places without worrying very much about it.  For example, we grow
> > hashtables on-demand in `puthash`, but we never shrink them back in
> > `remhash`.
> >
> > That doesn't mean I'm opposed to changing the read code to be more
> > careful with its use of memory, but I don't consider it a serious
> > concern, so code clarity, speed, reentrancy, and things like that are
> > more important.
>
> Ok, the attached patch bootstraps with -O0 without native compilation.
> I haven't done any benchmarking or tuning, or tested with optimization
> turned on, but it shows the technique.  The changes don't seem to have
> leaked beyond the obviously required scope.  The patch does eliminate
> one unwind_protect (per entry to read0) which is made unnecessary by
> using alloca.
>
This version eliminates the trampoline function and uses C block scope
and goto in place of return/call.  I have no idea if C semantics
guarantee the assumptions about jumping out of block scope and
variables allocated on the stack.  It seems to work with -O0.

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/2] 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 d17398d4fd7dd6947ff339195c0a11f03cc5fa31 Mon Sep 17 00:00:00 2001
From: owinebar <[email-masked]>
Date: Mon, 28 Jul 2025 07:00:17 -0400
Subject: [PATCH 2/2] 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