1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

locking on unget_byte, ungetc, ungets

* libguile/ports.h:
* libguile/ports.c (scm_unget_byte_unlocked, scm_unget_byte)
  (scm_ungetc_unlocked, scm_ungetc, scm_ungets_unlocked, scm_ungets):
  Add locking and _unlocked variants.

* libguile/arrays.c:
* libguile/rdelim.c:
* libguile/read.c:
* libguile/vports.c: Adapt callers to use the _unlocked variants.
This commit is contained in:
Andy Wingo 2011-11-08 00:14:16 +01:00
parent be632904ca
commit c932ce0b55
6 changed files with 63 additions and 38 deletions

View file

@ -862,7 +862,7 @@ scm_i_read_array (SCM port, int c)
*/ */
if (c == '(') if (c == '(')
{ {
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
return scm_vector (scm_read (port)); return scm_vector (scm_read (port));
} }
@ -874,7 +874,7 @@ scm_i_read_array (SCM port, int c)
if (c != '3' && c != '6') if (c != '3' && c != '6')
{ {
if (c != EOF) if (c != EOF)
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
return SCM_BOOL_F; return SCM_BOOL_F;
} }
rank = 1; rank = 1;
@ -954,7 +954,7 @@ scm_i_read_array (SCM port, int c)
scm_i_input_error (NULL, port, scm_i_input_error (NULL, port,
"missing '(' in vector or array literal", "missing '(' in vector or array literal",
SCM_EOL); SCM_EOL);
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
elements = scm_read (port); elements = scm_read (port);
if (scm_is_false (shape)) if (scm_is_false (shape))

View file

@ -1703,7 +1703,7 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0,
/* Pushback. */ /* Pushback. */
void void
scm_unget_byte (int c, SCM port) scm_unget_byte_unlocked (int c, SCM port)
#define FUNC_NAME "scm_unget_byte" #define FUNC_NAME "scm_unget_byte"
{ {
scm_t_port *pt = SCM_PTAB_ENTRY (port); scm_t_port *pt = SCM_PTAB_ENTRY (port);
@ -1767,7 +1767,15 @@ scm_unget_byte (int c, SCM port)
#undef FUNC_NAME #undef FUNC_NAME
void void
scm_ungetc (scm_t_wchar c, SCM port) scm_unget_byte (int c, SCM port)
{
scm_c_lock_port (port);
scm_unget_byte_unlocked (c, port);
scm_c_unlock_port (port);
}
void
scm_ungetc_unlocked (scm_t_wchar c, SCM port)
#define FUNC_NAME "scm_ungetc" #define FUNC_NAME "scm_ungetc"
{ {
scm_t_port *pt = SCM_PTAB_ENTRY (port); scm_t_port *pt = SCM_PTAB_ENTRY (port);
@ -1794,7 +1802,7 @@ scm_ungetc (scm_t_wchar c, SCM port)
SCM_BOOL_F, SCM_MAKE_CHAR (c)); SCM_BOOL_F, SCM_MAKE_CHAR (c));
for (i = len - 1; i >= 0; i--) for (i = len - 1; i >= 0; i--)
scm_unget_byte (result[i], port); scm_unget_byte_unlocked (result[i], port);
if (SCM_UNLIKELY (result != result_buf)) if (SCM_UNLIKELY (result != result_buf))
free (result); free (result);
@ -1811,9 +1819,16 @@ scm_ungetc (scm_t_wchar c, SCM port)
} }
#undef FUNC_NAME #undef FUNC_NAME
void
scm_ungetc (scm_t_wchar c, SCM port)
{
scm_c_lock_port (port);
scm_ungetc_unlocked (c, port);
scm_c_unlock_port (port);
}
void void
scm_ungets (const char *s, int n, SCM port) scm_ungets_unlocked (const char *s, int n, SCM port)
{ {
/* This is simple minded and inefficient, but unreading strings is /* This is simple minded and inefficient, but unreading strings is
* probably not a common operation, and remember that line and * probably not a common operation, and remember that line and
@ -1822,9 +1837,16 @@ scm_ungets (const char *s, int n, SCM port)
* Please feel free to write an optimized version! * Please feel free to write an optimized version!
*/ */
while (n--) while (n--)
scm_ungetc (s[n], port); scm_ungetc_unlocked (s[n], port);
} }
void
scm_ungets (const char *s, int n, SCM port)
{
scm_c_lock_port (port);
scm_ungets_unlocked (s, n, port);
scm_c_unlock_port (port);
}
SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0, SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0,
(SCM port), (SCM port),
@ -1866,7 +1888,7 @@ SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0,
err = get_codepoint (port, &c, bytes, &len); err = get_codepoint (port, &c, bytes, &len);
for (i = len - 1; i >= 0; i--) for (i = len - 1; i >= 0; i--)
scm_unget_byte (bytes[i], port); scm_unget_byte_unlocked (bytes[i], port);
SCM_COL (port) = column; SCM_COL (port) = column;
SCM_LINUM (port) = line; SCM_LINUM (port) = line;
@ -1904,7 +1926,7 @@ SCM_DEFINE (scm_unread_char, "unread-char", 1, 1, 0,
c = SCM_CHAR (cobj); c = SCM_CHAR (cobj);
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
return cobj; return cobj;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -1926,7 +1948,7 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0,
n = scm_i_string_length (str); n = scm_i_string_length (str);
while (n--) while (n--)
scm_ungetc (scm_i_string_ref (str, n), port); scm_ungetc_unlocked (scm_i_string_ref (str, n), port);
return str; return str;
} }

View file

@ -306,8 +306,8 @@ SCM_API SCM scm_adjust_port_revealed_x (SCM port, SCM addend);
/* Input. */ /* Input. */
SCM_API int scm_get_byte_or_eof (SCM port); SCM_API int scm_get_byte_or_eof (SCM port);
SCM_API int scm_peek_byte_or_eof (SCM port);
SCM_INLINE int scm_get_byte_or_eof_unlocked (SCM port); SCM_INLINE int scm_get_byte_or_eof_unlocked (SCM port);
SCM_API int scm_peek_byte_or_eof (SCM port);
SCM_INLINE int scm_peek_byte_or_eof_unlocked (SCM port); SCM_INLINE int scm_peek_byte_or_eof_unlocked (SCM port);
SCM_API size_t scm_c_read (SCM port, void *buffer, size_t size); SCM_API size_t scm_c_read (SCM port, void *buffer, size_t size);
SCM_API size_t scm_c_read_unlocked (SCM port, void *buffer, size_t size); SCM_API size_t scm_c_read_unlocked (SCM port, void *buffer, size_t size);
@ -317,8 +317,11 @@ SCM_API SCM scm_read_char (SCM port);
/* Pushback. */ /* Pushback. */
SCM_INTERNAL void scm_unget_byte (int c, SCM port); 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_ungetc (scm_t_wchar 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); SCM_API void scm_ungets (const char *s, int n, SCM port);
SCM_API void scm_ungets_unlocked (const char *s, int n, SCM port);
SCM_API SCM scm_peek_char (SCM port); SCM_API SCM scm_peek_char (SCM port);
SCM_API SCM scm_unread_char (SCM cobj, SCM port); SCM_API SCM scm_unread_char (SCM cobj, SCM port);
SCM_API SCM scm_unread_string (SCM str, SCM port); SCM_API SCM scm_unread_string (SCM str, SCM port);

View file

@ -85,7 +85,7 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
if (scm_i_string_ref (delims, k) == c) if (scm_i_string_ref (delims, k) == c)
{ {
if (scm_is_false (gobble)) if (scm_is_false (gobble))
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
return scm_cons (SCM_MAKE_CHAR (c), return scm_cons (SCM_MAKE_CHAR (c),
scm_from_size_t (j - cstart)); scm_from_size_t (j - cstart));

View file

@ -222,7 +222,7 @@ read_token (SCM port, char *buf, const size_t buf_size, size_t *read)
return 0; return 0;
else if (CHAR_IS_DELIMITER (chr)) else if (CHAR_IS_DELIMITER (chr))
{ {
scm_unget_byte (chr, port); scm_unget_byte_unlocked (chr, port);
return 0; return 0;
} }
else else
@ -334,7 +334,7 @@ flush_ws (SCM port, const char *eoferr)
} }
/* fall through */ /* fall through */
default: default:
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
return '#'; return '#';
} }
break; break;
@ -375,7 +375,7 @@ scm_read_sexp (scm_t_wchar chr, SCM port)
if (terminating_char == c) if (terminating_char == c)
return SCM_EOL; return SCM_EOL;
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
tmp = scm_read_expression (port); tmp = scm_read_expression (port);
/* Note that it is possible for scm_read_expression to return /* Note that it is possible for scm_read_expression to return
@ -402,7 +402,7 @@ scm_read_sexp (scm_t_wchar chr, SCM port)
"in pair: mismatched close paren: ~A", "in pair: mismatched close paren: ~A",
scm_list_1 (SCM_MAKE_CHAR (c))); scm_list_1 (SCM_MAKE_CHAR (c)));
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
tmp = scm_read_expression (port); tmp = scm_read_expression (port);
/* See above note about scm_sym_dot. */ /* See above note about scm_sym_dot. */
@ -478,7 +478,7 @@ skip_intraline_whitespace (SCM port)
} }
while (c == '\t' || uc_is_general_category (c, UC_SPACE_SEPARATOR)); while (c == '\t' || uc_is_general_category (c, UC_SPACE_SEPARATOR));
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
} }
static SCM static SCM
@ -596,7 +596,7 @@ scm_read_number (scm_t_wchar chr, SCM port)
int overflow; int overflow;
scm_t_port *pt = SCM_PTAB_ENTRY (port); scm_t_port *pt = SCM_PTAB_ENTRY (port);
scm_ungetc (chr, port); scm_ungetc_unlocked (chr, port);
overflow = read_complete_token (port, buffer, sizeof (buffer), overflow = read_complete_token (port, buffer, sizeof (buffer),
&overflow_buffer, &bytes_read); &overflow_buffer, &bytes_read);
@ -633,7 +633,7 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port)
scm_t_port *pt = SCM_PTAB_ENTRY (port); scm_t_port *pt = SCM_PTAB_ENTRY (port);
SCM str; SCM str;
scm_ungetc (chr, port); scm_ungetc_unlocked (chr, port);
overflow = read_complete_token (port, buffer, READER_BUFFER_SIZE, overflow = read_complete_token (port, buffer, READER_BUFFER_SIZE,
&overflow_buffer, &bytes_read); &overflow_buffer, &bytes_read);
if (bytes_read > 0) if (bytes_read > 0)
@ -710,8 +710,8 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port)
break; break;
default: default:
scm_ungetc (chr, port); scm_ungetc_unlocked (chr, port);
scm_ungetc ('#', port); scm_ungetc_unlocked ('#', port);
radix = 10; radix = 10;
} }
@ -767,7 +767,7 @@ scm_read_quote (int chr, SCM port)
p = scm_sym_uq_splicing; p = scm_sym_uq_splicing;
else else
{ {
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
p = scm_sym_unquote; p = scm_sym_unquote;
} }
break; break;
@ -817,7 +817,7 @@ scm_read_syntax (int chr, SCM port)
p = sym_unsyntax_splicing; p = sym_unsyntax_splicing;
else else
{ {
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
p = sym_unsyntax; p = sym_unsyntax;
} }
break; break;
@ -1064,7 +1064,7 @@ scm_read_guile_bit_vector (scm_t_wchar chr, SCM port)
} }
if (chr != EOF) if (chr != EOF)
scm_ungetc (chr, port); scm_ungetc_unlocked (chr, port);
return scm_bitvector (scm_reverse_x (s_bits, SCM_EOL)); return scm_bitvector (scm_reverse_x (s_bits, SCM_EOL));
} }
@ -1099,28 +1099,28 @@ scm_read_shebang (scm_t_wchar chr, SCM port)
int c = 0; int c = 0;
if ((c = scm_get_byte_or_eof_unlocked (port)) != 'r') if ((c = scm_get_byte_or_eof_unlocked (port)) != 'r')
{ {
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
return scm_read_scsh_block_comment (chr, port); return scm_read_scsh_block_comment (chr, port);
} }
if ((c = scm_get_byte_or_eof_unlocked (port)) != '6') if ((c = scm_get_byte_or_eof_unlocked (port)) != '6')
{ {
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
scm_ungetc ('r', port); scm_ungetc_unlocked ('r', port);
return scm_read_scsh_block_comment (chr, port); return scm_read_scsh_block_comment (chr, port);
} }
if ((c = scm_get_byte_or_eof_unlocked (port)) != 'r') if ((c = scm_get_byte_or_eof_unlocked (port)) != 'r')
{ {
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
scm_ungetc ('6', port); scm_ungetc_unlocked ('6', port);
scm_ungetc ('r', port); scm_ungetc_unlocked ('r', port);
return scm_read_scsh_block_comment (chr, port); return scm_read_scsh_block_comment (chr, port);
} }
if ((c = scm_get_byte_or_eof_unlocked (port)) != 's') if ((c = scm_get_byte_or_eof_unlocked (port)) != 's')
{ {
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
scm_ungetc ('r', port); scm_ungetc_unlocked ('r', port);
scm_ungetc ('6', port); scm_ungetc_unlocked ('6', port);
scm_ungetc ('r', port); scm_ungetc_unlocked ('r', port);
return scm_read_scsh_block_comment (chr, port); return scm_read_scsh_block_comment (chr, port);
} }
@ -1174,7 +1174,7 @@ scm_read_commented_expression (scm_t_wchar chr, SCM port)
if (EOF == c) if (EOF == c)
scm_i_input_error ("read_commented_expression", port, scm_i_input_error ("read_commented_expression", port,
"no expression after #; comment", SCM_EOL); "no expression after #; comment", SCM_EOL);
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
scm_read_expression (port); scm_read_expression (port);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -1476,7 +1476,7 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0,
c = flush_ws (port, (char *) NULL); c = flush_ws (port, (char *) NULL);
if (EOF == c) if (EOF == c)
return SCM_EOF_VAL; return SCM_EOF_VAL;
scm_ungetc (c, port); scm_ungetc_unlocked (c, port);
return (scm_read_expression (port)); return (scm_read_expression (port));
} }

View file

@ -114,7 +114,7 @@ sf_fill_input (SCM port)
return *pt->read_buf; return *pt->read_buf;
} }
else else
scm_ungetc (SCM_CHAR (ans), port); scm_ungetc_unlocked (SCM_CHAR (ans), port);
return SCM_CHAR (ans); return SCM_CHAR (ans);
} }