Commit 85f6aa33 authored by Ken Raeburn's avatar Ken Raeburn

Merge several Lisp reader speedups.

parents 87a44b93 59f3c866
......@@ -4240,7 +4240,7 @@ AC_CHECK_HEADERS(valgrind/valgrind.h)
AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.h>]])
AC_CHECK_FUNCS_ONCE([sbrk])
AC_CHECK_FUNCS_ONCE([getc_unlocked sbrk])
ok_so_far=yes
AC_CHECK_FUNC(socket, , ok_so_far=no)
......
......@@ -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;
......
......@@ -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;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment