diff options
Diffstat (limited to 'libguile/read.c')
-rw-r--r-- | libguile/read.c | 133 |
1 files changed, 57 insertions, 76 deletions
diff --git a/libguile/read.c b/libguile/read.c index 87d73bfbe..5738e2ed8 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -216,13 +216,13 @@ read_token (SCM port, char *buf, size_t buf_size, size_t *read) { int chr; - chr = scm_get_byte_or_eof (port); + chr = scm_get_byte_or_eof_unlocked (port); if (chr == EOF) return 0; else if (CHAR_IS_DELIMITER (chr)) { - scm_unget_byte (chr, port); + scm_unget_byte_unlocked (chr, port); return 0; } else @@ -288,7 +288,7 @@ flush_ws (SCM port, const char *eoferr) { 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"; @@ -334,7 +334,7 @@ flush_ws (SCM port, const char *eoferr) } /* fall through */ default: - scm_ungetc (c, port); + scm_ungetc_unlocked (c, port); return '#'; } break; @@ -383,7 +383,7 @@ scm_read_sexp (scm_t_wchar chr, SCM port) if (terminating_char == c) return SCM_EOL; - scm_ungetc (c, port); + scm_ungetc_unlocked (c, port); tmp = scm_read_expression (port); /* Note that it is possible for scm_read_expression to return @@ -410,7 +410,7 @@ scm_read_sexp (scm_t_wchar chr, SCM port) "in pair: mismatched close paren: ~A", scm_list_1 (SCM_MAKE_CHAR (c))); - scm_ungetc (c, port); + scm_ungetc_unlocked (c, port); tmp = scm_read_expression (port); /* See above note about scm_sym_dot. */ @@ -447,7 +447,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 \ @@ -477,13 +477,13 @@ skip_intraline_whitespace (SCM port) do { - c = scm_getc (port); + c = scm_getc_unlocked (port); if (c == EOF) return; } while (c == '\t' || uc_is_general_category (c, UC_SPACE_SEPARATOR)); - scm_ungetc (c, port); + scm_ungetc_unlocked (c, port); } static SCM @@ -501,7 +501,7 @@ scm_read_string (int chr, SCM port) long line = SCM_LINUM (port); int column = SCM_COL (port) - 1; - while ('"' != (c = scm_getc (port))) + while ('"' != (c = scm_getc_unlocked (port))) { if (c == EOF) { @@ -518,7 +518,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; @@ -610,7 +610,7 @@ scm_read_number (scm_t_wchar chr, SCM port) long line = SCM_LINUM (port); int column = SCM_COL (port) - 1; - scm_ungetc (chr, port); + scm_ungetc_unlocked (chr, port); buffer = read_complete_token (port, local_buffer, sizeof local_buffer, &bytes_read); @@ -642,7 +642,7 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port) scm_t_port *pt = SCM_PTAB_ENTRY (port); SCM str; - scm_ungetc (chr, port); + scm_ungetc_unlocked (chr, port); buffer = read_complete_token (port, local_buffer, sizeof local_buffer, &bytes_read); if (bytes_read > 0) @@ -705,8 +705,8 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port) break; default: - scm_ungetc (chr, port); - scm_ungetc ('#', port); + scm_ungetc_unlocked (chr, port); + scm_ungetc_unlocked ('#', port); radix = 10; } @@ -750,12 +750,12 @@ 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 { - scm_ungetc (c, port); + scm_ungetc_unlocked (c, port); p = scm_sym_unquote; } break; @@ -797,12 +797,12 @@ 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 { - scm_ungetc (c, port); + scm_ungetc_unlocked (c, port); p = sym_unsyntax; } break; @@ -839,9 +839,9 @@ scm_read_semicolon_comment (int chr, SCM port) /* We use the get_byte here because there is no need to get the locale correct with comment input. This presumes that newline always represents itself no matter what the encoding is. */ - for (c = scm_get_byte_or_eof (port); + for (c = scm_get_byte_or_eof_unlocked (port); (c != EOF) && (c != '\n'); - c = scm_get_byte_or_eof (port)); + c = scm_get_byte_or_eof_unlocked (port)); return SCM_UNSPECIFIED; } @@ -883,7 +883,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); @@ -1021,15 +1021,15 @@ scm_read_srfi4_vector (int chr, SCM port, long line, int column) static SCM scm_read_bytevector (scm_t_wchar chr, SCM port, long line, int column) { - 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; @@ -1051,15 +1051,15 @@ scm_read_guile_bit_vector (scm_t_wchar chr, SCM port, long line, int column) 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); } if (chr != EOF) - scm_ungetc (chr, port); + scm_ungetc_unlocked (chr, port); return maybe_annotate_source (scm_bitvector (scm_reverse_x (s_bits, SCM_EOL)), @@ -1073,7 +1073,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, @@ -1094,30 +1094,30 @@ static SCM scm_read_shebang (scm_t_wchar chr, SCM port) { int c = 0; - if ((c = scm_get_byte_or_eof (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); } - if ((c = scm_get_byte_or_eof (port)) != '6') + if ((c = scm_get_byte_or_eof_unlocked (port)) != '6') { - scm_ungetc (c, port); - scm_ungetc ('r', port); + scm_ungetc_unlocked (c, port); + scm_ungetc_unlocked ('r', port); return scm_read_scsh_block_comment (chr, port); } - if ((c = scm_get_byte_or_eof (port)) != 'r') + if ((c = scm_get_byte_or_eof_unlocked (port)) != 'r') { - scm_ungetc (c, port); - scm_ungetc ('6', port); - scm_ungetc ('r', port); + scm_ungetc_unlocked (c, port); + scm_ungetc_unlocked ('6', port); + scm_ungetc_unlocked ('r', port); return scm_read_scsh_block_comment (chr, port); } - if ((c = scm_get_byte_or_eof (port)) != 's') + if ((c = scm_get_byte_or_eof_unlocked (port)) != 's') { - scm_ungetc (c, port); - scm_ungetc ('r', port); - scm_ungetc ('6', port); - scm_ungetc ('r', port); + scm_ungetc_unlocked (c, port); + scm_ungetc_unlocked ('r', port); + scm_ungetc_unlocked ('6', port); + scm_ungetc_unlocked ('r', port); return scm_read_scsh_block_comment (chr, port); } @@ -1131,7 +1131,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, @@ -1139,7 +1139,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, @@ -1171,7 +1171,7 @@ scm_read_commented_expression (scm_t_wchar chr, SCM port) if (EOF == c) scm_i_input_error ("read_commented_expression", port, "no expression after #; comment", SCM_EOL); - scm_ungetc (c, port); + scm_ungetc_unlocked (c, port); scm_read_expression (port); return SCM_UNSPECIFIED; } @@ -1190,7 +1190,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) { @@ -1217,7 +1217,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; @@ -1304,7 +1304,7 @@ scm_read_sharp (scm_t_wchar chr, SCM port, long line, int column) { 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)) @@ -1335,29 +1335,10 @@ scm_read_sharp (scm_t_wchar chr, SCM port, long line, int column) case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '@': -#if SCM_ENABLE_DEPRECATED - /* See below for 'i' and 'e'. */ - case 'a': - case 'y': - case 'h': - case 'l': -#endif - return (scm_read_array (chr, port, line, column)); + return (scm_read_array (chr, port, line, column)); case 'i': case 'e': -#if SCM_ENABLE_DEPRECATED - { - /* When next char is '(', it really is an old-style - uniform array. */ - scm_t_wchar next_c = scm_getc (port); - if (next_c != EOF) - scm_ungetc (next_c, port); - if (next_c == '(') - return scm_read_array (chr, port, line, column); - /* Fall through. */ - } -#endif case 'b': case 'B': case 'o': @@ -1413,7 +1394,7 @@ scm_read_expression (SCM port) { scm_t_wchar chr; - chr = scm_getc (port); + chr = scm_getc_unlocked (port); switch (chr) { @@ -1492,7 +1473,7 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0, c = flush_ws (port, (char *) NULL); if (EOF == c) return SCM_EOF_VAL; - scm_ungetc (c, port); + scm_ungetc_unlocked (c, port); return (scm_read_expression (port)); } @@ -1604,7 +1585,7 @@ scm_i_scan_for_encoding (SCM port) pt = SCM_PTAB_ENTRY (port); if (pt->rw_active == SCM_PORT_WRITE) - scm_flush (port); + scm_flush_unlocked (port); if (pt->rw_random) pt->rw_active = SCM_PORT_READ; @@ -1612,7 +1593,7 @@ scm_i_scan_for_encoding (SCM port) if (pt->read_pos == pt->read_end) { /* We can use the read buffer, and thus avoid a seek. */ - if (scm_fill_input (port) == EOF) + if (scm_fill_input_unlocked (port) == EOF) return NULL; bytes_read = pt->read_end - pt->read_pos; @@ -1637,7 +1618,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)); } |