[Emacs-diffs] master f0a1e9e: Make read1 more reentrant

[Paul Eggert]

branch: master
commit f0a1e9ec3fba3d5bea5bd62f525dba3fb005d1b1
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    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.
---
 src/lread.c |  203 +++++++++++++++++++++++++++++++----------------------------
 1 file changed, 106 insertions(+), 97 deletions(-)

diff --git a/src/lread.c b/src/lread.c
index 1335ccf..157a392 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