mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-21 03:00:19 +02:00
Code Activity

Merge remote-tracking branch 'origin/stable-2.0'

Browse source 
Conflicts:
	libguile/ports.c
	libguile/ports.h
	libguile/read.c
	libguile/vm-i-system.c
This commit is contained in:
Andy Wingo 2012-05-08 22:43:04 +02:00
commit a3ded46520
12 changed files with 225 additions and 116 deletions
Download patch file Download diff file Expand all files Collapse all files

25
libguile/fports.c
View file

@ -174,7 +174,8 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
{
int cmode;
long csize;
SCM drained;
size_t ndrained;
char *drained;
scm_t_port *pt;
port = SCM_COERCE_OUTPORT (port);
@ -211,9 +212,21 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
pt = SCM_PTAB_ENTRY (port);
if (SCM_INPUT_PORT_P (port))
drained = scm_drain_input (port);
{
/* Drain pending input from PORT. Don't use `scm_drain_input' since
it returns a string, whereas we want binary input here. */
ndrained = pt->read_end - pt->read_pos;
if (pt->read_buf == pt->putback_buf)
ndrained += pt->saved_read_end - pt->saved_read_pos;
if (ndrained > 0)
{
drained = scm_gc_malloc_pointerless (ndrained, "file port");
scm_take_from_input_buffers (port, drained, ndrained);
}
}
else
drained = scm_nullstr;
ndrained = 0;
if (SCM_OUTPUT_PORT_P (port))
scm_flush_unlocked (port);
@ -232,8 +245,10 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
scm_fport_buffer_add (port, csize, csize);
if (scm_is_true (drained) && scm_c_string_length (drained))
scm_unread_string (drained, port);
if (ndrained > 0)
/* Put DRAINED back to PORT. */
while (ndrained-- > 0)
scm_unget_byte (drained[ndrained], port);
return SCM_UNSPECIFIED;
}

14
libguile/ports.c
View file

@ -2101,20 +2101,21 @@ scm_fill_input (SCM port)
return ret;
}
/* move up to read_len chars from port's putback and/or read buffers
into memory starting at dest. returns the number of chars moved. */
/* Move up to READ_LEN bytes from PORT's putback and/or read buffers
into memory starting at DEST. Return the number of bytes moved.
PORT's line/column numbers are left unchanged. */
size_t
scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
size_t chars_read = 0;
size_t bytes_read = 0;
size_t from_buf = min (pt->read_end - pt->read_pos, read_len);
if (from_buf > 0)
{
memcpy (dest, pt->read_pos, from_buf);
pt->read_pos += from_buf;
chars_read += from_buf;
bytes_read += from_buf;
read_len -= from_buf;
dest += from_buf;
}
@ -2127,10 +2128,11 @@ scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
{
memcpy (dest, pt->saved_read_pos, from_buf);
pt->saved_read_pos += from_buf;
chars_read += from_buf;
bytes_read += from_buf;
}
}
return chars_read;
return bytes_read;
}
/* Clear a port's read buffers, returning the contents. */

4
libguile/ports.h
View file

@ -324,8 +324,8 @@ SCM_API scm_t_wchar scm_getc_unlocked (SCM port);
SCM_API SCM scm_read_char (SCM port);
/* Pushback. */
SCM_INTERNAL void scm_unget_byte (int c, SCM port);
SCM_INTERNAL void scm_unget_byte_unlocked (int c, SCM port);
SCM_API void scm_unget_byte (int c, SCM port);
SCM_API void scm_unget_byte_unlocked (int c, SCM port);
SCM_API void scm_ungetc (scm_t_wchar c, SCM port);
SCM_API void scm_ungetc_unlocked (scm_t_wchar c, SCM port);
SCM_API void scm_ungets (const char *s, int n, SCM port);

142
libguile/read.c
View file

@ -161,8 +161,8 @@ scm_i_read_hash_procedures_set_x (SCM value)
/* Size of the C buffer used to read symbols and numbers. */
#define READER_BUFFER_SIZE 128
/* Size of the C buffer used to read strings. */
#define READER_STRING_BUFFER_SIZE 512
/* Number of 32-bit codepoints in the buffer used to read strings. */
#define READER_STRING_BUFFER_SIZE 128
/* The maximum size of Scheme character names. */
#define READER_CHAR_NAME_MAX_SIZE 50
@ -208,8 +208,8 @@ static SCM scm_get_hash_procedure (int);
fewer than BUF_SIZE bytes, non-zero otherwise. READ will be set the number of
bytes actually read. */
static int
read_token (SCM port, char *buf, const size_t buf_size, size_t *read)
{
read_token (SCM port, char *buf, size_t buf_size, size_t *read)
{
*read = 0;
while (*read < buf_size)
@ -235,20 +235,15 @@ read_token (SCM port, char *buf, const size_t buf_size, size_t *read)
return 1;
}
/* Read from PORT until a delimiter (e.g., a whitespace) is read. Put the
result in the pre-allocated buffer BUFFER, if the whole token has fewer than
BUFFER_SIZE bytes, or into OVERFLOW_BUFFER, allocated here to be freed by the
caller. Return zero if the token fits in BUFFER, non-zero otherwise. READ
will be set the number of bytes actually read. */
static int
read_complete_token (SCM port, char *buffer, const size_t buffer_size,
char **overflow_buffer, size_t *read)
/* Like `read_token', but return either BUFFER, or a GC-allocated buffer
if the token doesn't fit in BUFFER_SIZE bytes. */
static char *
read_complete_token (SCM port, char *buffer, size_t buffer_size,
size_t *read)
{
int overflow = 0;
size_t bytes_read, overflow_size;
*overflow_buffer = NULL;
overflow_size = 0;
size_t bytes_read, overflow_size = 0;
char *overflow_buffer = NULL;
do
{
@ -259,14 +254,19 @@ read_complete_token (SCM port, char *buffer, const size_t buffer_size,
{
if (overflow_size == 0)
{
*overflow_buffer = scm_malloc (bytes_read);
memcpy (*overflow_buffer, buffer, bytes_read);
overflow_buffer = scm_gc_malloc_pointerless (bytes_read, "read");
memcpy (overflow_buffer, buffer, bytes_read);
overflow_size = bytes_read;
}
else
{
*overflow_buffer = scm_realloc (*overflow_buffer, overflow_size + bytes_read);
memcpy (*overflow_buffer + overflow_size, buffer, bytes_read);
char *new_buf =
scm_gc_malloc_pointerless (overflow_size + bytes_read, "read");
memcpy (new_buf, overflow_buffer, overflow_size);
memcpy (new_buf + overflow_size, buffer, bytes_read);
overflow_buffer = new_buf;
overflow_size += bytes_read;
}
}
@ -278,7 +278,7 @@ read_complete_token (SCM port, char *buffer, const size_t buffer_size,
else
*read = bytes_read;
return (overflow_size != 0);
return (overflow_size > 0 ? overflow_buffer : buffer);
}
/* Skip whitespace from PORT and return the first non-whitespace character
@ -493,15 +493,14 @@ scm_read_string (int chr, SCM port)
/* For strings smaller than C_STR, this function creates only one Scheme
object (the string returned). */
SCM str = SCM_BOOL_F;
unsigned c_str_len = 0;
scm_t_wchar c;
SCM str = SCM_EOL;
size_t c_str_len = 0;
scm_t_wchar c, c_str[READER_STRING_BUFFER_SIZE];
/* Need to capture line and column numbers here. */
long line = SCM_LINUM (port);
int column = SCM_COL (port) - 1;
str = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL, 0);
while ('"' != (c = scm_getc_unlocked (port)))
{
if (c == EOF)
@ -511,12 +510,11 @@ scm_read_string (int chr, SCM port)
"end of file in string constant", SCM_EOL);
}
if (c_str_len + 1 >= scm_i_string_length (str))
{
SCM addy = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL, 0);
str = scm_string_append (scm_list_2 (str, addy));
}
if (c_str_len + 1 >= READER_STRING_BUFFER_SIZE)
{
str = scm_cons (scm_from_utf32_stringn (c_str, c_str_len), str);
c_str_len = 0;
}
if (c == '\\')
{
@ -580,12 +578,22 @@ scm_read_string (int chr, SCM port)
scm_list_1 (SCM_MAKE_CHAR (c)));
}
}
str = scm_i_string_start_writing (str);
scm_i_string_set_x (str, c_str_len++, c);
scm_i_string_stop_writing ();
c_str[c_str_len++] = c;
}
return maybe_annotate_source (scm_i_substring_copy (str, 0, c_str_len),
port, line, column);
if (scm_is_null (str))
/* Fast path: we got a string that fits in C_STR. */
str = scm_from_utf32_stringn (c_str, c_str_len);
else
{
if (c_str_len > 0)
str = scm_cons (scm_from_utf32_stringn (c_str, c_str_len), str);
str = scm_string_concatenate_reverse (str, SCM_UNDEFINED, SCM_UNDEFINED);
}
return maybe_annotate_source (str, port, line, column);
}
#undef FUNC_NAME
@ -594,10 +602,8 @@ static SCM
scm_read_number (scm_t_wchar chr, SCM port)
{
SCM result, str = SCM_EOL;
char buffer[READER_BUFFER_SIZE];
char *overflow_buffer = NULL;
char local_buffer[READER_BUFFER_SIZE], *buffer;
size_t bytes_read;
int overflow;
scm_t_port *pt = SCM_PTAB_ENTRY (port);
/* Need to capture line and column numbers here. */
@ -605,14 +611,10 @@ scm_read_number (scm_t_wchar chr, SCM port)
int column = SCM_COL (port) - 1;
scm_ungetc_unlocked (chr, port);
overflow = read_complete_token (port, buffer, sizeof (buffer),
&overflow_buffer, &bytes_read);
buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
&bytes_read);
if (!overflow)
str = scm_from_stringn (buffer, bytes_read, pt->encoding, pt->ilseq_handler);
else
str = scm_from_stringn (overflow_buffer, bytes_read, pt->encoding,
pt->ilseq_handler);
str = scm_from_stringn (buffer, bytes_read, pt->encoding, pt->ilseq_handler);
result = scm_string_to_number (str, SCM_UNDEFINED);
if (scm_is_false (result))
@ -625,8 +627,6 @@ scm_read_number (scm_t_wchar chr, SCM port)
else if (SCM_NIMP (result))
result = maybe_annotate_source (result, port, line, column);
if (overflow)
free (overflow_buffer);
SCM_COL (port) += scm_i_string_length (str);
return result;
}
@ -638,29 +638,20 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port)
int ends_with_colon = 0;
size_t bytes_read;
int postfix = scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_postfix);
int overflow;
char buffer[READER_BUFFER_SIZE], *overflow_buffer;
char local_buffer[READER_BUFFER_SIZE], *buffer;
scm_t_port *pt = SCM_PTAB_ENTRY (port);
SCM str;
scm_ungetc_unlocked (chr, port);
overflow = read_complete_token (port, buffer, READER_BUFFER_SIZE,
&overflow_buffer, &bytes_read);
buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
&bytes_read);
if (bytes_read > 0)
{
if (!overflow)
ends_with_colon = buffer[bytes_read - 1] == ':';
else
ends_with_colon = overflow_buffer[bytes_read - 1] == ':';
}
ends_with_colon = buffer[bytes_read - 1] == ':';
if (postfix && ends_with_colon && (bytes_read > 1))
{
if (!overflow)
str = scm_from_stringn (buffer, bytes_read - 1, pt->encoding, pt->ilseq_handler);
else
str = scm_from_stringn (overflow_buffer, bytes_read - 1, pt->encoding,
pt->ilseq_handler);
str = scm_from_stringn (buffer, bytes_read - 1,
pt->encoding, pt->ilseq_handler);
if (SCM_CASE_INSENSITIVE_P)
str = scm_string_downcase_x (str);
@ -668,19 +659,14 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port)
}
else
{
if (!overflow)
str = scm_from_stringn (buffer, bytes_read, pt->encoding, pt->ilseq_handler);
else
str = scm_from_stringn (overflow_buffer, bytes_read, pt->encoding,
pt->ilseq_handler);
str = scm_from_stringn (buffer, bytes_read,
pt->encoding, pt->ilseq_handler);
if (SCM_CASE_INSENSITIVE_P)
str = scm_string_downcase_x (str);
result = scm_string_to_symbol (str);
}
if (overflow)
free (overflow_buffer);
SCM_COL (port) += scm_i_string_length (str);
return result;
}
@ -691,8 +677,7 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port)
{
SCM result;
size_t read;
char buffer[READER_BUFFER_SIZE], *overflow_buffer;
int overflow;
char local_buffer[READER_BUFFER_SIZE], *buffer;
unsigned int radix;
SCM str;
scm_t_port *pt;
@ -725,21 +710,14 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port)
radix = 10;
}
overflow = read_complete_token (port, buffer, sizeof (buffer),
&overflow_buffer, &read);
buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
&read);
pt = SCM_PTAB_ENTRY (port);
if (!overflow)
str = scm_from_stringn (buffer, read, pt->encoding, pt->ilseq_handler);
else
str = scm_from_stringn (overflow_buffer, read, pt->encoding,
pt->ilseq_handler);
str = scm_from_stringn (buffer, read, pt->encoding, pt->ilseq_handler);
result = scm_string_to_number (str, scm_from_uint (radix));
if (overflow)
free (overflow_buffer);
SCM_COL (port) += scm_i_string_length (str);
if (scm_is_true (result))

1
libguile/vm-i-system.c
View file

@ -310,6 +310,7 @@ VM_DEFINE_INSTRUCTION (25, variable_ref, "variable-ref", 0, 1, 1)
{
SCM var_name;
SYNC_ALL ();
/* Attempt to provide the variable name in the error message. */
var_name = scm_module_reverse_lookup (scm_current_module (), x);
vm_error_unbound (program, scm_is_true (var_name) ? var_name : x);