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.

diff --git a/libguile/arrays.c b/libguile/arrays.c
index de221a9..05ddf87 100644 (file)
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -862,7 +862,7 @@ scm_i_read_array (SCM port, int c)
   */
   if (c == '(')
     {
-      scm_ungetc (c, port);
+      scm_ungetc_unlocked (c, 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 != EOF)
-           scm_ungetc (c, port);
+           scm_ungetc_unlocked (c, port);
          return SCM_BOOL_F;
        }
       rank = 1;
@@ -954,7 +954,7 @@ scm_i_read_array (SCM port, int c)
     scm_i_input_error (NULL, port,
                       "missing '(' in vector or array literal",
                       SCM_EOL);
-  scm_ungetc (c, port);
+  scm_ungetc_unlocked (c, port);
   elements = scm_read (port);
 
   if (scm_is_false (shape))

diff --git a/libguile/ports.c b/libguile/ports.c
index 6c763c1..20cd989 100644 (file)
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -1703,7 +1703,7 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0,
 /* Pushback.  */
 
 void 
-scm_unget_byte (int c, SCM port)
+scm_unget_byte_unlocked (int c, SCM port)
 #define FUNC_NAME "scm_unget_byte"
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
@@ -1766,8 +1766,16 @@ scm_unget_byte (int c, SCM port)
 }
 #undef FUNC_NAME
 
+void 
+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 (scm_t_wchar c, SCM port)
+scm_ungetc_unlocked (scm_t_wchar c, SCM port)
 #define FUNC_NAME "scm_ungetc"
 {
   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));
 
   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))
     free (result);
@@ -1811,9 +1819,16 @@ scm_ungetc (scm_t_wchar c, SCM port)
 }
 #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 
-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
    * 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!
    */
   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 port),
@@ -1866,7 +1888,7 @@ SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0,
   err = get_codepoint (port, &c, bytes, &len);
 
   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_LINUM (port) = line;
@@ -1904,7 +1926,7 @@ SCM_DEFINE (scm_unread_char, "unread-char", 1, 1, 0,
 
   c = SCM_CHAR (cobj);
 
-  scm_ungetc (c, port);
+  scm_ungetc_unlocked (c, port);
   return cobj;
 }
 #undef FUNC_NAME
@@ -1926,7 +1948,7 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0,
   n = scm_i_string_length (str);
 
   while (n--)
-    scm_ungetc (scm_i_string_ref (str, n), port);
+    scm_ungetc_unlocked (scm_i_string_ref (str, n), port);
   
   return str;
 }

diff --git a/libguile/ports.h b/libguile/ports.h
index 1abf30f..be6ea29 100644 (file)
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -306,8 +306,8 @@ SCM_API SCM scm_adjust_port_revealed_x (SCM port, SCM addend);
 
 /* Input.  */
 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_API int scm_peek_byte_or_eof (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);
@@ -317,8 +317,11 @@ 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_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_unlocked (const char *s, int n, 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_string (SCM str, SCM port);

diff --git a/libguile/rdelim.c b/libguile/rdelim.c
index 97b545f..c8c7d8b 100644 (file)
--- a/libguile/rdelim.c
+++ b/libguile/rdelim.c
@@ -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_is_false (gobble))
-               scm_ungetc (c, port);
+               scm_ungetc_unlocked (c, port);
 
              return scm_cons (SCM_MAKE_CHAR (c),
                               scm_from_size_t (j - cstart));

diff --git a/libguile/read.c b/libguile/read.c
index 09dbeb6..aef5804 100644 (file)
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -222,7 +222,7 @@ read_token (SCM port, char *buf, const size_t buf_size, size_t *read)
         return 0;
       else if (CHAR_IS_DELIMITER (chr))
         {
-          scm_unget_byte (chr, port);
+          scm_unget_byte_unlocked (chr, port);
           return 0;
         }
       else
@@ -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;
@@ -375,7 +375,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
@@ -402,7 +402,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.  */
@@ -478,7 +478,7 @@ skip_intraline_whitespace (SCM port)
     }
   while (c == '\t' || uc_is_general_category (c, UC_SPACE_SEPARATOR));
 
-  scm_ungetc (c, port);
+  scm_ungetc_unlocked (c, port);
 }                                         
 
 static SCM
@@ -596,7 +596,7 @@ scm_read_number (scm_t_wchar chr, SCM port)
   int overflow;
   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_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 str;
 
-  scm_ungetc (chr, port);
+  scm_ungetc_unlocked (chr, port);
   overflow = read_complete_token (port, buffer, READER_BUFFER_SIZE,
                                   &overflow_buffer, &bytes_read);
   if (bytes_read > 0)
@@ -710,8 +710,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;
     }
 
@@ -767,7 +767,7 @@ scm_read_quote (int chr, SCM port)
          p = scm_sym_uq_splicing;
        else
          {
-           scm_ungetc (c, port);
+           scm_ungetc_unlocked (c, port);
            p = scm_sym_unquote;
          }
        break;
@@ -817,7 +817,7 @@ scm_read_syntax (int chr, SCM port)
          p = sym_unsyntax_splicing;
        else
          {
-           scm_ungetc (c, port);
+           scm_ungetc_unlocked (c, port);
            p = sym_unsyntax;
          }
        break;
@@ -1064,7 +1064,7 @@ scm_read_guile_bit_vector (scm_t_wchar chr, SCM port)
     }
 
   if (chr != EOF)
-    scm_ungetc (chr, port);
+    scm_ungetc_unlocked (chr, port);
 
   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;
   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_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_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_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);
     }
   
@@ -1174,7 +1174,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;
 }
@@ -1476,7 +1476,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));
 }

diff --git a/libguile/vports.c b/libguile/vports.c
index 05d4590..62f552a 100644 (file)
--- a/libguile/vports.c
+++ b/libguile/vports.c
@@ -114,7 +114,7 @@ sf_fill_input (SCM port)
       return *pt->read_buf;
     }
   else
-    scm_ungetc (SCM_CHAR (ans), port);
+    scm_ungetc_unlocked (SCM_CHAR (ans), port);
   return SCM_CHAR (ans);
 }