summaryrefslogtreecommitdiff
path: root/src/lread.c
diff options
context:
space:
mode:
authorKen Raeburn <raeburn@raeburn.org>2016-10-30 09:05:46 -0400
committerKen Raeburn <raeburn@raeburn.org>2017-06-21 22:34:33 -0400
commitb91455633b03add918af3eb166ac797fd6c95722 (patch)
tree8291ac7adfcf7f60d3fe7560db0d90175122c8a4 /src/lread.c
parentefe200c10da02db68c6eeadc3cd82a8cc3108c96 (diff)
downloademacs-b91455633b03add918af3eb166ac797fd6c95722.tar.gz
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, if they're not already empty hash tables, and reset them to Qnil afterwards if something was added to the hash tables. (read_internal_start): Likewise. (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.
Diffstat (limited to 'src/lread.c')
-rw-r--r--src/lread.c125
1 files changed, 107 insertions, 18 deletions
diff --git a/src/lread.c b/src/lread.c
index b4ee3015e5d..d6a7e55b98a 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -76,11 +76,36 @@ 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 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;
@@ -1912,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);
@@ -1919,7 +1956,6 @@ readevalloop (Lisp_Object readcharfun,
else
{
UNREAD (c);
- read_objects = Qnil;
if (!NILP (readfun))
{
val = call1 (readfun, readcharfun);
@@ -1939,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 ();
@@ -2110,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;
@@ -2138,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;
}
@@ -2978,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
@@ -2987,12 +3048,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))
{
@@ -3005,7 +3088,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
Fsubstitute_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;
}
@@ -3014,9 +3099,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);
}
}
}
@@ -3441,8 +3528,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.
@@ -4917,8 +5004,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;