Make read1 more reentrant

This is needed if ‘read’ is called soon after startup, before the
Unicode tables have been set up, and it reads a \N escape and
needs to look up a value the Unicode tables, a lookup that in turn
calls read1 recursively.  Although this change doesn’t make ‘read’
fully reentrant, it’s good enough to handle this case.
* src/lread.c (read_buffer_size, read_buffer): Remove static vars.
(grow_read_buffer): Revamp to use locals, not statics, and to
record memory allocation un the specpdl.  All callers changed.
(read1): Start with a stack-based buffer, and use the heap
only if the stack buffer is too small.  Use unbind_to to
free any heap buffer allocated.  Use bool for boolean.
Redo symbol loop so that only one call to grow_read_buffer
is needed.
(init_obarray): Remove no-longer-needed initialization.

1 files changed, 106 insertions, 97 deletions

diff --git a/src/lread.c b/src/lread.c
index 1335ccfea78..157a392a158 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -2144,16 +2144,28 @@ read0 (Lisp_Object readcharfun)
             Fmake_string (make_number (1), make_number (c)));
 }
 
-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)
+/* 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)
 {
-  read_buffer = xpalloc (read_buffer, &read_buffer_size,
-                         MAX_MULTIBYTE_LENGTH, -1, 1);
+  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;
 }
 
 /* Return the scalar value that has the Unicode character name NAME.
@@ -2432,6 +2444,9 @@ read_escape (Lisp_Object readcharfun, bool stringp)
         if (length == 0)
           invalid_syntax ("Empty character name");
         name[length] = '\0';
+
+        /* character_name_to_code can invoke read1, recursively.
+           This is why read1's buffer is not static.  */
         return character_name_to_code (name, length);
       }
 
@@ -2541,8 +2556,9 @@ static Lisp_Object
 read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 {
   int c;
-  bool uninterned_symbol = 0;
+  bool uninterned_symbol = false;
   bool multibyte;
+  char stackbuf[MAX_ALLOCA];
 
   *pch = 0;
 
@@ -2873,7 +2889,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
       /* #:foo is the uninterned symbol named foo.  */
       if (c == ':')
         {
-          uninterned_symbol = 1;
+          uninterned_symbol = true;
           c = READCHAR;
           if (!(c > 040
                 && c != NO_BREAK_SPACE
@@ -3084,16 +3100,20 @@ 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 = 0;
+        bool force_multibyte = false;
         /* True if we saw an escape sequence specifying
            a single-byte character.  */
-        bool force_singlebyte = 0;
-        bool cancel = 0;
+        bool force_singlebyte = false;
+        bool cancel = false;
         ptrdiff_t nchars = 0;
 
         while ((ch = READCHAR) >= 0
@@ -3102,7 +3122,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
             if (end - p < MAX_MULTIBYTE_LENGTH)
               {
                 ptrdiff_t offset = p - read_buffer;
-                grow_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;
               }
@@ -3117,7 +3139,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
                 if (ch == -1)
                   {
                     if (p == read_buffer)
-                      cancel = 1;
+                      cancel = true;
                     continue;
                   }
 
@@ -3125,9 +3147,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
                 ch = ch & ~CHAR_MODIFIER_MASK;
 
                 if (CHAR_BYTE8_P (ch))
-                  force_singlebyte = 1;
+                  force_singlebyte = true;
                 else if (! ASCII_CHAR_P (ch))
-                  force_multibyte = 1;
+                  force_multibyte = true;
                 else            /* I.e. ASCII_CHAR_P (ch).  */
                   {
                     /* Allow `\C- ' and `\C-?'.  */
@@ -3153,7 +3175,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
                            string.  */
                         modifiers &= ~CHAR_META;
                         ch = BYTE8_TO_CHAR (ch | 0x80);
-                        force_singlebyte = 1;
+                        force_singlebyte = true;
                       }
                   }
 
@@ -3166,9 +3188,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 = 1;
+                  force_singlebyte = true;
                 else if (! ASCII_CHAR_P (ch))
-                  force_multibyte = 1;
+                  force_multibyte = true;
               }
             nchars++;
           }
@@ -3180,7 +3202,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 make_number (0);
+          return unbind_to (count, make_number (0));
 
         if (! force_multibyte && force_singlebyte)
           {
@@ -3191,9 +3213,11 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
             p = read_buffer + nchars;
           }
 
-        return make_specified_string (read_buffer, nchars, p - read_buffer,
-                                      (force_multibyte
-                                       || (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);
       }
 
     case '.':
@@ -3221,81 +3245,74 @@ 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;
-        bool quoted = 0;
+        char *end = read_buffer + read_buffer_size;
+        bool quoted = false;
         EMACS_INT start_position = readchar_count - 1;
 
-        {
-          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;
-                }
+        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;
+              }
 
-              if (c == '\\')
-                {
-                  c = READCHAR;
-                  if (c == -1)
-                    end_of_file_error ();
-                  quoted = 1;
-                }
+            if (c == '\\')
+              {
+                c = READCHAR;
+                if (c == -1)
+                  end_of_file_error ();
+                quoted = true;
+              }
 
-              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));
 
-          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);
-        }
+        *p = 0;
+        UNREAD (c);
 
         if (!quoted && !uninterned_symbol)
           {
             Lisp_Object result = string_to_number (read_buffer, 10, 0);
             if (! NILP (result))
-              return result;
+              return unbind_to (count, 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);
-
-          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 result;
-        }
+
+        ptrdiff_t nbytes = p - read_buffer;
+        ptrdiff_t nchars
+          = (multibyte
+             ? multibyte_chars_in_text ((unsigned char *) read_buffer,
+                                        nbytes)
+             : nbytes);
+        Lisp_Object name = ((uninterned_symbol && ! NILP (Vpurify_flag)
+                             ? make_pure_string : make_specified_string)
+                            (read_buffer, nchars, nbytes, multibyte));
+        Lisp_Object 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);
       }
     }
 }
@@ -4104,12 +4121,7 @@ OBARRAY defaults to the value of `obarray'.  */)
 void
 init_obarray (void)
 {
-  Lisp_Object oblength;
-  ptrdiff_t size = 100 + MAX_MULTIBYTE_LENGTH;
-
-  XSETFASTINT (oblength, OBARRAY_SIZE);
-
-  Vobarray = Fmake_vector (oblength, make_number (0));
+  Vobarray = Fmake_vector (make_number (OBARRAY_SIZE), make_number (0));
   initial_obarray = Vobarray;
   staticpro (&initial_obarray);
 
@@ -4132,9 +4144,6 @@ init_obarray (void)
   Vpurify_flag = Qt;
 
   DEFSYM (Qvariable_documentation, "variable-documentation");
-
-  read_buffer = xmalloc (size);
-  read_buffer_size = size;
 }
 
 void