From: Andy Wingo Date: Mon, 7 Nov 2011 22:53:06 +0000 (+0100) Subject: locking on scm_c_read, scm_getc X-Git-Url: https://git.hcoop.net/bpt/guile.git/commitdiff_plain/be632904cafd0c5baf38b2ef970acc2c72af6cd3 locking on scm_c_read, scm_getc * libguile/ports.c (scm_c_read_unlocked, scm_c_read, scm_getc_unlocked) (scm_getc): Split getc and read operations into locked and unlocked variants. Change most uses to use the _unlocked version. --- diff --git a/libguile/arrays.c b/libguile/arrays.c index cc5c72602..de221a90d 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -832,14 +832,14 @@ read_decimal_integer (SCM port, int c, ssize_t *resp) if (c == '-') { sign = -1; - c = scm_getc (port); + c = scm_getc_unlocked (port); } while ('0' <= c && c <= '9') { res = 10*res + c-'0'; got_it = 1; - c = scm_getc (port); + c = scm_getc_unlocked (port); } if (got_it) @@ -870,7 +870,7 @@ scm_i_read_array (SCM port, int c) */ if (c == 'f') { - c = scm_getc (port); + c = scm_getc_unlocked (port); if (c != '3' && c != '6') { if (c != EOF) @@ -899,7 +899,7 @@ scm_i_read_array (SCM port, int c) && tag_len < sizeof tag_buf / sizeof tag_buf[0]) { tag_buf[tag_len++] = c; - c = scm_getc (port); + c = scm_getc_unlocked (port); } if (tag_len == 0) tag = SCM_BOOL_T; @@ -924,7 +924,7 @@ scm_i_read_array (SCM port, int c) if (c == '@') { - c = scm_getc (port); + c = scm_getc_unlocked (port); c = read_decimal_integer (port, c, &lbnd); } @@ -932,7 +932,7 @@ scm_i_read_array (SCM port, int c) if (c == ':') { - c = scm_getc (port); + c = scm_getc_unlocked (port); c = read_decimal_integer (port, c, &len); if (len < 0) scm_i_input_error (NULL, port, diff --git a/libguile/ports.c b/libguile/ports.c index 50e73dd35..6c763c1c7 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -1226,7 +1226,7 @@ swap_buffer (void *data) } size_t -scm_c_read (SCM port, void *buffer, size_t size) +scm_c_read_unlocked (SCM port, void *buffer, size_t size) #define FUNC_NAME "scm_c_read" { scm_t_port *pt; @@ -1329,6 +1329,18 @@ scm_c_read (SCM port, void *buffer, size_t size) } #undef FUNC_NAME +size_t +scm_c_read (SCM port, void *buffer, size_t size) +{ + size_t ret; + + scm_c_lock_port (port); + ret = scm_c_read_unlocked (port, buffer, size); + scm_c_unlock_port (port); + + return ret; +} + /* Update the line and column number of PORT after consumption of C. */ static inline void update_port_lf (scm_t_wchar c, SCM port) @@ -1633,7 +1645,7 @@ get_codepoint (SCM port, scm_t_wchar *codepoint, /* Read a codepoint from PORT and return it. */ scm_t_wchar -scm_getc (SCM port) +scm_getc_unlocked (SCM port) #define FUNC_NAME "scm_getc" { int err; @@ -1651,6 +1663,18 @@ scm_getc (SCM port) } #undef FUNC_NAME +scm_t_wchar +scm_getc (SCM port) +{ + scm_t_wchar ret; + + scm_c_lock_port (port); + ret = scm_getc_unlocked (port); + scm_c_unlock_port (port); + + return ret; +} + SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0, (SCM port), "Return the next character available from @var{port}, updating\n" @@ -1666,7 +1690,7 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0, if (SCM_UNBNDP (port)) port = scm_current_input_port (); SCM_VALIDATE_OPINPORT (1, port); - c = scm_getc (port); + c = scm_getc_unlocked (port); if (EOF == c) return SCM_EOF_VAL; return SCM_MAKE_CHAR (c); diff --git a/libguile/ports.h b/libguile/ports.h index 2bb2ac46f..1abf30ff4 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -310,7 +310,9 @@ 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_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_unlocked (SCM port, void *buffer, size_t size); SCM_API scm_t_wchar scm_getc (SCM port); +SCM_API scm_t_wchar scm_getc_unlocked (SCM port); SCM_API SCM scm_read_char (SCM port); /* Pushback. */ diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c index 06576e98e..4d7b1073f 100644 --- a/libguile/r6rs-ports.c +++ b/libguile/r6rs-ports.c @@ -475,7 +475,7 @@ SCM_DEFINE (scm_get_bytevector_n, "get-bytevector-n", 2, 0, 0, if (SCM_LIKELY (c_count > 0)) /* XXX: `scm_c_read ()' does not update the port position. */ - c_read = scm_c_read (port, c_bv, c_count); + c_read = scm_c_read_unlocked (port, c_bv, c_count); else /* Don't invoke `scm_c_read ()' since it may block. */ c_read = 0; @@ -522,7 +522,7 @@ SCM_DEFINE (scm_get_bytevector_n_x, "get-bytevector-n!", 4, 0, 0, scm_out_of_range (FUNC_NAME, count); if (SCM_LIKELY (c_count > 0)) - c_read = scm_c_read (port, c_bv + c_start, c_count); + c_read = scm_c_read_unlocked (port, c_bv + c_start, c_count); else /* Don't invoke `scm_c_read ()' since it may block. */ c_read = 0; @@ -577,7 +577,7 @@ SCM_DEFINE (scm_get_bytevector_some, "get-bytevector-some", 1, 0, 0, } /* We can't use `scm_c_read ()' since it blocks. */ - c_chr = scm_getc (port); + c_chr = scm_getc_unlocked (port); if (c_chr != EOF) { c_bv[c_total] = (char) c_chr; @@ -642,7 +642,7 @@ SCM_DEFINE (scm_get_bytevector_all, "get-bytevector-all", 1, 0, 0, /* `scm_c_read ()' blocks until C_COUNT bytes are available or EOF is reached. */ - c_read = scm_c_read (port, c_bv + c_total, c_count); + c_read = scm_c_read_unlocked (port, c_bv + c_total, c_count); c_total += c_read, c_count -= c_read; } while (!SCM_EOF_OBJECT_P (scm_peek_char (port))); @@ -1231,7 +1231,7 @@ SCM_DEFINE (scm_get_string_n_x, for (j = c_start; j < c_end; j++) { - c = scm_getc (port); + c = scm_getc_unlocked (port); if (c == EOF) { size_t chars_read = j - c_start; diff --git a/libguile/rdelim.c b/libguile/rdelim.c index 9d1496795..97b545f82 100644 --- a/libguile/rdelim.c +++ b/libguile/rdelim.c @@ -79,7 +79,7 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0, { size_t k; - c = scm_getc (port); + c = scm_getc_unlocked (port); for (k = 0; k < num_delims; k++) { if (scm_i_string_ref (delims, k) == c) @@ -149,7 +149,7 @@ SCM_DEFINE (scm_read_line, "%read-line", 0, 1, 0, } else { - buf[index] = scm_getc (port); + buf[index] = scm_getc_unlocked (port); switch (buf[index]) { case EOF: diff --git a/libguile/read.c b/libguile/read.c index 06decc83d..09dbeb6b5 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -288,7 +288,7 @@ flush_ws (SCM port, const char *eoferr) { register scm_t_wchar c; while (1) - switch (c = scm_getc (port)) + switch (c = scm_getc_unlocked (port)) { case EOF: goteof: @@ -303,7 +303,7 @@ flush_ws (SCM port, const char *eoferr) case ';': lp: - switch (c = scm_getc (port)) + switch (c = scm_getc_unlocked (port)) { case EOF: goto goteof; @@ -315,7 +315,7 @@ flush_ws (SCM port, const char *eoferr) break; case '#': - switch (c = scm_getc (port)) + switch (c = scm_getc_unlocked (port)) { case EOF: eoferr = "read_sharp"; @@ -442,7 +442,7 @@ scm_read_sexp (scm_t_wchar chr, SCM port) c = 0; \ while (i < ndigits) \ { \ - a = scm_getc (port); \ + a = scm_getc_unlocked (port); \ if (a == EOF) \ goto str_eof; \ if (terminator \ @@ -472,7 +472,7 @@ skip_intraline_whitespace (SCM port) do { - c = scm_getc (port); + c = scm_getc_unlocked (port); if (c == EOF) return; } @@ -493,7 +493,7 @@ scm_read_string (int chr, SCM port) scm_t_wchar c; str = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL, 0); - while ('"' != (c = scm_getc (port))) + while ('"' != (c = scm_getc_unlocked (port))) { if (c == EOF) { @@ -511,7 +511,7 @@ scm_read_string (int chr, SCM port) if (c == '\\') { - switch (c = scm_getc (port)) + switch (c = scm_getc_unlocked (port)) { case EOF: goto str_eof; @@ -762,7 +762,7 @@ scm_read_quote (int chr, SCM port) { scm_t_wchar c; - c = scm_getc (port); + c = scm_getc_unlocked (port); if ('@' == c) p = scm_sym_uq_splicing; else @@ -812,7 +812,7 @@ scm_read_syntax (int chr, SCM port) { int c; - c = scm_getc (port); + c = scm_getc_unlocked (port); if ('@' == c) p = sym_unsyntax_splicing; else @@ -901,7 +901,7 @@ scm_read_character (scm_t_wchar chr, SCM port) if (bytes_read == 0) { - chr = scm_getc (port); + chr = scm_getc_unlocked (port); if (chr == EOF) scm_i_input_error (FUNC_NAME, port, "unexpected end of file " "while reading character", SCM_EOL); @@ -1028,15 +1028,15 @@ scm_read_srfi4_vector (int chr, SCM port) static SCM scm_read_bytevector (scm_t_wchar chr, SCM port) { - chr = scm_getc (port); + chr = scm_getc_unlocked (port); if (chr != 'u') goto syntax; - chr = scm_getc (port); + chr = scm_getc_unlocked (port); if (chr != '8') goto syntax; - chr = scm_getc (port); + chr = scm_getc_unlocked (port); if (chr != '(') goto syntax; @@ -1056,9 +1056,9 @@ scm_read_guile_bit_vector (scm_t_wchar chr, SCM port) terribly inefficient but who cares? */ SCM s_bits = SCM_EOL; - for (chr = scm_getc (port); + for (chr = scm_getc_unlocked (port); (chr != EOF) && ((chr == '0') || (chr == '1')); - chr = scm_getc (port)) + chr = scm_getc_unlocked (port)) { s_bits = scm_cons ((chr == '0') ? SCM_BOOL_F : SCM_BOOL_T, s_bits); } @@ -1076,7 +1076,7 @@ scm_read_scsh_block_comment (scm_t_wchar chr, SCM port) for (;;) { - int c = scm_getc (port); + int c = scm_getc_unlocked (port); if (c == EOF) scm_i_input_error ("skip_block_comment", port, @@ -1134,7 +1134,7 @@ scm_read_r6rs_block_comment (scm_t_wchar chr, SCM port) nested. So care must be taken. */ int nesting_level = 1; - int a = scm_getc (port); + int a = scm_getc_unlocked (port); if (a == EOF) scm_i_input_error ("scm_read_r6rs_block_comment", port, @@ -1142,7 +1142,7 @@ scm_read_r6rs_block_comment (scm_t_wchar chr, SCM port) while (nesting_level > 0) { - int b = scm_getc (port); + int b = scm_getc_unlocked (port); if (b == EOF) scm_i_input_error ("scm_read_r6rs_block_comment", port, @@ -1193,7 +1193,7 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port) buf = scm_i_string_start_writing (buf); - while ((chr = scm_getc (port)) != EOF) + while ((chr = scm_getc_unlocked (port)) != EOF) { if (saw_brace) { @@ -1220,7 +1220,7 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port) that the extended read syntax would never put a `\' before an `x'. For now, we just ignore other instances of backslash in the string. */ - switch ((chr = scm_getc (port))) + switch ((chr = scm_getc_unlocked (port))) { case EOF: goto done; @@ -1307,7 +1307,7 @@ scm_read_sharp (scm_t_wchar chr, SCM port) { SCM result; - chr = scm_getc (port); + chr = scm_getc_unlocked (port); result = scm_read_sharp_extension (chr, port); if (!scm_is_eq (result, SCM_UNSPECIFIED)) @@ -1398,7 +1398,7 @@ scm_read_expression (SCM port) { register scm_t_wchar chr; - chr = scm_getc (port); + chr = scm_getc_unlocked (port); switch (chr) { @@ -1621,7 +1621,7 @@ scm_i_scan_for_encoding (SCM port) if (SCM_FPORTP (port) && !SCM_FDES_RANDOM_P (SCM_FPORT_FDES (port))) return NULL; - bytes_read = scm_c_read (port, header, SCM_ENCODING_SEARCH_SIZE); + bytes_read = scm_c_read_unlocked (port, header, SCM_ENCODING_SEARCH_SIZE); header[bytes_read] = '\0'; scm_seek (port, scm_from_int (0), scm_from_int (SEEK_SET)); }