Re: Unbuffered socket I/O

[Ludovic Courtès]

Hi,

Here is an updated patch that adds `setvbuf-input' and `setvbuf-output'.

As suggested by Kevin, `setvbuf-{input,output}' now take a MODE
argument.  Unlike previous versions of the patch,
`setvbuf-{input,output}' simply discard the input/output buffer.  In
addition, `setvbuf' and `fport_buffer_add ()' are now implemented in
terms of the two other.

I'd be grateful if someone (Kevin?) could review this.

Thanks in advance,
Ludovic.

--- orig/libguile/fports.c
+++ mod/libguile/fports.c
@@ -86,71 +86,78 @@
 
 scm_t_bits scm_tc16_fport;
 
+static void fport_flush (SCM port);
+
+/* Hints passed to the GC allocation functions for port buffers and file
+   ports.  */
+static const char gc_port_buffer_hint[] = "port buffer";
+static const char gc_file_port_hint[]   = "file port";
 
 /* default buffer size, used if the O/S won't supply a value.  */
 static const size_t default_buffer_size = 1024;
 
-/* create FPORT buffer with specified sizes (or -1 to use default size or
-   0 for no buffer.  */
+/* Create FPORT buffer with specified sizes (or -1 to use default size or
+   0 for no buffer).  */
 static void
-scm_fport_buffer_add (SCM port, long read_size, int write_size)
+fport_buffer_add (SCM port, long c_buffer_size)
 #define FUNC_NAME "scm_fport_buffer_add"
 {
+  SCM buffer_size, mode;
+  int c_mode = _IOFBF;
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
-  if (read_size == -1 || write_size == -1)
+  if (c_buffer_size == -1)
     {
-      size_t default_size;
 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
       struct stat st;
       scm_t_fport *fp = SCM_FSTREAM (port);
-      
-      default_size = (fstat (fp->fdes, &st) == -1) ? default_buffer_size
+
+      c_buffer_size = (fstat (fp->fdes, &st) == -1) ? default_buffer_size
        : st.st_blksize;
 #else
-      default_size = default_buffer_size;
+      c_buffer_size = default_buffer_size;
 #endif
-      if (read_size == -1)
-       read_size = default_size;
-      if (write_size == -1)
-       write_size = default_size;
     }
 
-  if (SCM_INPUT_PORT_P (port) && read_size > 0)
-    {
-      pt->read_buf = scm_gc_malloc (read_size, "port buffer");
-      pt->read_pos = pt->read_end = pt->read_buf;
-      pt->read_buf_size = read_size;
-    }
+  buffer_size = scm_from_long (c_buffer_size);
+  c_mode = (SCM_CELL_WORD_0 (port) & SCM_BUFLINE) ? _IOLBF : _IOFBF;
+  mode = scm_from_int (c_mode);
+
+  if (SCM_INPUT_PORT_P (port) && (buffer_size > 0))
+    scm_setvbuf_input (port, mode, buffer_size);
   else
     {
       pt->read_pos = pt->read_buf = pt->read_end = &pt->shortbuf;
       pt->read_buf_size = 1;
     }
 
-  if (SCM_OUTPUT_PORT_P (port) && write_size > 0)
-    {
-      pt->write_buf = scm_gc_malloc (write_size, "port buffer");
-      pt->write_pos = pt->write_buf;
-      pt->write_buf_size = write_size;
-    }
+  if (SCM_OUTPUT_PORT_P (port) && (buffer_size > 0))
+    scm_setvbuf_output (port, mode, buffer_size);
   else
     {
       pt->write_buf = pt->write_pos = &pt->shortbuf;
       pt->write_buf_size = 1;
     }
-
-  pt->write_end = pt->write_buf + pt->write_buf_size;
-  if (read_size > 0 || write_size > 0)
-    SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~SCM_BUF0);
-  else
-    SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUF0);
 }
 #undef FUNC_NAME
 
+/* Convert MODE to a C buffering mode.  */
+static inline int
+scm_to_buffer_mode (SCM mode, const char *func_name)
+{
+  int c_mode;
+
+  c_mode = scm_to_int (mode);
+  if (c_mode != _IONBF && c_mode != _IOFBF && c_mode != _IOLBF)
+    scm_out_of_range (func_name, mode);
+
+  return c_mode;
+}
+
 SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, 
             (SCM port, SCM mode, SCM size),
-           "Set the buffering mode for @var{port}.  @var{mode} can be:\n"
+           "Set the input and output buffering mode for @var{port}.  "
+           "@var{mode} can be:\n"
            "@table @code\n"
            "@item _IONBF\n"
            "non-buffered\n"
@@ -162,61 +169,163 @@
            "@end table")
 #define FUNC_NAME s_scm_setvbuf
 {
-  int cmode;
-  long csize;
-  scm_t_port *pt;
-
   port = SCM_COERCE_OUTPORT (port);
 
-  SCM_VALIDATE_OPFPORT (1,port);
-  cmode = scm_to_int (mode);
-  if (cmode != _IONBF && cmode != _IOFBF && cmode != _IOLBF)
-    scm_out_of_range (FUNC_NAME, mode);
+  SCM_VALIDATE_OPFPORT (1, port);
+
+  if (SCM_INPUT_PORT_P (port))
+    scm_setvbuf_input (port, mode, size);
+
+  if (SCM_OUTPUT_PORT_P (port))
+    scm_setvbuf_output (port, mode, size);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_setvbuf_input, "setvbuf-input", 2, 1, 0,
+           (SCM port, SCM mode, SCM size),
+           "Set the input buffering mode for @var{port}, with the "
+           "@var{mode} and @var{size} arguments akin to those of "
+           "@code{setvbuf}.")
+#define FUNC_NAME s_scm_setvbuf_input
+{
+  scm_t_port *c_port;
+  int c_mode;
+  size_t c_size;
+  unsigned char *new_buf;
 
-  if (cmode == _IOLBF)
+  SCM_VALIDATE_FPORT (1, port);
+  SCM_VALIDATE_OPINPORT (1, port);
+
+  c_port = SCM_PTAB_ENTRY (port);
+  c_mode = scm_to_buffer_mode (mode, FUNC_NAME);
+  if (SCM_UNBNDP (size))
     {
-      SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUFLINE);
-      cmode = _IOFBF;
+      if (c_mode == _IOFBF)
+       c_size = -1;
+      else
+       c_size = 0;
+    }
+  else
+    {
+      c_size = scm_to_int (size);
+      if (c_size < 0 || (c_mode == _IONBF && c_size > 0))
+       scm_out_of_range (FUNC_NAME, size);
+    }
+
+  if (c_port->read_buf == c_port->putback_buf)
+    {
+      /* Silently discard buffered and put-back chars.  */
+      c_port->read_buf = c_port->saved_read_buf;
+      c_port->read_pos = c_port->saved_read_pos;
+      c_port->read_end = c_port->saved_read_end;
+      c_port->read_buf_size = c_port->saved_read_buf_size;
+    }
+
+  if (c_size == 0)
+    {
+      new_buf = &c_port->shortbuf, c_size = 1;
+      if (c_port->read_buf != &c_port->shortbuf)
+       scm_gc_free (c_port->read_buf, c_port->read_buf_size,
+                    gc_port_buffer_hint);
     }
   else
     {
-      SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & 
~(scm_t_bits)SCM_BUFLINE);
+      if (c_port->read_buf != &c_port->shortbuf)
+       new_buf = scm_gc_realloc (c_port->read_buf,
+                                 c_port->read_buf_size, c_size,
+                                 gc_port_buffer_hint);
+      else
+       new_buf = scm_gc_malloc (c_size, gc_port_buffer_hint);
     }
 
+  c_port->read_buf = new_buf;
+  c_port->read_end = new_buf;
+  c_port->read_pos = new_buf;
+  c_port->read_buf_size = c_size;
+
+  if ((c_port->read_buf_size == 0) && (c_port->write_buf_size == 0))
+    SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUF0);
+  else
+    SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~SCM_BUF0);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_setvbuf_output, "setvbuf-output", 2, 1, 0,
+           (SCM port, SCM mode, SCM size),
+           "Set the output buffering mode for @var{port}, with the "
+           "@var{mode} and @var{size} arguments akin to those of "
+           "@code{setvbuf}.")
+#define FUNC_NAME s_scm_setvbuf_output
+{
+  scm_t_port *c_port;
+  int c_mode;
+  size_t c_size;
+  unsigned char *new_buf;
+
+  SCM_VALIDATE_FPORT (1, port);
+
+  c_port = SCM_PTAB_ENTRY (port);
+  c_mode = scm_to_buffer_mode (mode, FUNC_NAME);
   if (SCM_UNBNDP (size))
     {
-      if (cmode == _IOFBF)
-       csize = -1;
+      if (c_mode == _IOFBF)
+       c_size = -1;
       else
-       csize = 0;
+       c_size = 0;
     }
   else
     {
-      csize = scm_to_int (size);
-      if (csize < 0 || (cmode == _IONBF && csize > 0))
+      c_size = scm_to_int (size);
+      if (c_size < 0 || (c_mode == _IONBF && c_size > 0))
        scm_out_of_range (FUNC_NAME, size);
     }
 
-  pt = SCM_PTAB_ENTRY (port);
+  /* Note: line buffering is only supported by `fport_write ()'.  */
+  if (c_mode == _IOLBF)
+    {
+      SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUFLINE);
+      c_mode = _IOFBF;
+    }
+  else
+    SCM_SET_CELL_WORD_0 (port,
+                        SCM_CELL_WORD_0 (port) & ~(scm_t_bits) SCM_BUFLINE);
 
-  /* silently discards buffered and put-back chars.  */
-  if (pt->read_buf == pt->putback_buf)
+  if (c_size == 0)
     {
-      pt->read_buf = pt->saved_read_buf;
-      pt->read_pos = pt->saved_read_pos;
-      pt->read_end = pt->saved_read_end;
-      pt->read_buf_size = pt->saved_read_buf_size;
+      new_buf = &c_port->shortbuf, c_size = 1;
+      if (c_port->write_buf != &c_port->shortbuf)
+       scm_gc_free (c_port->write_buf, c_port->write_buf_size,
+                    gc_port_buffer_hint);
     }
-  if (pt->read_buf != &pt->shortbuf)
-    scm_gc_free (pt->read_buf, pt->read_buf_size, "port buffer");
-  if (pt->write_buf != &pt->shortbuf)
-    scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer");
+  else
+    {
+      if (c_port->write_buf != &c_port->shortbuf)
+       new_buf = scm_gc_realloc (c_port->write_buf,
+                                 c_port->write_buf_size, c_size,
+                                 gc_port_buffer_hint);
+      else
+       new_buf = scm_gc_malloc (c_size, gc_port_buffer_hint);
+    }
+
+  c_port->write_buf = new_buf;
+  c_port->write_end = new_buf + c_size;
+  c_port->write_pos = new_buf;
+  c_port->write_buf_size = c_size;
+
+  if ((c_port->read_buf_size == 0) && (c_port->write_buf_size == 0))
+    SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUF0);
+  else
+    SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~SCM_BUF0);
 
-  scm_fport_buffer_add (port, csize, csize);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
+
 /* Move ports with the specified file descriptor to new descriptors,
  * resetting the revealed count to 0.
  */
@@ -459,15 +568,16 @@
   pt = SCM_PTAB_ENTRY(port);
   {
     scm_t_fport *fp
-      = (scm_t_fport *) scm_gc_malloc (sizeof (scm_t_fport), "file port");
+      = (scm_t_fport *) scm_gc_malloc (sizeof (scm_t_fport),
+                                      gc_file_port_hint);
 
     fp->fdes = fdes;
     pt->rw_random = SCM_FDES_RANDOM_P (fdes);
     SCM_SETSTREAM (port, fp);
     if (mode_bits & SCM_BUF0)
-      scm_fport_buffer_add (port, 0, 0);
+      fport_buffer_add (port, 0);
     else
-      scm_fport_buffer_add (port, -1, -1);
+      fport_buffer_add (port, -1);
   }
   SCM_SET_FILENAME (port, name);
   scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
@@ -583,8 +693,6 @@
 }
 #endif /* !__MINGW32__ */
 
-static void fport_flush (SCM port);
-
 /* fill a port's read-buffer with a single read.  returns the first
    char or EOF if end of file.  */
 static int
@@ -892,10 +1000,10 @@
   if (pt->read_buf == pt->putback_buf)
     pt->read_buf = pt->saved_read_buf;
   if (pt->read_buf != &pt->shortbuf)
-    scm_gc_free (pt->read_buf, pt->read_buf_size, "port buffer");
+    scm_gc_free (pt->read_buf, pt->read_buf_size, gc_port_buffer_hint);
   if (pt->write_buf != &pt->shortbuf)
-    scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer");
-  scm_gc_free (fp, sizeof (*fp), "file port");
+    scm_gc_free (pt->write_buf, pt->write_buf_size, gc_port_buffer_hint);
+  scm_gc_free (fp, sizeof (*fp), gc_file_port_hint);
   return rv;
 }
 
--- orig/libguile/fports.h
+++ mod/libguile/fports.h
@@ -49,6 +49,8 @@
 
 SCM_API SCM scm_setbuf0 (SCM port);
 SCM_API SCM scm_setvbuf (SCM port, SCM mode, SCM size);
+SCM_API SCM scm_setvbuf_input (SCM port, SCM mode, SCM size);
+SCM_API SCM scm_setvbuf_output (SCM port, SCM mode, SCM size);
 SCM_API void scm_evict_ports (int fd);
 SCM_API SCM scm_open_file (SCM filename, SCM modes);
 SCM_API SCM scm_fdes_to_port (int fdes, char *mode, SCM name);