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

[bpt/guile.git] / libguile / read.c

diff --git a/libguile/read.c b/libguile/read.c
index 87d73bf..5738e2e 100644 (file)
--- 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));
     }