bug#27779: #27779; C stack overflow from `read' on deeply nested lisp object.

[Vasilij Schneidermann <mail@vasilij.de>]

[-- Attachment #1: Type: text/plain, Size: 494 bytes --]

Hello all,

I've run into this issue today when loading up undo-tree on Emacs 26.1.
The last patch fixes it for me, I only had to delete the first context
line of hunk #13 for it to apply with some fuzz.  I expect plenty more
people to run into this as undo-tree is a dependency for Evil and
therefore keeps Emacs users from properly booting their editor (it's
particularly fatal for the daemon, I couldn't get `emacsclient` to
successfully connect to it after it ran into the issue).

Vasilij

[-- Attachment #2: stack-overflow.patch --]
[-- Type: text/plain, Size: 9696 bytes --]

diff --git a/src/lread.c b/src/lread.c
index 45d6064..1219077 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -2272,28 +2272,16 @@ read0 (Lisp_Object readcharfun)
 	    Fmake_string (make_number (1), make_number (c)));
 }
 \f
-/* Grow a read buffer BUF that contains OFFSET useful bytes of data,
-   by at least MAX_MULTIBYTE_LENGTH bytes.  Update *BUF_ADDR and
-   *BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE.  If *BUF_ADDR is
-   initially null, BUF is on the stack: copy its data to the new heap
-   buffer.  Otherwise, BUF must equal *BUF_ADDR and can simply be
-   reallocated.  Either way, remember the heap allocation (which is at
-   pdl slot COUNT) so that it can be freed when unwinding the stack.*/
-
-static char *
-grow_read_buffer (char *buf, ptrdiff_t offset,
-		  char **buf_addr, ptrdiff_t *buf_size, ptrdiff_t count)
+static ptrdiff_t read_buffer_size;
+static char *read_buffer;
+ 
+/* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes.  */
+ 
+static void
+grow_read_buffer (void)
 {
-  char *p = xpalloc (*buf_addr, buf_size, MAX_MULTIBYTE_LENGTH, -1, 1);
-  if (!*buf_addr)
-    {
-      memcpy (p, buf, offset);
-      record_unwind_protect_ptr (xfree, p);
-    }
-  else
-    set_unwind_protect_ptr (count, xfree, p);
-  *buf_addr = p;
-  return p;
+  read_buffer = xpalloc (read_buffer, &read_buffer_size,
+			 MAX_MULTIBYTE_LENGTH, -1, 1);
 }
 
 /* Return the scalar value that has the Unicode character name NAME.
@@ -2673,10 +2661,8 @@ static Lisp_Object
 read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 {
   int c;
-  bool uninterned_symbol = false;
+  bool uninterned_symbol = 0;
   bool multibyte;
-  char stackbuf[MAX_ALLOCA];
-  current_thread->stack_top = stackbuf;
 
   *pch = 0;
 
@@ -3028,7 +3014,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
       /* #:foo is the uninterned symbol named foo.  */
       if (c == ':')
 	{
-	  uninterned_symbol = true;
+	  uninterned_symbol = 1;
 	  c = READCHAR;
 	  if (!(c > 040
 		&& c != NO_BREAK_SPACE
@@ -3285,20 +3271,16 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 
     case '"':
       {
-	ptrdiff_t count = SPECPDL_INDEX ();
-	char *read_buffer = stackbuf;
-	ptrdiff_t read_buffer_size = sizeof stackbuf;
-	char *heapbuf = NULL;
 	char *p = read_buffer;
 	char *end = read_buffer + read_buffer_size;
 	int ch;
 	/* True if we saw an escape sequence specifying
 	   a multibyte character.  */
-	bool force_multibyte = false;
+	bool force_multibyte = 0;
 	/* True if we saw an escape sequence specifying
 	   a single-byte character.  */
-	bool force_singlebyte = false;
-	bool cancel = false;
+	bool force_singlebyte = 0;
+	bool cancel = 0;
 	ptrdiff_t nchars = 0;
 
 	while ((ch = READCHAR) >= 0
@@ -3307,9 +3289,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 	    if (end - p < MAX_MULTIBYTE_LENGTH)
 	      {
 		ptrdiff_t offset = p - read_buffer;
-		read_buffer = grow_read_buffer (read_buffer, offset,
-						&heapbuf, &read_buffer_size,
-						count);
+		grow_read_buffer ();
 		p = read_buffer + offset;
 		end = read_buffer + read_buffer_size;
 	      }
@@ -3324,7 +3304,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 		if (ch == -1)
 		  {
 		    if (p == read_buffer)
-		      cancel = true;
+		      cancel = 1;
 		    continue;
 		  }
 
@@ -3332,9 +3312,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 		ch = ch & ~CHAR_MODIFIER_MASK;
 
 		if (CHAR_BYTE8_P (ch))
-		  force_singlebyte = true;
+		  force_singlebyte = 1;
 		else if (! ASCII_CHAR_P (ch))
-		  force_multibyte = true;
+		  force_multibyte = 1;
 		else		/* I.e. ASCII_CHAR_P (ch).  */
 		  {
 		    /* Allow `\C- ' and `\C-?'.  */
@@ -3360,7 +3340,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 			   string.  */
 			modifiers &= ~CHAR_META;
 			ch = BYTE8_TO_CHAR (ch | 0x80);
-			force_singlebyte = true;
+			force_singlebyte = 1;
 		      }
 		  }
 
@@ -3373,9 +3353,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 	      {
 		p += CHAR_STRING (ch, (unsigned char *) p);
 		if (CHAR_BYTE8_P (ch))
-		  force_singlebyte = true;
+		  force_singlebyte = 1;
 		else if (! ASCII_CHAR_P (ch))
-		  force_multibyte = true;
+		  force_multibyte = 1;
 	      }
 	    nchars++;
 	  }
@@ -3387,7 +3367,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 	   return zero instead.  This is for doc strings
 	   that we are really going to find in etc/DOC.nn.nn.  */
 	if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
-	  return unbind_to (count, make_number (0));
+	  return make_number (0);
 
 	if (! force_multibyte && force_singlebyte)
 	  {
@@ -3398,11 +3378,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 	    p = read_buffer + nchars;
 	  }
 
-	Lisp_Object result
-	  = make_specified_string (read_buffer, nchars, p - read_buffer,
-				   (force_multibyte
-				    || (p - read_buffer != nchars)));
-	return unbind_to (count, result);
+	return make_specified_string (read_buffer, nchars, p - read_buffer,
+				      (force_multibyte
+				       || (p - read_buffer != nchars)));
       }
 
     case '.':
@@ -3430,54 +3408,58 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 
     read_symbol:
       {
-	ptrdiff_t count = SPECPDL_INDEX ();
-	char *read_buffer = stackbuf;
-	ptrdiff_t read_buffer_size = sizeof stackbuf;
-	char *heapbuf = NULL;
 	char *p = read_buffer;
-	char *end = read_buffer + read_buffer_size;
-	bool quoted = false;
+	bool quoted = 0;
 	EMACS_INT start_position = readchar_count - 1;
 
-	do
-	  {
-	    if (end - p < MAX_MULTIBYTE_LENGTH + 1)
-	      {
-		ptrdiff_t offset = p - read_buffer;
-		read_buffer = grow_read_buffer (read_buffer, offset,
-						&heapbuf, &read_buffer_size,
-						count);
-		p = read_buffer + offset;
-		end = read_buffer + read_buffer_size;
-	      }
+	{
+	  char *end = read_buffer + read_buffer_size;
+ 
+	  do
+	    {
+	      if (end - p < MAX_MULTIBYTE_LENGTH)
+		{
+		  ptrdiff_t offset = p - read_buffer;
+		  grow_read_buffer ();
+		  p = read_buffer + offset;
+		  end = read_buffer + read_buffer_size;
+		}
 
-	    if (c == '\\')
-	      {
-		c = READCHAR;
-		if (c == -1)
-		  end_of_file_error ();
-		quoted = true;
-	      }
+	      if (c == '\\')
+		{
+		  c = READCHAR;
+		  if (c == -1)
+		    end_of_file_error ();
+		  quoted = 1;
+		}
 
-	    if (multibyte)
-	      p += CHAR_STRING (c, (unsigned char *) p);
-	    else
-	      *p++ = c;
-	    c = READCHAR;
-	  }
-	while (c > 040
-	       && c != NO_BREAK_SPACE
-	       && (c >= 0200
-		   || strchr ("\"';()[]#`,", c) == NULL));
+	      if (multibyte)
+		p += CHAR_STRING (c, (unsigned char *) p);
+	      else
+		*p++ = c;
+	      c = READCHAR;
+	    }
+	  while (c > 040
+		 && c != NO_BREAK_SPACE
+		 && (c >= 0200
+		     || strchr ("\"';()[]#`,", c) == NULL));
 
-	*p = 0;
-	UNREAD (c);
+	  if (p == end)
+	    {
+	      ptrdiff_t offset = p - read_buffer;
+	      grow_read_buffer ();
+	      p = read_buffer + offset;
+	      end = read_buffer + read_buffer_size;
+	    }
+	  *p = 0;
+	  UNREAD (c);
+	}
 
 	if (!quoted && !uninterned_symbol)
 	  {
 	    Lisp_Object result = string_to_number (read_buffer, 10, 0);
 	    if (! NILP (result))
-	      return unbind_to (count, result);
+	      return result;
 	  }
         if (!quoted && multibyte)
           {
@@ -3498,48 +3480,25 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
           }
 	{
-	  Lisp_Object result;
+	  Lisp_Object name, result;
 	  ptrdiff_t nbytes = p - read_buffer;
 	  ptrdiff_t nchars
 	    = (multibyte
 	       ? multibyte_chars_in_text ((unsigned char *) read_buffer,
 					  nbytes)
 	       : nbytes);
-
-	  if (uninterned_symbol)
-	    {
-	      Lisp_Object name
-		= ((! NILP (Vpurify_flag)
-		    ? make_pure_string : make_specified_string)
-		   (read_buffer, nchars, nbytes, 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);
-	      Lisp_Object tem = oblookup (obarray, read_buffer,
-					  nchars, nbytes);
-
-	      if (SYMBOLP (tem))
-		result = tem;
-	      else
-		{
-		  Lisp_Object name
-		    = make_specified_string (read_buffer, nchars, nbytes,
-					     multibyte);
-		  result = intern_driver (name, obarray, tem);
-		}
-	    }
-
+ 
+	  name = ((uninterned_symbol && ! NILP (Vpurify_flag)
+		   ? make_pure_string : make_specified_string)
+		  (read_buffer, nchars, nbytes, multibyte));
+	  result = (uninterned_symbol ? Fmake_symbol (name)
+		    : Fintern (name, Qnil));
+ 
 	  if (EQ (Vread_with_symbol_positions, Qt)
 	      || EQ (Vread_with_symbol_positions, readcharfun))
 	    Vread_symbol_positions_list
 	      = Fcons (Fcons (result, make_number (start_position)),
 		       Vread_symbol_positions_list);
-	  return unbind_to (count, result);
+	  return result;
 	}
       }
     }
@@ -4320,7 +4279,12 @@ OBARRAY defaults to the value of `obarray'.  */)
 void
 init_obarray (void)
 {
-  Vobarray = Fmake_vector (make_number (OBARRAY_SIZE), make_number (0));
+  Lisp_Object oblength;
+  ptrdiff_t size = 100 + MAX_MULTIBYTE_LENGTH;
+ 
+  XSETFASTINT (oblength, OBARRAY_SIZE);
+ 
+  Vobarray = Fmake_vector (oblength, make_number (0));
   initial_obarray = Vobarray;
   staticpro (&initial_obarray);
 
@@ -4343,6 +4307,9 @@ init_obarray (void)
   Vpurify_flag = Qt;
 
   DEFSYM (Qvariable_documentation, "variable-documentation");
+
+  read_buffer = xmalloc (size);
+  read_buffer_size = size;
 }
 \f
 void