Commit f0a1e9ec authored by Paul Eggert's avatar Paul Eggert

Make read1 more reentrant

This is needed if ‘read’ is called soon after startup, before the
Unicode tables have been set up, and it reads a \N escape and
needs to look up a value the Unicode tables, a lookup that in turn
calls read1 recursively.  Although this change doesn’t make ‘read’
fully reentrant, it’s good enough to handle this case.
* src/lread.c (read_buffer_size, read_buffer): Remove static vars.
(grow_read_buffer): Revamp to use locals, not statics, and to
record memory allocation un the specpdl.  All callers changed.
(read1): Start with a stack-based buffer, and use the heap
only if the stack buffer is too small.  Use unbind_to to
free any heap buffer allocated.  Use bool for boolean.
Redo symbol loop so that only one call to grow_read_buffer
is needed.
(init_obarray): Remove no-longer-needed initialization.
parent 162ba405
......@@ -2144,16 +2144,28 @@ read0 (Lisp_Object readcharfun)
Fmake_string (make_number (1), make_number (c)));
}
static ptrdiff_t read_buffer_size;
static char *read_buffer;
/* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */
static void
grow_read_buffer (void)
/* Grow a read buffer BUF that contains OFFSET useful bytes of data,
by at least MAX_MULTIBYTE_LENGTH bytes. Update *BUF_ADDR and
*BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE. If *BUF_ADDR is
initially null, BUF is on the stack: copy its data to the new heap
buffer. Otherwise, BUF must equal *BUF_ADDR and can simply be
reallocated. Either way, remember the heap allocation (which is at
pdl slot COUNT) so that it can be freed when unwinding the stack.*/
static char *
grow_read_buffer (char *buf, ptrdiff_t offset,
char **buf_addr, ptrdiff_t *buf_size, ptrdiff_t count)
{
read_buffer = xpalloc (read_buffer, &read_buffer_size,
MAX_MULTIBYTE_LENGTH, -1, 1);
char *p = xpalloc (*buf_addr, buf_size, MAX_MULTIBYTE_LENGTH, -1, 1);
if (!*buf_addr)
{
memcpy (p, buf, offset);
record_unwind_protect_ptr (xfree, p);
}
else
set_unwind_protect_ptr (count, xfree, p);
*buf_addr = p;
return p;
}
/* Return the scalar value that has the Unicode character name NAME.
......@@ -2432,6 +2444,9 @@ read_escape (Lisp_Object readcharfun, bool stringp)
if (length == 0)
invalid_syntax ("Empty character name");
name[length] = '\0';
/* character_name_to_code can invoke read1, recursively.
This is why read1's buffer is not static. */
return character_name_to_code (name, length);
}
......@@ -2541,8 +2556,9 @@ static Lisp_Object
read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
{
int c;
bool uninterned_symbol = 0;
bool uninterned_symbol = false;
bool multibyte;
char stackbuf[MAX_ALLOCA];
*pch = 0;
......@@ -2873,7 +2889,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
/* #:foo is the uninterned symbol named foo. */
if (c == ':')
{
uninterned_symbol = 1;
uninterned_symbol = true;
c = READCHAR;
if (!(c > 040
&& c != NO_BREAK_SPACE
......@@ -3084,16 +3100,20 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
case '"':
{
ptrdiff_t count = SPECPDL_INDEX ();
char *read_buffer = stackbuf;
ptrdiff_t read_buffer_size = sizeof stackbuf;
char *heapbuf = NULL;
char *p = read_buffer;
char *end = read_buffer + read_buffer_size;
int ch;
/* True if we saw an escape sequence specifying
a multibyte character. */
bool force_multibyte = 0;
bool force_multibyte = false;
/* True if we saw an escape sequence specifying
a single-byte character. */
bool force_singlebyte = 0;
bool cancel = 0;
bool force_singlebyte = false;
bool cancel = false;
ptrdiff_t nchars = 0;
while ((ch = READCHAR) >= 0
......@@ -3102,7 +3122,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
if (end - p < MAX_MULTIBYTE_LENGTH)
{
ptrdiff_t offset = p - read_buffer;
grow_read_buffer ();
read_buffer = grow_read_buffer (read_buffer, offset,
&heapbuf, &read_buffer_size,
count);
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
......@@ -3117,7 +3139,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
if (ch == -1)
{
if (p == read_buffer)
cancel = 1;
cancel = true;
continue;
}
......@@ -3125,9 +3147,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
ch = ch & ~CHAR_MODIFIER_MASK;
if (CHAR_BYTE8_P (ch))
force_singlebyte = 1;
force_singlebyte = true;
else if (! ASCII_CHAR_P (ch))
force_multibyte = 1;
force_multibyte = true;
else /* I.e. ASCII_CHAR_P (ch). */
{
/* Allow `\C- ' and `\C-?'. */
......@@ -3153,7 +3175,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
string. */
modifiers &= ~CHAR_META;
ch = BYTE8_TO_CHAR (ch | 0x80);
force_singlebyte = 1;
force_singlebyte = true;
}
}
......@@ -3166,9 +3188,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
{
p += CHAR_STRING (ch, (unsigned char *) p);
if (CHAR_BYTE8_P (ch))
force_singlebyte = 1;
force_singlebyte = true;
else if (! ASCII_CHAR_P (ch))
force_multibyte = 1;
force_multibyte = true;
}
nchars++;
}
......@@ -3180,7 +3202,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
return zero instead. This is for doc strings
that we are really going to find in etc/DOC.nn.nn. */
if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
return make_number (0);
return unbind_to (count, make_number (0));
if (! force_multibyte && force_singlebyte)
{
......@@ -3191,9 +3213,11 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
p = read_buffer + nchars;
}
return make_specified_string (read_buffer, nchars, p - read_buffer,
(force_multibyte
|| (p - read_buffer != nchars)));
Lisp_Object result
= make_specified_string (read_buffer, nchars, p - read_buffer,
(force_multibyte
|| (p - read_buffer != nchars)));
return unbind_to (count, result);
}
case '.':
......@@ -3221,81 +3245,74 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
read_symbol:
{
ptrdiff_t count = SPECPDL_INDEX ();
char *read_buffer = stackbuf;
ptrdiff_t read_buffer_size = sizeof stackbuf;
char *heapbuf = NULL;
char *p = read_buffer;
bool quoted = 0;
char *end = read_buffer + read_buffer_size;
bool quoted = false;
EMACS_INT start_position = readchar_count - 1;
{
char *end = read_buffer + read_buffer_size;
do
{
if (end - p < MAX_MULTIBYTE_LENGTH)
{
ptrdiff_t offset = p - read_buffer;
grow_read_buffer ();
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
do
{
if (end - p < MAX_MULTIBYTE_LENGTH + 1)
{
ptrdiff_t offset = p - read_buffer;
read_buffer = grow_read_buffer (read_buffer, offset,
&heapbuf, &read_buffer_size,
count);
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
if (c == '\\')
{
c = READCHAR;
if (c == -1)
end_of_file_error ();
quoted = 1;
}
if (c == '\\')
{
c = READCHAR;
if (c == -1)
end_of_file_error ();
quoted = true;
}
if (multibyte)
p += CHAR_STRING (c, (unsigned char *) p);
else
*p++ = c;
c = READCHAR;
}
while (c > 040
&& c != NO_BREAK_SPACE
&& (c >= 0200
|| strchr ("\"';()[]#`,", c) == NULL));
if (multibyte)
p += CHAR_STRING (c, (unsigned char *) p);
else
*p++ = c;
c = READCHAR;
}
while (c > 040
&& c != NO_BREAK_SPACE
&& (c >= 0200
|| strchr ("\"';()[]#`,", c) == NULL));
if (p == end)
{
ptrdiff_t offset = p - read_buffer;
grow_read_buffer ();
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
*p = 0;
UNREAD (c);
}
*p = 0;
UNREAD (c);
if (!quoted && !uninterned_symbol)
{
Lisp_Object result = string_to_number (read_buffer, 10, 0);
if (! NILP (result))
return result;
return unbind_to (count, result);
}
{
Lisp_Object name, result;
ptrdiff_t nbytes = p - read_buffer;
ptrdiff_t nchars
= (multibyte
? multibyte_chars_in_text ((unsigned char *) read_buffer,
nbytes)
: nbytes);
name = ((uninterned_symbol && ! NILP (Vpurify_flag)
? make_pure_string : make_specified_string)
(read_buffer, nchars, nbytes, multibyte));
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 result;
}
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);
}
}
}
......@@ -4104,12 +4121,7 @@ OBARRAY defaults to the value of `obarray'. */)
void
init_obarray (void)
{
Lisp_Object oblength;
ptrdiff_t size = 100 + MAX_MULTIBYTE_LENGTH;
XSETFASTINT (oblength, OBARRAY_SIZE);
Vobarray = Fmake_vector (oblength, make_number (0));
Vobarray = Fmake_vector (make_number (OBARRAY_SIZE), make_number (0));
initial_obarray = Vobarray;
staticpro (&initial_obarray);
......@@ -4132,9 +4144,6 @@ init_obarray (void)
Vpurify_flag = Qt;
DEFSYM (Qvariable_documentation, "variable-documentation");
read_buffer = xmalloc (size);
read_buffer_size = size;
}
void
......
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