Re: Making custom binary input ports unbuffered

[Ludovic Courtès]

Mark H Weaver <address@hidden> skribis:

> While I agree that CBIPs should be unbuffered by default, I think it's
> important to have a way to enable buffering, even if it's not portable.

So I started with the patch below, which allows us to specify which
ports (really: which port types) support ‘setvbuf’.  This is
conservative so that ports that do not explicitly claim to support it
won’t break.

Then I started modifying the CBIP.  The problem is that the CBIP has a
bytevector stored in its SCM_STREAM, whose contents are normally stored
in ‘read_buf’.  So it needs to know if a new buffer is installed.

Perhaps that, rather than a ‘supports_setvbuf’ bit, we need a pointer to
the port’s ‘setvbuf’ method?  For file ports it would be
‘scm_fport_buffer_add’, for instance.

Thoughts?

Ludo’.

>From 0b9ddbe6085aff2224203a8f125417ccadc2463b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <address@hidden>
Date: Wed, 15 Jan 2014 17:38:44 +0100
Subject: [PATCH] Prepare 'setvbuf' to support for non-file ports.

* libguile/ports-internal.h (struct scm_port_internal): Add
  'supports_setvbuf' field.  Change 'pending_eof' to a 1-bit unsigned
  char.
* libguile/ports.c (scm_new_port_table_entry): Clear
  'pti->supports_setvbuf'.
* libguile/fports.c (scm_setvbuf): Accept any open port, and error out
  when PORT's 'supports_setvbuf' field is cleared.  Remove explicit
  'scm_gc_free' calls.
  (scm_i_fdes_to_port): Set PORT's 'supports_setvbuf' flag.
* test-suite/tests/ports.test ("setvbuf")["closed port", "string port"]:
  New tests.
---
 libguile/fports.c           | 24 +++++++++++++++---------
 libguile/ports-internal.h   | 11 +++++++++--
 libguile/ports.c            |  8 +++++++-
 test-suite/tests/ports.test | 14 +++++++++++++-
 4 files changed, 44 insertions(+), 13 deletions(-)

diff --git a/libguile/fports.c b/libguile/fports.c
index 70732e5..0246512 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -58,6 +58,7 @@
 #include "libguile/hashtab.h"
 
 #include "libguile/fports.h"
+#include "libguile/ports-internal.h"
 
 #if SIZEOF_OFF_T == SIZEOF_INT
 #define OFF_T_MAX  INT_MAX
@@ -158,7 +159,11 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
 
   port = SCM_COERCE_OUTPORT (port);
 
-  SCM_VALIDATE_OPFPORT (1,port);
+  SCM_VALIDATE_OPENPORT (1, port);
+  if (!SCM_PORT_GET_INTERNAL (port)->supports_setvbuf)
+    scm_wrong_type_arg_msg (FUNC_NAME, 1, port,
+                           "port that supports 'setvbuf'");
+
   cmode = scm_to_int (mode);
   if (cmode != _IONBF && cmode != _IOFBF && cmode != _IOLBF)
     scm_out_of_range (FUNC_NAME, mode);
@@ -169,9 +174,8 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
       cmode = _IOFBF;
     }
   else
-    {
-      SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & 
~(scm_t_bits)SCM_BUFLINE);
-    }
+    SCM_SET_CELL_WORD_0 (port,
+                        SCM_CELL_WORD_0 (port) & ~(scm_t_bits) SCM_BUFLINE);
 
   if (SCM_UNBNDP (size))
     {
@@ -216,10 +220,6 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
       pt->read_end = pt->saved_read_end;
       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");
-  if (pt->write_buf != &pt->shortbuf)
-    scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer");
 
   scm_fport_buffer_add (port, csize, csize);
 
@@ -542,6 +542,7 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name)
 {
   SCM port;
   scm_t_port *pt;
+  scm_t_port_internal *pti;
 
   /* Test that fdes is valid.  */
 #ifdef F_GETFL
@@ -567,7 +568,12 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name)
 
   port = scm_new_port_table_entry (scm_tc16_fport);
   SCM_SET_CELL_TYPE(port, scm_tc16_fport | mode_bits);
-  pt = SCM_PTAB_ENTRY(port);
+  pt = SCM_PTAB_ENTRY (port);
+
+  /* File ports support 'setvbuf'.  */
+  pti = SCM_PORT_GET_INTERNAL (port);
+  pti->supports_setvbuf = 1;
+
   {
     scm_t_fport *fp
       = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport),
diff --git a/libguile/ports-internal.h b/libguile/ports-internal.h
index 8a3a00b..2243744 100644
--- a/libguile/ports-internal.h
+++ b/libguile/ports-internal.h
@@ -1,7 +1,7 @@
 /*
  * ports-internal.h - internal-only declarations for ports.
  *
- * Copyright (C) 2013 Free Software Foundation, Inc.
+ * Copyright (C) 2013, 2014 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
@@ -50,7 +50,14 @@ struct scm_port_internal
   unsigned at_stream_start_for_bom_write : 1;
   scm_t_port_encoding_mode encoding_mode;
   scm_t_iconv_descriptors *iconv_descriptors;
-  int pending_eof;
+  unsigned char pending_eof: 1;
+
+  /* Whether this port supports 'setvbuf'.  If true, that means that
+     'setvbuf' is free to fiddle with its internal buffers.
+     XXX: Make this a property of the 'scm_t_ptob_descriptor'.  */
+  unsigned char supports_setvbuf: 1;
+
+  /* Key-value properties.  */
   SCM alist;
 };
 
diff --git a/libguile/ports.c b/libguile/ports.c
index 4516160..dbd22b9 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2006,
- *   2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ *   2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 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
@@ -677,6 +677,12 @@ scm_new_port_table_entry (scm_t_bits tag)
   pti->pending_eof = 0;
   pti->alist = SCM_EOL;
 
+  /* Until Guile 2.0.9 included, 'setvbuf' would only work on file
+     ports.  Now all port types can be supported, but it's not clear
+     that port types out in wild accept having someone else fiddle with
+     their buffer.  Thus, conservatively turn it off by default.  */
+  pti->supports_setvbuf = 0;
+
   SCM_SET_CELL_TYPE (z, tag);
   SCM_SETPTAB_ENTRY (z, entry);
 
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 9b1c6c0..c2f4480 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -2,7 +2,7 @@
 ;;;; Jim Blandy <address@hidden> --- May 1999
 ;;;;
 ;;;;   Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010,
-;;;;      2011, 2012, 2013 Free Software Foundation, Inc.
+;;;;      2011, 2012, 2013, 2014 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
@@ -1499,6 +1499,18 @@
 
 (with-test-prefix "setvbuf"
 
+  (pass-if-exception "closed port"
+      exception:wrong-type-arg
+    (let ((port (open-input-file "/dev/null")))
+      (close-port port)
+      (setvbuf port _IOFBF)))
+
+  (pass-if-exception "string port"
+      exception:wrong-type-arg
+    (let ((port (open-input-string "Hey!")))
+      (close-port port)
+      (setvbuf port _IOFBF)))
+
   (pass-if "line/column number preserved"
     ;; In Guile 2.0.5, `setvbuf' would erroneously decrease the port's
     ;; line and/or column number.
-- 
1.8.4