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) ...@@ -4240,7 +4240,7 @@ AC_CHECK_HEADERS(valgrind/valgrind.h)
AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.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 ok_so_far=yes
AC_CHECK_FUNC(socket, , ok_so_far=no) AC_CHECK_FUNC(socket, , ok_so_far=no)
......
...@@ -198,6 +198,10 @@ static struct ...@@ -198,6 +198,10 @@ static struct
#define GET_TEMP_CHARSET_WORK_DECODER(CODE) \ #define GET_TEMP_CHARSET_WORK_DECODER(CODE) \
(temp_charset_work->table.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 /* 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) ...@@ -416,15 +420,15 @@ read_hex (FILE *fp, bool *eof, bool *overflow)
int c; int c;
unsigned n; unsigned n;
while ((c = getc (fp)) != EOF) while ((c = getc_unlocked (fp)) != EOF)
{ {
if (c == '#') if (c == '#')
{ {
while ((c = getc (fp)) != EOF && c != '\n'); while ((c = getc_unlocked (fp)) != EOF && c != '\n');
} }
else if (c == '0') else if (c == '0')
{ {
if ((c = getc (fp)) == EOF || c == 'x') if ((c = getc_unlocked (fp)) == EOF || c == 'x')
break; break;
} }
} }
...@@ -434,7 +438,7 @@ read_hex (FILE *fp, bool *eof, bool *overflow) ...@@ -434,7 +438,7 @@ read_hex (FILE *fp, bool *eof, bool *overflow)
return 0; return 0;
} }
n = 0; n = 0;
while (c_isxdigit (c = getc (fp))) while (c_isxdigit (c = getc_unlocked (fp)))
{ {
if (INT_LEFT_SHIFT_OVERFLOW (n, 4)) if (INT_LEFT_SHIFT_OVERFLOW (n, 4))
*overflow = 1; *overflow = 1;
...@@ -508,7 +512,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, ...@@ -508,7 +512,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile,
from = read_hex (fp, &eof, &overflow); from = read_hex (fp, &eof, &overflow);
if (eof) if (eof)
break; break;
if (getc (fp) == '-') if (getc_unlocked (fp) == '-')
to = read_hex (fp, &eof, &overflow); to = read_hex (fp, &eof, &overflow);
else else
to = from; to = from;
......
...@@ -72,11 +72,40 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ ...@@ -72,11 +72,40 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define file_tell ftell #define file_tell ftell
#endif #endif
/* The association list of objects read with the #n=object form. #ifndef HAVE_GETC_UNLOCKED
Each member of the list has the form (n . object), and is used to #define getc_unlocked getc
look up the object for the corresponding #n# construct. #endif
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. */ /* File for get_file_char to read from. Use by load. */
static FILE *instream; static FILE *instream;
...@@ -445,7 +474,7 @@ readbyte_from_file (int c, Lisp_Object readcharfun) ...@@ -445,7 +474,7 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
} }
block_input (); block_input ();
c = getc (instream); c = getc_unlocked (instream);
/* Interrupted reads have been observed while reading over the network. */ /* Interrupted reads have been observed while reading over the network. */
while (c == EOF && ferror (instream) && errno == EINTR) while (c == EOF && ferror (instream) && errno == EINTR)
...@@ -454,7 +483,7 @@ readbyte_from_file (int c, Lisp_Object readcharfun) ...@@ -454,7 +483,7 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
maybe_quit (); maybe_quit ();
block_input (); block_input ();
clearerr (instream); clearerr (instream);
c = getc (instream); c = getc_unlocked (instream);
} }
unblock_input (); unblock_input ();
...@@ -757,7 +786,7 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, ...@@ -757,7 +786,7 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
{ {
register Lisp_Object val; register Lisp_Object val;
block_input (); block_input ();
XSETINT (val, getc (instream)); XSETINT (val, getc_unlocked (instream));
unblock_input (); unblock_input ();
return val; return val;
} }
...@@ -1908,6 +1937,18 @@ readevalloop (Lisp_Object readcharfun, ...@@ -1908,6 +1937,18 @@ readevalloop (Lisp_Object readcharfun,
|| c == NO_BREAK_SPACE) || c == NO_BREAK_SPACE)
goto read_next; 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 == '(') if (!NILP (Vpurify_flag) && c == '(')
{ {
val = read_list (0, readcharfun); val = read_list (0, readcharfun);
...@@ -1915,7 +1956,6 @@ readevalloop (Lisp_Object readcharfun, ...@@ -1915,7 +1956,6 @@ readevalloop (Lisp_Object readcharfun,
else else
{ {
UNREAD (c); UNREAD (c);
read_objects = Qnil;
if (!NILP (readfun)) if (!NILP (readfun))
{ {
val = call1 (readfun, readcharfun); val = call1 (readfun, readcharfun);
...@@ -1935,6 +1975,13 @@ readevalloop (Lisp_Object readcharfun, ...@@ -1935,6 +1975,13 @@ readevalloop (Lisp_Object readcharfun,
else else
val = read_internal_start (readcharfun, Qnil, Qnil); 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) if (!NILP (start) && continue_reading_p)
start = Fpoint_marker (); start = Fpoint_marker ();
...@@ -2106,7 +2153,18 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) ...@@ -2106,7 +2153,18 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
readchar_count = 0; readchar_count = 0;
new_backquote_flag = 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) if (EQ (Vread_with_symbol_positions, Qt)
|| EQ (Vread_with_symbol_positions, stream)) || EQ (Vread_with_symbol_positions, stream))
Vread_symbol_positions_list = Qnil; Vread_symbol_positions_list = Qnil;
...@@ -2134,6 +2192,13 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) ...@@ -2134,6 +2192,13 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
if (EQ (Vread_with_symbol_positions, Qt) if (EQ (Vread_with_symbol_positions, Qt)
|| EQ (Vread_with_symbol_positions, stream)) || EQ (Vread_with_symbol_positions, stream))
Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list); 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; return retval;
} }
...@@ -2901,7 +2966,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) ...@@ -2901,7 +2966,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
/* Copy that many characters into saved_doc_string. */ /* Copy that many characters into saved_doc_string. */
block_input (); block_input ();
for (i = 0; i < nskip && c >= 0; i++) 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 (); unblock_input ();
saved_doc_string_length = i; saved_doc_string_length = i;
...@@ -2974,7 +3039,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) ...@@ -2974,7 +3039,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
/* Note: We used to use AUTO_CONS to allocate /* Note: We used to use AUTO_CONS to allocate
placeholder, but that is a bad idea, since it placeholder, but that is a bad idea, since it
will place a stack-allocated cons cell into 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 staticpro'd global variable, and thus each of
its elements is marked during each GC. A its elements is marked during each GC. A
stack-allocated object will become garbled stack-allocated object will become garbled
...@@ -2983,27 +3048,62 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) ...@@ -2983,27 +3048,62 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
different purposes, which will cause crashes different purposes, which will cause crashes
in GC. */ in GC. */
Lisp_Object placeholder = Fcons (Qnil, Qnil); Lisp_Object placeholder = Fcons (Qnil, Qnil);
Lisp_Object cell = Fcons (make_number (n), placeholder); struct Lisp_Hash_Table *h
read_objects = Fcons (cell, read_objects); = 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. */ /* Read the object itself. */
tem = read0 (readcharfun); 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... */ /* 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. */ /* ...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; return tem;
}
} }
/* #n# returns a previously read object. */ /* #n# returns a previously read object. */
if (c == '#') if (c == '#')
{ {
tem = Fassq (make_number (n), read_objects); struct Lisp_Hash_Table *h
if (CONSP (tem)) = XHASH_TABLE (read_objects_map);
return XCDR (tem); 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) ...@@ -3342,25 +3442,51 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
if (! NILP (result)) if (! NILP (result))
return unbind_to (count, 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; Like intern_1 but supports multibyte names. */
ptrdiff_t nchars Lisp_Object obarray = check_obarray (Vobarray);
= (multibyte Lisp_Object tem = oblookup (obarray, read_buffer,
? multibyte_chars_in_text ((unsigned char *) read_buffer, nchars, nbytes);
nbytes)
: nbytes); if (SYMBOLP (tem))
Lisp_Object name = ((uninterned_symbol && ! NILP (Vpurify_flag) result = tem;
? make_pure_string : make_specified_string) else
(read_buffer, nchars, nbytes, multibyte)); {
Lisp_Object result = (uninterned_symbol ? Fmake_symbol (name) Lisp_Object name
: Fintern (name, Qnil)); = make_specified_string (read_buffer, nchars, nbytes,
multibyte);
if (EQ (Vread_with_symbol_positions, Qt) result = intern_driver (name, obarray, tem);
|| EQ (Vread_with_symbol_positions, readcharfun)) }
Vread_symbol_positions_list }
= Fcons (Fcons (result, make_number (start_position)),
Vread_symbol_positions_list); if (EQ (Vread_with_symbol_positions, Qt)
return unbind_to (count, result); || 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 ...@@ -3414,6 +3540,13 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
if (EQ (placeholder, subtree)) if (EQ (placeholder, subtree))
return object; 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 we've been to this node before, don't explore it again. */
if (!EQ (Qnil, Fmemq (subtree, seen_list))) if (!EQ (Qnil, Fmemq (subtree, seen_list)))
return subtree; return subtree;
...@@ -3421,8 +3554,8 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj ...@@ -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 /* 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 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 by #n=, which means that we can find it as a value in
read_objects. */ read_objects_completed. */
if (!EQ (Qnil, Frassq (subtree, read_objects))) if (hash_lookup (XHASH_TABLE (read_objects_completed), subtree, NULL) >= 0)
seen_list = Fcons (subtree, seen_list); seen_list = Fcons (subtree, seen_list);
/* Recurse according to subtree's type. /* Recurse according to subtree's type.
...@@ -4898,8 +5031,10 @@ that are loaded before your customizations are read! */); ...@@ -4898,8 +5031,10 @@ that are loaded before your customizations are read! */);
DEFSYM (Qdir_ok, "dir-ok"); DEFSYM (Qdir_ok, "dir-ok");
DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation"); DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation");
staticpro (&read_objects); staticpro (&read_objects_map);
read_objects = Qnil; read_objects_map = Qnil;
staticpro (&read_objects_completed);
read_objects_completed = Qnil;
staticpro (&seen_list); staticpro (&seen_list);
seen_list = Qnil; 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