Unbuffered socket I/O

Unbuffered socket I/O

[Ludovic Courtès]

Hi,

Is there a reason why `SCM_SOCK_FD_TO_PORT ()' in `socket.c' asks for an
unbuffered port?  This results in awful inefficiency, as can be seen
with `strace':

  read(7, "\x43", 1)                      = 1
  select(1024, [7], [], [], {0, 0})       = 1 (in [7], left {0, 0})
  read(7, "\x4c", 1)                      = 1
  select(1024, [7], [], [], {0, 0})       = 1 (in [7], left {0, 0})
  read(7, "\x41", 1)                      = 1
  select(1024, [7], [], [], {0, 0})       = 1 (in [7], left {0, 0})

I'd like to change it to:

  #define SCM_SOCK_FD_TO_PORT(fd) \
     scm_fdes_to_port (fd, "r", sym_socket)

Thanks,
Ludovic.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Neil Jerram]

ludovic.courtes@laas.fr (Ludovic Courtès) writes:

> Hi,
>
> Is there a reason why `SCM_SOCK_FD_TO_PORT ()' in `socket.c' asks for an
> unbuffered port?  This results in awful inefficiency, as can be seen
> with `strace':

I don't know the details, but I recall people in the past talking
about Guile doing its own buffering.  Does that help at all?

Regards,
     Neil



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Kevin Ryde]

ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>
> Is there a reason why `SCM_SOCK_FD_TO_PORT ()' in `socket.c' asks for an
> unbuffered port?

To make send and receive conversations reliable, according to sockets
section in the manual.  (I don't think I added that.  I hope I'm not
claiming my own words as an authority!)

Also of course send and recv! don't use the buffering, so there's no
point having it when working with packets.

>   #define SCM_SOCK_FD_TO_PORT(fd) \
>      scm_fdes_to_port (fd, "r", sym_socket)

That's an incompatible change, I think, since it can leave unflushed
data where previously it went straight out.

Perhaps the unbuffering can be reiterated in the manual or docstrings
in each of socket, socketpair and accept which create such ports.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 1489 bytes --]

Hi,

Kevin Ryde <user42@zip.com.au> writes:

> ludovic.courtes@laas.fr (Ludovic Courtès) writes:

>>   #define SCM_SOCK_FD_TO_PORT(fd) \
>>      scm_fdes_to_port (fd, "r", sym_socket)
>
> That's an incompatible change, I think, since it can leave unflushed
> data where previously it went straight out.

Right.  That's an incompatible change if the _output_ is buffered.
Input can be buffered, though, without this being visible by users.

Fortunately, port buffering doesn't have to be symmetrical (although the
API allowing to do that is internal---actually, we might want to expose
and document `scm_fport_buffer_add ()').  Thus, I propose the following
change, where sockets are turned into ports whose output is left
unbuffered and whose input is buffered.  Again, this has no visible
effect on user programs AFAICS.

I tried it with TCP server-side sockets and the performance impact is
_huge_.  Actually, it seems even hard to write a TCP server without this
because it takes so long to read a single octet that clients may
time-out before the server is done receiving their request! (I observed
this with RPC server/clients)

BTW, do you know what the purpose of `fport_wait_for_input ()' is?  It
does nothing for O_NONBLOCK streams and waits for events otherwise.
Since, for blocking streams, `read ()' does not return until either EOF
is reached or at least one octet was read, `fport_wait_for_input ()'
seems redundant.

Thanks,
Ludovic.



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Patch providing socket input buffering. --]
[-- Type: text/x-patch, Size: 3183 bytes --]

--- orig/libguile/fports.c
+++ mod/libguile/fports.c
@@ -90,11 +90,11 @@
 /* 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.  */
-static void
-scm_fport_buffer_add (SCM port, long read_size, int write_size)
-#define FUNC_NAME "scm_fport_buffer_add"
+/* Create FPORT buffer with specified sizes (or -1 to use default size or
+   0 for no buffer).  */
+void
+scm_i_fport_buffer_add (SCM port, long read_size, long write_size)
+#define FUNC_NAME "scm_i_fport_buffer_add"
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
@@ -212,7 +212,7 @@
   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);
+  scm_i_fport_buffer_add (port, csize, csize);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -465,9 +465,9 @@
     pt->rw_random = SCM_FDES_RANDOM_P (fdes);
     SCM_SETSTREAM (port, fp);
     if (mode_bits & SCM_BUF0)
-      scm_fport_buffer_add (port, 0, 0);
+      scm_i_fport_buffer_add (port, 0, 0);
     else
-      scm_fport_buffer_add (port, -1, -1);
+      scm_i_fport_buffer_add (port, -1, -1);
   }
   SCM_SET_FILENAME (port, name);
   scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);


--- orig/libguile/fports.h
+++ mod/libguile/fports.h
@@ -60,7 +60,8 @@
 SCM_API SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name);
 SCM_API int scm_i_fport_truncate (SCM, SCM);
 SCM_API SCM scm_i_fport_seek (SCM, SCM, int);
-
+SCM_API void scm_i_fport_buffer_add (SCM port, long read_size,
+				     long write_size);
 
 #endif  /* SCM_FPORTS_H */
 


--- orig/libguile/socket.c
+++ mod/libguile/socket.c
@@ -403,9 +403,26 @@
 
 #endif  /* HAVE_IPV6 */
 
+\f
+/* Sockets.  */
+
 SCM_SYMBOL (sym_socket, "socket");
 
-#define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
+/* Size of the input buffer of socket ports.  */
+#define SCM_SOCKET_INPUT_BUFFER_SIZE  4096
+
+
+/* Return a socket with buffered input and unbufferred output.  */
+static inline SCM
+socket_to_port (int fd)
+{
+  SCM port;
+
+  port = scm_fdes_to_port (fd, "r+0", sym_socket);
+  scm_i_fport_buffer_add (port, SCM_SOCKET_INPUT_BUFFER_SIZE, 0);
+
+  return port;
+}
 
 SCM_DEFINE (scm_socket, "socket", 3, 0, 0,
             (SCM family, SCM style, SCM proto),
@@ -429,7 +446,7 @@
 	       scm_to_int (proto));
   if (fd == -1)
     SCM_SYSERROR;
-  return SCM_SOCK_FD_TO_PORT (fd);
+  return socket_to_port (fd);
 }
 #undef FUNC_NAME
 
@@ -451,7 +468,7 @@
   if (socketpair (fam, scm_to_int (style), scm_to_int (proto), fd) == -1)
     SCM_SYSERROR;
 
-  return scm_cons (SCM_SOCK_FD_TO_PORT (fd[0]), SCM_SOCK_FD_TO_PORT (fd[1]));
+  return scm_cons (socket_to_port (fd[0]), socket_to_port (fd[1]));
 }
 #undef FUNC_NAME
 #endif
@@ -1312,7 +1329,7 @@
   newfd = accept (fd, addr, &addr_size);
   if (newfd == -1)
     SCM_SYSERROR;
-  newsock = SCM_SOCK_FD_TO_PORT (newfd);
+  newsock = socket_to_port (newfd);
   address = _scm_from_sockaddr (addr, addr_size, FUNC_NAME);
   return scm_cons (newsock, address);
 }




[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Neil Jerram]

ludovic.courtes@laas.fr (Ludovic Courtès) writes:

> I tried it with TCP server-side sockets and the performance impact is
> _huge_.  Actually, it seems even hard to write a TCP server without this
> because it takes so long to read a single octet that clients may
> time-out before the server is done receiving their request! (I observed
> this with RPC server/clients)

I have no technical objection to your patch, but I'm afraid you must
be missing something, or else there is something special about the
environment that you were measuring in.  I have played with a few
TCP-based Guile applications (including the Emacs debugging interface)
and not noticed any obvious performance problem.

Regards,
     Neil



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Kevin Ryde]

ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>
> Right.  That's an incompatible change if the _output_ is buffered.
> Input can be buffered, though, without this being visible by users.

Alas, that too is in an incompatible change, because recv! ignores
buffering.

> Fortunately, port buffering doesn't have to be symmetrical (although the
> API allowing to do that is internal---actually, we might want to expose
> and document `scm_fport_buffer_add ()').

Sounds good.  Perhaps `setvbuf-input' and `setvbuf-output' for the two
directions.  They could go in 1.8 too if you're careful with the
implementation.

Might have to check the SCM_BUFLINE and SCM_BUF0 flags are ok though.
Suspect the answer is yes, SCM_BUFLINE being an output side feature,
and SCM_BUF0 already merely a combination read==unbuf + write==unbuf.

> Thus, I propose the following
> change, where sockets are turned into ports whose output is left
> unbuffered and whose input is buffered.

The manual could emphasise that unbuffered is not what you want if
reading piecemeal, but the default should stay as advertised.

> BTW, do you know what the purpose of `fport_wait_for_input ()' is?

Maybe left from the 1.6 cooperative threads.

> It
> does nothing for O_NONBLOCK streams and waits for events otherwise.
> Since, for blocking streams, `read ()' does not return until either EOF
> is reached or at least one octet was read, `fport_wait_for_input ()'
> seems redundant.

Ahh, hang on, I wonder if it's a hack to do an "exit guile" while
blocked within a read(), thus allowing gc to run in other threads.

If that's true then presumably the write side is afflicted too, as
well as various other potentially blocking operations like
read-string!/partial and gethost.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Kevin Ryde]

Neil Jerram <neil@ossau.uklinux.net> writes:
>
> I have played with a few
> TCP-based Guile applications (including the Emacs debugging interface)
> and not noticed any obvious performance problem.

Likewise.  I've been reading http headers byte by byte - because I was
too lazy to do it properly yet - with no obvious pain.  I read the
bodies block by block though, with read-string!/partial.

Dunno if read-string!/partial is entirely obvious from what's in the
manual.  Maybe the "Reading" node should have some prominent cross
refs to the rdelim and rw modules -- don't want people thinking
read-char is the right way to go.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 661 bytes --]

Hi,

Neil Jerram <neil@ossau.uklinux.net> writes:

> I have no technical objection to your patch, but I'm afraid you must
> be missing something, or else there is something special about the
> environment that you were measuring in.  I have played with a few
> TCP-based Guile applications (including the Emacs debugging interface)
> and not noticed any obvious performance problem.

I tried the attached script, both with and without the patch.  Here, it
says "time: 7" with the patch and "time: 2645" without.

Now, it seems that I was observing an even higher difference because the
Guile server script was running under `strace'...  :-)

Thanks,
Ludovic.



[-- Attachment #2: Test program. --]
[-- Type: text/plain, Size: 944 bytes --]

(use-modules (srfi srfi-4))

(define %port 7778)
(define %size 5000000)

(define (time thunk)
  (let ((start (get-internal-run-time)))
    (thunk)
    (let ((end (get-internal-run-time)))
      (format #t "time: ~a~%" (- end start)))))

(if (= 0 (primitive-fork))

    (let ((s (socket PF_INET SOCK_STREAM 0)))
      (bind s AF_INET INADDR_LOOPBACK %port)
      (listen s 1024)

      (format #t "accepting connections...~%")
      (let* ((accepted (accept s))
             (port (car accepted))
             (vec  (make-u8vector %size)))
        (time
         (lambda ()
           (uniform-vector-read! vec port)))
        (close-port port)))

    (let ((s (socket PF_INET SOCK_STREAM 0))
          (vec (make-u8vector %size)))
      (format #t "client~%")
      (sleep 1)
      (connect s AF_INET INADDR_LOOPBACK %port)

      (format #t "writing...~%")
      (uniform-vector-write vec s)
      (format #t "done.~%")
      (close-port s)))

[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 1851 bytes --]

Hi,

Kevin Ryde <user42@zip.com.au> writes:

> ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>>
>> Right.  That's an incompatible change if the _output_ is buffered.
>> Input can be buffered, though, without this being visible by users.
>
> Alas, that too is in an incompatible change, because recv! ignores
> buffering.

Hmm, right.

> Sounds good.  Perhaps `setvbuf-input' and `setvbuf-output' for the two
> directions.  They could go in 1.8 too if you're careful with the
> implementation.

Below is a tentative patch (I chose more meaningful names since they
don't relate to `setvbuf(3)').  The issue is that it duplicates fport
buffering logic, but I couldn't think of a nice way to factorize this
with, e.g., `scm_fport_buffer_add ()'.  What do you think?

Besides, how about applying the change I originally proposed to HEAD?
That would require changing `recv!', `send', etc. so that they are
somehow "buffering-aware".  Ideally, it would be nice if they didn't
break through the port abstraction as they currently do, but I don't
know how that could be implemented (what should be the meaning of
`MSG_DONTROUTE' on an input string buffer?  ;-)).

>> It
>> does nothing for O_NONBLOCK streams and waits for events otherwise.
>> Since, for blocking streams, `read ()' does not return until either EOF
>> is reached or at least one octet was read, `fport_wait_for_input ()'
>> seems redundant.
>
> Ahh, hang on, I wonder if it's a hack to do an "exit guile" while
> blocked within a read(), thus allowing gc to run in other threads.

Indeed, `scm_std_select ()' does a "leave guile".

> If that's true then presumably the write side is afflicted too, as
> well as various other potentially blocking operations like
> read-string!/partial and gethost.

Afflicted by what?

Thanks,
Ludovic.



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Asymmetrical fport buffering. --]
[-- Type: text/x-patch, Size: 4273 bytes --]

--- orig/libguile/fports.c
+++ mod/libguile/fports.c
@@ -90,10 +90,10 @@
 /* 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);
@@ -217,6 +217,115 @@
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_set_port_input_buffer_size_x, "set-port-input-buffer-size!",
+	    2, 0, 0,
+	    (SCM port, SCM size),
+	    "Use a @var{size}-octet input buffer for @var{port}, which "
+	    "must be a file or socket port.  The current input buffer "
+	    "of @var{port} must contain less than @var{size} octets.")
+#define FUNC_NAME s_scm_set_port_input_buffer_size_x
+{
+  scm_t_port *pt;
+  size_t c_size;
+
+  SCM_VALIDATE_FPORT (1, port);
+  c_size = scm_to_uint (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)
+	scm_wrong_type_arg_msg (FUNC_NAME, 1, port,
+				"Input buffer must be flushed before it "
+				"can be shrunk");
+
+      if (c_size == 0)
+	new_buf = &pt->shortbuf, c_size = 1;
+      else
+	{
+	  if (pt->read_buf != &pt->shortbuf)
+	    new_buf = scm_gc_realloc (pt->read_buf,
+				      pt->read_buf_size, c_size,
+				      "port buffer");
+	  else
+	    new_buf = scm_gc_malloc (c_size, "port buffer");
+	}
+
+      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);
+    }
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_set_port_output_buffer_size_x, "set-port-output-buffer-size!",
+	    2, 0, 0,
+	    (SCM port, SCM size),
+	    "Use a @var{size}-octet output buffer for @var{port}, which "
+	    "must be a file or socket port.  The current output buffer of "
+	    "@var{port} must contain less than @var{size} octets.")
+#define FUNC_NAME s_scm_set_port_output_buffer_size_x
+{
+  scm_t_port *pt;
+  size_t c_size;
+
+  SCM_VALIDATE_FPORT (1, port);
+  c_size = scm_to_uint (size);
+
+  pt = SCM_PTAB_ENTRY (port);
+
+  if (pt->write_buf_size != c_size)
+    {
+      size_t c_offset, c_end;
+      unsigned char *new_buf;
+
+      c_end = pt->write_end - pt->write_buf;
+      c_offset = pt->write_pos - pt->write_buf;
+
+      if (c_offset > c_size)
+	scm_wrong_type_arg_msg (FUNC_NAME, 1, port,
+				"Output buffer must be flushed before it "
+				"can be shrunk");
+
+      if (c_size == 0)
+	new_buf = &pt->shortbuf, c_size = 1;
+      else
+	{
+	  if (pt->write_buf != &pt->shortbuf)
+	    new_buf = scm_gc_realloc (pt->write_buf,
+				      pt->write_buf_size, c_size,
+				      "port buffer");
+	  else
+	    new_buf = scm_gc_malloc (c_size, "port buffer");
+	}
+
+      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);
+    }
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
 /* Move ports with the specified file descriptor to new descriptors,
  * resetting the revealed count to 0.
  */


--- orig/libguile/fports.h
+++ mod/libguile/fports.h
@@ -49,6 +49,8 @@
 \f
 SCM_API SCM scm_setbuf0 (SCM port);
 SCM_API SCM scm_setvbuf (SCM port, SCM mode, SCM size);
+SCM_API SCM scm_set_port_input_buffer_size_x (SCM port, SCM size);
+SCM_API SCM scm_set_port_output_buffer_size_x (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);




[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Kevin Ryde]

ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>
> Below is a tentative patch (I chose more meaningful names since they
> don't relate to `setvbuf(3)').

Call them setvbuf.  Two names for the same thing is more confusing
than one (slightly obscure) name.

> Besides, how about applying the change I originally proposed to HEAD?

No, principally because unbuffered is an advertised feature.  Even if
it was year zero you'd probably still choose them to start unbuffered,
since there's various ways to do comms and it can be up to an
application how much might be desirable.  For block operations for
instance it's certainly not wanted.

> That would require changing `recv!', `send', etc. so that they are
> somehow "buffering-aware".

That could be ok.  I doubt it makes much sense, because buffering is
more or less stream oriented yet those funcs are about packets.  But
they could still look at the buffers in the interests of keeping data
in sequence.

> Afflicted by what?

Blocking in one thread prevents gc in any other thread, bringing
everything to a screeching halt, before long.


> +	    "Use a @var{size}-octet

Say "byte" not "octet".  Octet sounds like one of those dreadful CCITT
standards.

> +  size_t c_size;
> +  c_size = scm_to_uint (size);

There's an scm_to_size_t for that.

+      if (c_offset > c_size)
+	scm_wrong_type_arg_msg (FUNC_NAME, 1, port,
+				"Input buffer must be flushed before it "
+				"can be shrunk");

The current code silently discards, I think that's probably enough.
If it was up to me I might move it to the putback buffer though.

> +      if (c_size == 0)
> +	new_buf = &pt->shortbuf, c_size = 1;

I suppose an explicit request for size==1 could use the shortbuf too,
though I see the existing code doesn't do that.  (Maybe there's a
reason it doesn't.)

I expect there's a memory leak there if you don't free the old buf
when becoming unbuffered.

> +      if ((pt->read_buf_size == 0) && (pt->write_buf_size == 0))
> +	SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUF0);

That'd need to turn the flag off too, if it's become non-zero.

> +      if (c_offset > c_size)
> +	scm_wrong_type_arg_msg (FUNC_NAME, 1, port,
> +				"Output buffer must be flushed before it "
> +				"can be shrunk");

That doesn't need to be an error does it?  Can't it be flushed there
and then?

Otherwise looks ok as long as it actually works! :)


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Kevin Ryde]

ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>
>            (uniform-vector-read! vec port)))

Slackness in the implementation of that function.  It knows a size to
read and should come out as a read() system call of that size.  Yet it
always goes through the port buffer.  You need to post the problem
instead of leaping to a "solution".

read-string!/partial is much better in that respect.  Maybe that func
should be loosened up to work on non-fports too, that could be nice.

It's a bit of a failing of the ptab port functions that there's no
"read N bytes", but that needn't prevent uniform-vector-read! doing
the right thing on fports.

Could think about whether it ought to make multiple calls to fill the
requested size.  I guess that's how it is now, in effect, so probably
yes.  Could also think if those calls should then cope with O_NONBLOCK
too, by sleeping in select() if finding there's nothing to read yet.
On a single read call I would say let it throw an error, but if the
aim is to block until the requested size then it's easy enough to
cope.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Ludovic Courtès]

Hi,

Kevin Ryde <user42@zip.com.au> writes:

> ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>>
>>            (uniform-vector-read! vec port)))
>
> Slackness in the implementation of that function.  It knows a size to
> read and should come out as a read() system call of that size.  Yet it
> always goes through the port buffer.

I believe it's a feature, not some "slackness".  ;-)

The function is meant to read from _any_ kind of input port.  Thus, it
can definitely not use the `read ()' system call to that end.  Instead,
it rightfully uses one of the two public functions available to read
from an arbitrary port: `scm_getc ()' and `scm_c_read ()'.

> read-string!/partial is much better in that respect.  Maybe that func
> should be loosened up to work on non-fports too, that could be nice.
>
> It's a bit of a failing of the ptab port functions that there's no
> "read N bytes", but that needn't prevent uniform-vector-read! doing
> the right thing on fports.

There's `scm_c_read ()' for "read N bytes", but it translates into N
calls to `scm_getc ()'.  If the port is unbuffered, then each invocation
of `scm_getc ()' translates in one `scm_fill_input ()' call, which in
turn translates in one `select ()' and one `read ()' of size 1.  I think
_this_ is the issue, not the fact that `uniform-vector-read!' can read
from any kind of port.

IMO it feels wrong to dismiss the port abstraction (e.g., by testing for
fports and using fport-specific I/O methods) just to work around this
performance problem.

> Could also think if those calls should then cope with O_NONBLOCK
> too, by sleeping in select() if finding there's nothing to read yet.
> On a single read call I would say let it throw an error, but if the
> aim is to block until the requested size then it's easy enough to
> cope.

I noticed that `fport_fill_input ()' would raise an error when reading
from a non-blocking file descriptor where input is not available (i.e.,
when `read ()' returns -1 with ERRNO == EWOULDBLOCK).  Thus it must be
inconvenient (at best) to use the port I/O functions on a port whose
underlying FD is in non-blocking mode.  I don't know what would need to
be done to fix this.

Thanks,
Ludovic.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 1085 bytes --]

Hi,

Attached is an updated patch.  Ok to apply?

Kevin Ryde <user42@zip.com.au> writes:

>> Besides, how about applying the change I originally proposed to HEAD?
>
> No, principally because unbuffered is an advertised feature.

Hey, it's only advertised as long as we advertise it!  ;-)

I mean, if we start nitpicking about such changes in HEAD, then we'll
never implement a Unicode-capable port I/O interface, will we?  :-)

> Even if
> it was year zero you'd probably still choose them to start unbuffered,
> since there's various ways to do comms and it can be up to an
> application how much might be desirable.  For block operations for
> instance it's certainly not wanted.

The thing is that port buffering in Guile does not necessarily have a
direct relationship to OS-level buffering.  This is clear for input,
where one can have unbuffered OS-level file descriptor and where
port-level input buffering only impacts performance, not semantics.
Conversely, port-level output buffering does have a visible impact from
the outside world.

Thanks for your comments!

Ludovic.



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: The improved patch. --]
[-- Type: text/x-patch, Size: 8079 bytes --]

--- 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 @@
 \f
 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);


[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Kevin Ryde]

ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>
> There's `scm_c_read ()' for "read N bytes", but it translates into N
> calls to `scm_getc ()'.

Then that's where it can best be fixed.

> IMO it feels wrong to dismiss the port abstraction

There's nothing super fantastic about the ptab funcs, there's
certainly no need to confine oneself to what's presently there.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Kevin Ryde]

ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>
> +SCM_DEFINE (scm_setvbuf_output, "setvbuf-output", 2, 0, 0,
> +	    (SCM port, SCM size),

Can that take a mode, so it's possible to set _IOLBF ?

setvbuf-input could also take a mode, though _IOLBF wouldn't be wanted
there, but it'd make the args the same for all three funcs - the input
and output versions being the same as the main except only operating
on one side.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Kevin Ryde]

ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>
> of `scm_getc ()' translates in one `scm_fill_input ()' call, which in
> turn translates in one `select ()' and one `read ()'

Coming back to this bit: that select really does seem pretty doubtful.
The more I think the more it sounds like a hangover from 1.6 where
select was the only proper place to block if other threads were to
keep running.

But maybe now the right thing would be to have the scm_leave_guile or
scm_without_guile or whatever around each read/write.  Avoiding
initializing an fd_set and whatnot for select would have to be a good
thing.

If so then there'd be other places a similar leave might be wanted,
`copy-file' and `gethost' for instance (I might have mentioned them
before).  Oh well, I guess there's plenty of work for anyone who wants
to investigate ...


One thing I'm pretty sure about though is that the __MINGW32__
conditional on fport_wait_for_input can't be right.  I think we had
bug reports that mingw has pthreads now, so surely anything wanted for
pthreads will be wanted on mingw (or new enough ones or whatever).

Maybe the condition was meant to be "if threads" instead of "if not
mingw".  If configured with null-threads then there'd be no need to
worry about where any blocking happens.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Kevin Ryde]

ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>
> N calls to `scm_getc ()'

Speaking of scm_getc ... I've wondered for a while if some of the low
level reading funcs ought to be looking directly into the read buffer
instead of making a call to scm_getc for every char.  My experience
has usually been that a function call per character is very much to be
avoided if performance on sizeable input matters.

I'd have in mind simple bits like rdelim `read-line' which could do a
scan of the buffer for a newline; and possibly scm_flush_ws (within
`read') which is looking for non-whitespace and jumping over comments.
Not sure if helping the latter would be noticable speedup, but it's
nice to think that big chunks of comments in sources could be cheap to
read.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Kevin Ryde]

I wrote:
>
> rdelim `read-line'

Oops, I confused myself.  It already looks in the buffer - it's the
model not the improvable - a few more bits could be like it ...


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Ludovic Courtès]

Hi,

Kevin Ryde <user42@zip.com.au> writes:

> Speaking of scm_getc ... I've wondered for a while if some of the low
> level reading funcs ought to be looking directly into the read buffer
> instead of making a call to scm_getc for every char.  My experience
> has usually been that a function call per character is very much to be
> avoided if performance on sizeable input matters.

You are right: `scm_getc ()' _is_ a performance bottleneck, one function
call for a single memory read (which is the common case when the port is
buffered) is way too much---`scm_getc ()' often shows up in the top 10
in Gprof's flat profile.

The whole point of having a buffer in a publicly-exposed struct is to
avoid function call overhead when accessing it.  Thus, `scm_getc ()'
should be inlined.

(You might have read that Guile-Reader is noticeably faster than
`scm_read ()'.  One of the reasons for this is that it inlines
`scm_getc ()' in the generated lightning code.)


Unfortunately, the machinery in `inline.h' makes it quite inconvenient
to add inline functions, and forces us to put all of them in a single
file.  GMP has a similar but slightly "cleaner" mechanism, which maybe
we could build upon to improve ours.

There are definitely a number of functions candidate for inlining in
Guile, typically functions that only execute a handful of instructions.

Thanks,
Ludovic.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

`scm_std_select ()' call in `fport_wait_for_input ()'

[Ludovic Courtès]

Hi,

Kevin Ryde <user42@zip.com.au> writes:

> ludovic.courtes@laas.fr (Ludovic Courtès) writes:

>> BTW, do you know what the purpose of `fport_wait_for_input ()' is?
>
> Maybe left from the 1.6 cooperative threads.
>
>> It
>> does nothing for O_NONBLOCK streams and waits for events otherwise.
>> Since, for blocking streams, `read ()' does not return until either EOF
>> is reached or at least one octet was read, `fport_wait_for_input ()'
>> seems redundant.
>
> Ahh, hang on, I wonder if it's a hack to do an "exit guile" while
> blocked within a read(), thus allowing gc to run in other threads.
>
> If that's true then presumably the write side is afflicted too, as
> well as various other potentially blocking operations like
> read-string!/partial and gethost.

In node "Blocking", the manual reads this:

  A thread must not block outside of a libguile function while it is in
  guile mode.  The following functions can be used to temporily leave
  guile mode or to perform some common blocking operations in a
  supported way.

The `scm_std_select ()' call does indeed a "leave guile mode", thereby
allowing GC to run, should input data be currently unavailable.  I guess
that's why it's here.

A alternative way to do this would be to have `fport_wait_for_input ()'
call `read(2)' through `scm_without_guile ()'.  This would make the
intent clearer, and may perform slightly better (removes one syscall
from the I/O path).

What do you think?

Thanks,
Ludovic.



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Unbuffered socket I/O

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 441 bytes --]

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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: The patch --]
[-- Type: text/x-patch, Size: 10912 bytes --]

--- 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 @@
 \f
 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);


[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel