--- orig/doc/ref/posix.texi
+++ mod/doc/ref/posix.texi
@@ -472,6 +472,21 @@
 @end defvar
 @end deffn
 
+@deffn {Scheme Procedure} setvbuf-input port size
+@deffnx {C Function} scm_setvbuf_input (port, size)
+Use a @var{size}-byte input buffer for @var{port}, which must be a
+file or socket port.  Note that buffered data is lost if the input
+buffer contains more than @var{size} bytes.  Thus, it may be necessary
+to call @code{drain-input} prior to @code{setvbuf-input}.
+@end deffn
+
+@deffn {Scheme Procedure} setvbuf-output port size
+@deffnx {C Function} scm_setvbuf_output (port, size)
+Use a @var{size}-byte output buffer for @var{port}, which must be a
+file or socket port.  The current output buffer may be flushed as a
+result of this operation.
+@end deffn
+
 @deffn {Scheme Procedure} fcntl port/fd cmd [value]
 @deffnx {C Function} scm_fcntl (object, cmd, value)
 Apply @var{cmd} on @var{port/fd}, either a port or file descriptor.


--- orig/libguile/fports.c
+++ mod/libguile/fports.c
@@ -86,14 +86,20 @@
 
 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)
+scm_fport_buffer_add (SCM port, long read_size, long write_size)
 #define FUNC_NAME "scm_fport_buffer_add"
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
@@ -118,7 +124,7 @@
 
   if (SCM_INPUT_PORT_P (port) && read_size > 0)
     {
-      pt->read_buf = scm_gc_malloc (read_size, "port buffer");
+      pt->read_buf = scm_gc_malloc (read_size, gc_port_buffer_hint);
       pt->read_pos = pt->read_end = pt->read_buf;
       pt->read_buf_size = read_size;
     }
@@ -130,7 +136,7 @@
 
   if (SCM_OUTPUT_PORT_P (port) && write_size > 0)
     {
-      pt->write_buf = scm_gc_malloc (write_size, "port buffer");
+      pt->write_buf = scm_gc_malloc (write_size, gc_port_buffer_hint);
       pt->write_pos = pt->write_buf;
       pt->write_buf_size = write_size;
     }
@@ -208,15 +214,140 @@
       pt->read_buf_size = pt->saved_read_buf_size;
     }
   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 (pt->write_buf, pt->write_buf_size, gc_port_buffer_hint);
 
   scm_fport_buffer_add (port, csize, csize);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_setvbuf_input, "setvbuf-input", 2, 0, 0,
+	    (SCM port, SCM size),
+	    "Use a @var{size}-byte input buffer for @var{port}, which "
+	    "must be a file or socket port.  Note that buffered data "
+	    "is lost if the input buffer contains more than @var{size} "
+	    "bytes.  Thus, it may be necessary to call "
+	    "@code{drain-input} prior to @code{setvbuf-input}.")
+#define FUNC_NAME s_scm_setvbuf_input
+{
+  scm_t_port *pt;
+  size_t c_size;
+
+  SCM_VALIDATE_FPORT (1, port);
+  c_size = scm_to_size_t (size);
+
+  pt = SCM_PTAB_ENTRY (port);
+
+  if (pt->read_buf_size != c_size)
+    {
+      size_t c_offset, c_end;
+      unsigned char *new_buf;
+
+      c_end = pt->read_end - pt->read_buf;
+      c_offset = pt->read_pos - pt->read_buf;
+
+      if (c_offset > c_size)
+	/* Discard all the buffered input.  */
+	c_offset = c_end = 0;
+
+      if (c_size == 0)
+	{
+	  new_buf = &pt->shortbuf, c_size = 1;
+	  if (pt->read_buf != &pt->shortbuf)
+	    scm_gc_free (pt->read_buf, pt->read_buf_size,
+			 gc_port_buffer_hint);
+	}
+      else
+	{
+	  if (pt->read_buf != &pt->shortbuf)
+	    new_buf = scm_gc_realloc (pt->read_buf,
+				      pt->read_buf_size, c_size,
+				      gc_port_buffer_hint);
+	  else
+	    new_buf = scm_gc_malloc (c_size, gc_port_buffer_hint);
+	}
+
+      pt->read_buf = new_buf;
+      pt->read_end = new_buf + c_end;
+      pt->read_pos = new_buf + c_offset;
+      pt->read_buf_size = c_size;
+
+      if ((pt->read_buf_size == 0) && (pt->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, 0, 0,
+	    (SCM port, SCM size),
+	    "Use a @var{size}-byte output buffer for @var{port}, which "
+	    "must be a file or socket port.  The current output buffer "
+	    "may be flushed as a result of this operation.")
+#define FUNC_NAME s_scm_setvbuf_output
+{
+  scm_t_port *pt;
+  size_t c_size;
+
+  SCM_VALIDATE_FPORT (1, port);
+  c_size = scm_to_size_t (size);
+
+  pt = SCM_PTAB_ENTRY (port);
+
+  if (pt->write_buf_size != c_size)
+    {
+      size_t c_offset, c_end;
+      unsigned char *new_buf;
+
+    do_it:
+      c_end = pt->write_end - pt->write_buf;
+      c_offset = pt->write_pos - pt->write_buf;
+
+      if (c_offset > c_size)
+	{
+	  /* Flush the output buffer so that it can be shrunk.  */
+	  fport_flush (port);
+	  goto do_it;
+	}
+
+      if (c_size == 0)
+	{
+	  new_buf = &pt->shortbuf, c_size = 1;
+	  if (pt->write_buf != &pt->shortbuf)
+	    scm_gc_free (pt->write_buf, pt->write_buf_size,
+			 gc_port_buffer_hint);
+	}
+      else
+	{
+	  if (pt->write_buf != &pt->shortbuf)
+	    new_buf = scm_gc_realloc (pt->write_buf,
+				      pt->write_buf_size, c_size,
+				      gc_port_buffer_hint);
+	  else
+	    new_buf = scm_gc_malloc (c_size, gc_port_buffer_hint);
+	}
+
+      pt->write_buf = new_buf;
+      pt->write_end = new_buf + c_end;
+      pt->write_pos = new_buf + c_offset;
+      pt->write_buf_size = c_size;
+
+      if ((pt->read_buf_size == 0) && (pt->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
+
+
 /* Move ports with the specified file descriptor to new descriptors,
  * resetting the revealed count to 0.
  */
@@ -459,7 +590,8 @@
   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);
@@ -583,8 +715,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 +1022,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 size);
+SCM_API SCM scm_setvbuf_output (SCM port, 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);