Merge several Lisp reader speedups.

2 files changed, 187 insertions, 48 deletions

diff --git a/src/charset.c b/src/charset.c
index f0b41400843..9d15375dd79 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -198,6 +198,10 @@ static struct
 
 #define GET_TEMP_CHARSET_WORK_DECODER(CODE)     \
   (temp_charset_work->table.decoder[(CODE)])
+
+#ifndef HAVE_GETC_UNLOCKED
+#define getc_unlocked getc
+#endif
 
 
 /* Set to 1 to warn that a charset map is loaded and thus a buffer
@@ -416,15 +420,15 @@ read_hex (FILE *fp, bool *eof, bool *overflow)
   int c;
   unsigned n;
 
-  while ((c = getc (fp)) != EOF)
+  while ((c = getc_unlocked (fp)) != EOF)
     {
       if (c == '#')
         {
-          while ((c = getc (fp)) != EOF && c != '\n');
+          while ((c = getc_unlocked (fp)) != EOF && c != '\n');
         }
       else if (c == '0')
         {
-          if ((c = getc (fp)) == EOF || c == 'x')
+          if ((c = getc_unlocked (fp)) == EOF || c == 'x')
             break;
         }
     }
@@ -434,7 +438,7 @@ read_hex (FILE *fp, bool *eof, bool *overflow)
       return 0;
     }
   n = 0;
-  while (c_isxdigit (c = getc (fp)))
+  while (c_isxdigit (c = getc_unlocked (fp)))
     {
       if (INT_LEFT_SHIFT_OVERFLOW (n, 4))
         *overflow = 1;
@@ -508,7 +512,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile,
       from = read_hex (fp, &eof, &overflow);
       if (eof)
         break;
-      if (getc (fp) == '-')
+      if (getc_unlocked (fp) == '-')
         to = read_hex (fp, &eof, &overflow);
       else
         to = from;
diff --git a/src/lread.c b/src/lread.c
index 88dbc23b964..b01cbd5c072 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -72,11 +72,40 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #define file_tell ftell
 #endif
 
-/* The association list of objects read with the #n=object form.
-   Each member of the list has the form (n . object), and is used to
-   look up the object for the corresponding #n# construct.
-   It must be set to nil before all top-level calls to read0.  */
-static Lisp_Object read_objects;
+#ifndef HAVE_GETC_UNLOCKED
+#define getc_unlocked getc
+#endif
+
+/* The objects or placeholders read with the #n=object form.
+
+   A hash table maps a number to either a placeholder (while the
+   object is still being parsed, in case it's referenced within its
+   own definition) or to the completed object.  With small integers
+   for keys, it's effectively little more than a vector, but it'll
+   manage any needed resizing for us.
+
+   The variable must be reset to an empty hash table before all
+   top-level calls to read0.  In between calls, it may be an empty
+   hash table left unused from the previous call (to reduce
+   allocations), or nil.  */
+static Lisp_Object read_objects_map;
+
+/* The recursive objects read with the #n=object form.
+
+   Objects that might have circular references are stored here, so
+   that recursive substitution knows not to keep processing them
+   multiple times.
+
+   Only objects that are completely processed, including substituting
+   references to themselves (but not necessarily replacing
+   placeholders for other objects still being read), are stored.
+
+   A hash table is used for efficient lookups of keys.  We don't care
+   what the value slots hold.  The variable must be set to an empty
+   hash table before all top-level calls to read0.  In between calls,
+   it may be an empty hash table left unused from the previous call
+   (to reduce allocations), or nil.  */
+static Lisp_Object read_objects_completed;
 
 /* File for get_file_char to read from.  Use by load.  */
 static FILE *instream;
@@ -445,7 +474,7 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
     }
 
   block_input ();
-  c = getc (instream);
+  c = getc_unlocked (instream);
 
   /* Interrupted reads have been observed while reading over the network.  */
   while (c == EOF && ferror (instream) && errno == EINTR)
@@ -454,7 +483,7 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
       maybe_quit ();
       block_input ();
       clearerr (instream);
-      c = getc (instream);
+      c = getc_unlocked (instream);
     }
 
   unblock_input ();
@@ -757,7 +786,7 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
 {
   register Lisp_Object val;
   block_input ();
-  XSETINT (val, getc (instream));
+  XSETINT (val, getc_unlocked (instream));
   unblock_input ();
   return val;
 }
@@ -1908,6 +1937,18 @@ readevalloop (Lisp_Object readcharfun,
           || c == NO_BREAK_SPACE)
         goto read_next;
 
+      if (! HASH_TABLE_P (read_objects_map)
+          || XHASH_TABLE (read_objects_map)->count)
+        read_objects_map
+          = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE,
+                             DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
+                             Qnil, Qnil);
+      if (! HASH_TABLE_P (read_objects_completed)
+          || XHASH_TABLE (read_objects_completed)->count)
+        read_objects_completed
+          = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE,
+                             DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
+                             Qnil, Qnil);
       if (!NILP (Vpurify_flag) && c == '(')
         {
           val = read_list (0, readcharfun);
@@ -1915,7 +1956,6 @@ readevalloop (Lisp_Object readcharfun,
       else
         {
           UNREAD (c);
-          read_objects = Qnil;
           if (!NILP (readfun))
             {
               val = call1 (readfun, readcharfun);
@@ -1935,6 +1975,13 @@ readevalloop (Lisp_Object readcharfun,
           else
             val = read_internal_start (readcharfun, Qnil, Qnil);
         }
+      /* Empty hashes can be reused; otherwise, reset on next call.  */
+      if (HASH_TABLE_P (read_objects_map)
+          && XHASH_TABLE (read_objects_map)->count > 0)
+        read_objects_map = Qnil;
+      if (HASH_TABLE_P (read_objects_completed)
+          && XHASH_TABLE (read_objects_completed)->count > 0)
+        read_objects_completed = Qnil;
 
       if (!NILP (start) && continue_reading_p)
         start = Fpoint_marker ();
@@ -2106,7 +2153,18 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
 
   readchar_count = 0;
   new_backquote_flag = 0;
-  read_objects = Qnil;
+  /* We can get called from readevalloop which may have set these
+     already.  */
+  if (! HASH_TABLE_P (read_objects_map)
+      || XHASH_TABLE (read_objects_map)->count)
+    read_objects_map
+      = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
+                         DEFAULT_REHASH_THRESHOLD, Qnil, Qnil);
+  if (! HASH_TABLE_P (read_objects_completed)
+      || XHASH_TABLE (read_objects_completed)->count)
+    read_objects_completed
+      = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
+                         DEFAULT_REHASH_THRESHOLD, Qnil, Qnil);
   if (EQ (Vread_with_symbol_positions, Qt)
       || EQ (Vread_with_symbol_positions, stream))
     Vread_symbol_positions_list = Qnil;
@@ -2134,6 +2192,13 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
   if (EQ (Vread_with_symbol_positions, Qt)
       || EQ (Vread_with_symbol_positions, stream))
     Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
+  /* Empty hashes can be reused; otherwise, reset on next call.  */
+  if (HASH_TABLE_P (read_objects_map)
+      && XHASH_TABLE (read_objects_map)->count > 0)
+    read_objects_map = Qnil;
+  if (HASH_TABLE_P (read_objects_completed)
+      && XHASH_TABLE (read_objects_completed)->count > 0)
+    read_objects_completed = Qnil;
   return retval;
 }
 
@@ -2901,7 +2966,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
               /* Copy that many characters into saved_doc_string.  */
               block_input ();
               for (i = 0; i < nskip && c >= 0; i++)
-                saved_doc_string[i] = c = getc (instream);
+                saved_doc_string[i] = c = getc_unlocked (instream);
               unblock_input ();
 
               saved_doc_string_length = i;
@@ -2974,7 +3039,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
                       /* Note: We used to use AUTO_CONS to allocate
                          placeholder, but that is a bad idea, since it
                          will place a stack-allocated cons cell into
-                         the list in read_objects, which is a
+                         the list in read_objects_map, which is a
                          staticpro'd global variable, and thus each of
                          its elements is marked during each GC.  A
                          stack-allocated object will become garbled
@@ -2983,27 +3048,62 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
                          different purposes, which will cause crashes
                          in GC.  */
                       Lisp_Object placeholder = Fcons (Qnil, Qnil);
-                      Lisp_Object cell = Fcons (make_number (n), placeholder);
-                      read_objects = Fcons (cell, read_objects);
+                      struct Lisp_Hash_Table *h
+                        = XHASH_TABLE (read_objects_map);
+                      EMACS_UINT hash;
+                      Lisp_Object number = make_number (n);
+
+                      ptrdiff_t i = hash_lookup (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 the object itself.  */
                       tem = read0 (readcharfun);
 
+                      /* If it can be recursive, remember it for
+                         future substitutions.  */
+                      if (! SYMBOLP (tem)
+                          && ! NUMBERP (tem)
+                          && ! (STRINGP (tem) && !string_intervals (tem)))
+                        {
+                          struct Lisp_Hash_Table *h2
+                            = XHASH_TABLE (read_objects_completed);
+                          i = hash_lookup (h2, tem, &hash);
+                          eassert (i < 0);
+                          hash_put (h2, tem, Qnil, hash);
+                        }
+
                       /* Now put it everywhere the placeholder was...  */
-                      Fsubstitute_object_in_subtree (tem, placeholder);
+                      if (CONSP (tem))
+                        {
+                          Fsetcar (placeholder, XCAR (tem));
+                          Fsetcdr (placeholder, XCDR (tem));
+                          return placeholder;
+                        }
+                      else
+                        {
+                          Fsubstitute_object_in_subtree (tem, placeholder);
 
-                      /* ...and #n# will use the real value from now on.  */
-                      Fsetcdr (cell, tem);
+                          /* ...and #n# will use the real value from now on.  */
+                          i = hash_lookup (h, number, &hash);
+                          eassert (i >= 0);
+                          set_hash_value_slot (h, i, tem);
 
-                      return tem;
+                          return tem;
+                        }
                     }
 
                   /* #n# returns a previously read object.  */
                   if (c == '#')
                     {
-                      tem = Fassq (make_number (n), read_objects);
-                      if (CONSP (tem))
-                        return XCDR (tem);
+                      struct Lisp_Hash_Table *h
+                        = XHASH_TABLE (read_objects_map);
+                      ptrdiff_t i = hash_lookup (h, make_number (n), NULL);
+                      if (i >= 0)
+                        return HASH_VALUE (h, i);
                     }
                 }
             }
@@ -3342,25 +3442,51 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
             if (! NILP (result))
               return unbind_to (count, result);
           }
+        {
+          Lisp_Object 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.
 
-        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);
+                 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);
+                }
+            }
+
+          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);
+        }
       }
     }
 }
@@ -3414,6 +3540,13 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
   if (EQ (placeholder, subtree))
     return object;
 
+  /* For common object types that can't contain other objects, don't
+     bother looking them up; we're done.  */
+  if (SYMBOLP (subtree)
+      || (STRINGP (subtree) && !string_intervals (subtree))
+      || NUMBERP (subtree))
+    return subtree;
+
   /* If we've been to this node before, don't explore it again.  */
   if (!EQ (Qnil, Fmemq (subtree, seen_list)))
     return subtree;
@@ -3421,8 +3554,8 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
   /* If this node can be the entry point to a cycle, remember that
      we've seen it.  It can only be such an entry point if it was made
      by #n=, which means that we can find it as a value in
-     read_objects.  */
-  if (!EQ (Qnil, Frassq (subtree, read_objects)))
+     read_objects_completed.  */
+  if (hash_lookup (XHASH_TABLE (read_objects_completed), subtree, NULL) >= 0)
     seen_list = Fcons (subtree, seen_list);
 
   /* Recurse according to subtree's type.
@@ -4898,8 +5031,10 @@ that are loaded before your customizations are read!  */);
   DEFSYM (Qdir_ok, "dir-ok");
   DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation");
 
-  staticpro (&read_objects);
-  read_objects = Qnil;
+  staticpro (&read_objects_map);
+  read_objects_map = Qnil;
+  staticpro (&read_objects_completed);
+  read_objects_completed = Qnil;
   staticpro (&seen_list);
   seen_list = Qnil;