locking on port buffering operations

* libguile/ports.c (scm_fill_input_unlocked, scm_fill_input)
  (scm_end_input, scm_end_input_unlocked, scm_flush)
  (scm_flush_unlocked): Add locking and _unlocked variants.

* libguile/filesys.c:
* libguile/fports.c:
* libguile/gdbint.c:
* libguile/r6rs-ports.c:
* libguile/read.c:
* libguile/rw.c: Adapt callers to use _unlocked variants.

libguile/filesys.c

@@ -1027,7 +1027,7 @@ SCM_DEFINE (scm_fsync, "fsync", 1, 0, 0,
 
   if (SCM_OPFPORTP (object))
     {
-      scm_flush (object);
+      scm_flush_unlocked (object);
       fdes = SCM_FPORT_FDES (object);
     }
   else

libguile/fports.c

@@ -215,7 +215,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
     drained = scm_nullstr;
 
   if (SCM_OUTPUT_PORT_P (port))
-    scm_flush (port);
+    scm_flush_unlocked (port);
 
   if (pt->read_buf == pt->putback_buf)
     {
@@ -717,7 +717,7 @@ fport_seek (SCM port, scm_t_off offset, int whence)
       if (offset != 0 || whence != SEEK_CUR)
 	{
 	  /* could expand to avoid a second seek.  */
-	  scm_end_input (port);
+	  scm_end_input_unlocked (port);
 	  result = rv = lseek_or_lseek64 (fp->fdes, offset, whence);
 	}
       else

libguile/gdbint.c

@@ -213,7 +213,7 @@ gdb_print (SCM obj)
       {
 	scm_t_port *pt = SCM_PTAB_ENTRY (gdb_output_port);
 
-	scm_flush (gdb_output_port);
+	scm_flush_unlocked (gdb_output_port);
 	*(pt->write_buf + pt->read_buf_size) = 0;
 	SEND_STRING (pt->read_buf);
       }

libguile/ioext.c

@@ -95,7 +95,7 @@ SCM_DEFINE (scm_redirect_port, "redirect-port", 2, 0, 0,
       if (pt->rw_active == SCM_PORT_WRITE)
 	ptob->flush (new);
       else if (pt->rw_active == SCM_PORT_READ)
-	scm_end_input (new);
+	scm_end_input_unlocked (new);
       ans = dup2 (oldfd, newfd);
       if (ans == -1)
 	SCM_SYSERROR;

libguile/ports.c

@@ -1290,7 +1290,7 @@ scm_c_read_unlocked (SCM port, void *buffer, size_t size)
 
       /* Call scm_fill_input until we have all the bytes that we need,
 	 or we hit EOF. */
-      while (pt->read_buf_size && (scm_fill_input (port) != EOF))
+      while (pt->read_buf_size && (scm_fill_input_unlocked (port) != EOF))
 	{
 	  pt->read_buf_size -= (pt->read_end - pt->read_pos);
 	  pt->read_pos = pt->read_buf = pt->read_end;
@@ -1314,7 +1314,7 @@ scm_c_read_unlocked (SCM port, void *buffer, size_t size)
 	 that a custom port implementation's entry points (in
 	 particular, fill_input) can rely on the buffer always being
 	 the same as they first set up. */
-      while (size && (scm_fill_input (port) != EOF))
+      while (size && (scm_fill_input_unlocked (port) != EOF))
 	{
 	  n_available = min (size, pt->read_end - pt->read_pos);
 	  memcpy (buffer, pt->read_pos, n_available);
@@ -1959,6 +1959,8 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0,
 
 /* Manipulating the buffers.  */
 
+/* This routine does not take any locks, as it is usually called as part
+   of a port implementation.  */
 void
 scm_port_non_buffer (scm_t_port *pt)
 {
@@ -1972,7 +1974,7 @@ scm_port_non_buffer (scm_t_port *pt)
    tries to refill the read buffer.  it returns the first char from
    the port, which is either EOF or *(pt->read_pos).  */
 int
-scm_fill_input (SCM port)
+scm_fill_input_unlocked (SCM port)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
@@ -1991,6 +1993,18 @@ scm_fill_input (SCM port)
   return SCM_PORT_DESCRIPTOR (port)->fill_input (port);
 }
 
+int
+scm_fill_input (SCM port)
+{
+  int ret;
+  
+  scm_c_lock_port (port);
+  ret = scm_fill_input_unlocked (port);
+  scm_c_unlock_port (port);
+
+  return ret;
+}
+
 /* move up to read_len chars from port's putback and/or read buffers
    into memory starting at dest.  returns the number of chars moved.  */
 size_t
@@ -2066,7 +2080,7 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
 #undef FUNC_NAME
 
 void
-scm_end_input (SCM port)
+scm_end_input_unlocked (SCM port)
 {
   long offset;
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
@@ -2085,6 +2099,14 @@ scm_end_input (SCM port)
   SCM_PORT_DESCRIPTOR (port)->end_input (port, offset);
 }
 
+void
+scm_end_input (SCM port)
+{
+  scm_c_lock_port (port);
+  scm_end_input_unlocked (port);
+  scm_c_unlock_port (port);
+}
+
 SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0,
            (SCM port),
 	    "Flush the specified output port, or the current output port if @var{port}\n"
@@ -2102,17 +2124,25 @@ SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0,
       port = SCM_COERCE_OUTPORT (port);
       SCM_VALIDATE_OPOUTPORT (1, port);
     }
-  scm_flush (port);
+  scm_flush_unlocked (port);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
 void
-scm_flush (SCM port)
+scm_flush_unlocked (SCM port)
 {
   SCM_PORT_DESCRIPTOR (port)->flush (port);
 }
 
+void
+scm_flush (SCM port)
+{
+  scm_c_lock_port (port);
+  scm_flush_unlocked (port);
+  scm_c_unlock_port (port);
+}
+
 
 
 
@@ -2140,7 +2170,7 @@ scm_c_write (SCM port, const void *ptr, size_t size)
   ptob = SCM_PORT_DESCRIPTOR (port);
 
   if (pt->rw_active == SCM_PORT_READ)
-    scm_end_input (port);
+    scm_end_input_unlocked (port);
 
   ptob->write (port, ptr, size);
 
@@ -2160,7 +2190,7 @@ scm_lfwrite (const char *ptr, size_t size, SCM port)
   scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (port);
 
   if (pt->rw_active == SCM_PORT_READ)
-    scm_end_input (port);
+    scm_end_input_unlocked (port);
 
   ptob->write (port, ptr, size);
 
@@ -2178,7 +2208,7 @@ scm_lfwrite_substr (SCM str, size_t start, size_t end, SCM port)
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
   if (pt->rw_active == SCM_PORT_READ)
-    scm_end_input (port);
+    scm_end_input_unlocked (port);
 
   if (end == (size_t) -1)
     end = scm_i_string_length (str);
@@ -2378,7 +2408,7 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
       if (!ptob->truncate)
 	SCM_MISC_ERROR ("port is not truncatable", SCM_EOL);
       if (pt->rw_active == SCM_PORT_READ)
-	scm_end_input (object);
+	scm_end_input_unlocked (object);
       else if (pt->rw_active == SCM_PORT_WRITE)
 	ptob->flush (object);
       
@@ -2585,7 +2615,7 @@ static void
 flush_output_port (void *closure, SCM port)
 {
   if (SCM_OPOUTPORTP (port))
-    scm_flush (port);
+    scm_flush_unlocked (port);
 }
 
 SCM_DEFINE (scm_flush_all_ports, "flush-all-ports", 0, 0, 0,

libguile/ports.h

@@ -329,11 +329,14 @@ SCM_API SCM scm_unread_string (SCM str, SCM port);
 /* Manipulating the buffers.  */
 SCM_API void scm_port_non_buffer (scm_t_port *pt);
 SCM_API int scm_fill_input (SCM port);
+SCM_API int scm_fill_input_unlocked (SCM port);
 SCM_INTERNAL size_t scm_take_from_input_buffers (SCM port, char *dest, size_t read_len);
 SCM_API SCM scm_drain_input (SCM port);
 SCM_API void scm_end_input (SCM port);
+SCM_API void scm_end_input_unlocked (SCM port);
 SCM_API SCM scm_force_output (SCM port);
 SCM_API void scm_flush (SCM port);
+SCM_API void scm_flush_unlocked (SCM port);
 
 /* Output.  */
 SCM_INLINE void scm_putc (char c, SCM port);
@@ -419,7 +422,7 @@ scm_get_byte_or_eof_unlocked (SCM port)
 
   if (pt->read_pos >= pt->read_end)
     {
-      if (SCM_UNLIKELY (scm_fill_input (port) == EOF))
+      if (SCM_UNLIKELY (scm_fill_input_unlocked (port) == EOF))
 	return EOF;
     }
 
@@ -444,7 +447,7 @@ scm_peek_byte_or_eof_unlocked (SCM port)
 
   if (pt->read_pos >= pt->read_end)
     {
-      if (SCM_UNLIKELY (scm_fill_input (port) == EOF))
+      if (SCM_UNLIKELY (scm_fill_input_unlocked (port) == EOF))
 	return EOF;
     }
 

libguile/r6rs-ports.c

@@ -1112,7 +1112,7 @@ tp_fill_input (SCM port)
     scm_force_output (bport);
 
   if (c_bport->read_pos >= c_bport->read_end)
-    scm_fill_input (bport);
+    scm_fill_input_unlocked (bport);
   
   count = c_bport->read_end - c_bport->read_pos;
   if (count > c_port->read_buf_size)

libguile/read.c

@@ -1588,7 +1588,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;
@@ -1596,7 +1596,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;

libguile/rw.c

@@ -1,4 +1,4 @@
-/* 	Copyright (C) 2001, 2006, 2009 Free Software Foundation, Inc.
+/* 	Copyright (C) 2001, 2006, 2009, 2011 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -248,7 +248,7 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
 	  return scm_from_long (write_len);
 	}
       if (pt->write_pos > pt->write_buf)
-	scm_flush (port);
+	scm_flush_unlocked (port);
       fdes = SCM_FPORT_FDES (port);
     }
   {

libguile/strports.c

@@ -207,7 +207,7 @@ st_seek (SCM port, scm_t_off offset, int whence)
 	st_flush (port);
   
       if (pt->rw_active == SCM_PORT_READ)
-	scm_end_input (port);
+	scm_end_input_unlocked (port);
 
       switch (whence)
 	{