emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] scratch/raeburn-startup dcc4b55 04/17: Replace read_object


From: Ken Raeburn
Subject: [Emacs-diffs] scratch/raeburn-startup dcc4b55 04/17: Replace read_objects assoc list with two hash tables.
Date: Thu, 15 Dec 2016 11:33:18 +0000 (UTC)

branch: scratch/raeburn-startup
commit dcc4b55c78211998cc5f8b87e8f7828e8422d303
Author: Ken Raeburn <address@hidden>
Commit: Ken Raeburn <address@hidden>

    Replace read_objects assoc list with two hash tables.
    
    For larger input files with lots of shared data structures, an
    association list is too slow.
    
    * src/lread.c (read_objects_map, read_objects_completed): New
    variables, replacing read_objects.
    (readevalloop): Initialize them with hash tables before starting a
    top-level read, and reset them to Qnil after.
    (read_internal_start): Likewise, but don't reinitialize if they're
    already empty hash tables.
    (read1): Store first the placeholder and later the newly read object
    into read_objects_map under the specified object number.  If the new
    object can contain a reference to itself, store it in
    read_objects_completed.
    (substitute_objects_recurse): Check read_objects_completed instead of
    read_objects for the known possibly-recursive objects.
    (syms_of_lread): Update initializations.
---
 src/lread.c |  107 +++++++++++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 89 insertions(+), 18 deletions(-)

diff --git a/src/lread.c b/src/lread.c
index 74d9dfb..28171fc 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -76,11 +76,32 @@ along with GNU Emacs.  If not, see 
<http://www.gnu.org/licenses/>.  */
 #define getc_unlocked getc
 #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;
+/* 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 hash must be recreated and empty before all top-level calls to
+   read0.  */
+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 hash must be recreated and empty
+   before all top-level calls to read0.  */
+static Lisp_Object read_objects_completed;
 
 /* File for get_file_char to read from.  Use by load.  */
 static FILE *instream;
@@ -1892,6 +1913,14 @@ readevalloop (Lisp_Object readcharfun,
          || c == NO_BREAK_SPACE)
        goto read_next;
 
+      read_objects_map
+       = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE),
+                          make_float (DEFAULT_REHASH_SIZE),
+                          make_float (DEFAULT_REHASH_THRESHOLD), Qnil);
+      read_objects_completed
+       = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE),
+                          make_float (DEFAULT_REHASH_SIZE),
+                          make_float (DEFAULT_REHASH_THRESHOLD), Qnil);
       if (!NILP (Vpurify_flag) && c == '(')
        {
          val = read_list (0, readcharfun);
@@ -1899,7 +1928,6 @@ readevalloop (Lisp_Object readcharfun,
       else
        {
          UNREAD (c);
-         read_objects = Qnil;
          if (!NILP (readfun))
            {
              val = call1 (readfun, readcharfun);
@@ -1919,6 +1947,7 @@ readevalloop (Lisp_Object readcharfun,
          else
            val = read_internal_start (readcharfun, Qnil, Qnil);
        }
+      read_objects_map = read_objects_completed = Qnil;
 
       if (!NILP (start) && continue_reading_p)
        start = Fpoint_marker ();
@@ -2089,7 +2118,20 @@ 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, make_number (DEFAULT_HASH_SIZE),
+                        make_float (DEFAULT_REHASH_SIZE),
+                        make_float (DEFAULT_REHASH_THRESHOLD), Qnil);
+  if (! HASH_TABLE_P (read_objects_completed)
+      || XHASH_TABLE (read_objects_completed)->count)
+    read_objects_completed
+      = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE),
+                        make_float (DEFAULT_REHASH_SIZE),
+                        make_float (DEFAULT_REHASH_THRESHOLD), Qnil);
   if (EQ (Vread_with_symbol_positions, Qt)
       || EQ (Vread_with_symbol_positions, stream))
     Vread_symbol_positions_list = Qnil;
@@ -2117,6 +2159,7 @@ 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);
+  read_objects_map = read_objects_completed = Qnil;
   return retval;
 }
 
@@ -2924,7 +2967,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
@@ -2933,12 +2976,34 @@ 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...  */
                       if (CONSP (tem))
                         {
@@ -2951,7 +3016,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool 
first_in_list)
                          substitute_object_in_subtree (tem, placeholder);
 
                          /* ...and #n# will use the real value from now on.  */
-                         Fsetcdr (cell, tem);
+                         i = hash_lookup (h, number, &hash);
+                         eassert (i >= 0);
+                         set_hash_value_slot (h, i, tem);
 
                          return tem;
                         }
@@ -2960,9 +3027,11 @@ read1 (Lisp_Object readcharfun, int *pch, bool 
first_in_list)
                  /* #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);
                    }
                }
            }
@@ -3373,8 +3442,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.
@@ -4844,8 +4913,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;
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]