[Guile-commits] GNU Guile branch, master, updated. release_1-9-13-139-g67a72dc

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=67a72dc13c9d058730361449416ba88c4a6d5dcb

The branch, master has been updated
       via  67a72dc13c9d058730361449416ba88c4a6d5dcb (commit)
       via  4595600a08b7f01b9a4eb8f9d1732f1728989d81 (commit)
       via  e9634465e365e74b3dc3edeae98a98ece1530f82 (commit)
      from  a9a206554062cf55220dd33d9256ccb431cc888e (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 67a72dc13c9d058730361449416ba88c4a6d5dcb
Author: Andy Wingo <address@hidden>
Date:   Mon Dec 6 19:59:15 2010 +0100

    scm_setvbuf doesn't throw away current buffers
    
    * libguile/ports.c (scm_drain_input): Slight optimization.
    
    * libguile/fports.c (scm_setvbuf): If there is buffered output, flush
      it.  If there is input, drain it, and then unread it after updating
      the buffers.  Much more sensible than dropping it silently...

commit 4595600a08b7f01b9a4eb8f9d1732f1728989d81
Author: Andy Wingo <address@hidden>
Date:   Mon Dec 6 19:52:51 2010 +0100

    http-read calls setvbuf only once
    
    * module/web/server/http.scm (http-read): Don't play the setvbuf dance,
      it was throwing away buffered input. Instead just call setvbuf once
      before doing any reads or writes.

commit e9634465e365e74b3dc3edeae98a98ece1530f82
Author: Andy Wingo <address@hidden>
Date:   Mon Dec 6 19:27:22 2010 +0100

    ice-9 poll handles buffered io too
    
    * libguile/poll.c (scm_primitive_poll): Account for buffered I/O.
    
    * module/ice-9/poll.scm (poll): Adapt to call primitive-poll with the
      port vector too.

-----------------------------------------------------------------------

Summary of changes:
 libguile/fports.c          |   14 +++++++-
 libguile/poll.c            |   80 +++++++++++++++++++++++++++++++++++++++++--
 libguile/ports.c           |   10 ++++-
 module/ice-9/poll.scm      |    1 +
 module/web/server/http.scm |    8 +---
 5 files changed, 100 insertions(+), 13 deletions(-)

diff --git a/libguile/fports.c b/libguile/fports.c
index 4b190e1..fdc8f46 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -170,6 +170,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
 {
   int cmode;
   long csize;
+  SCM drained;
   scm_t_port *pt;
 
   port = SCM_COERCE_OUTPORT (port);
@@ -205,7 +206,14 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
 
   pt = SCM_PTAB_ENTRY (port);
 
-  /* silently discards buffered and put-back chars.  */
+  if (SCM_INPUT_PORT_P (port))
+    drained = scm_drain_input (port);
+  else
+    drained = scm_nullstr;
+
+  if (SCM_OUTPUT_PORT_P (port))
+    scm_flush (port);
+
   if (pt->read_buf == pt->putback_buf)
     {
       pt->read_buf = pt->saved_read_buf;
@@ -219,6 +227,10 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
     scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer");
 
   scm_fport_buffer_add (port, csize, csize);
+
+  if (scm_is_true (drained) && scm_c_string_length (drained))
+    scm_unread_string (drained, port);
+
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
diff --git a/libguile/poll.c b/libguile/poll.c
index 0304448..e4d430c 100644
--- a/libguile/poll.c
+++ b/libguile/poll.c
@@ -61,17 +61,28 @@
    The pollfds bytevector is modified directly, setting the returned events in
    the final two bytes (the revents member).
 
+   Since Scheme ports can buffer input or output in userspace, a Scheme
+   poll interface needs to take that into account as well.  The `ports'
+   argument, a vector big enough for `nfds' elements, is given for this
+   purpose.  If a pollfd entry has a corresponding open port, that port
+   is scanned for available input or output before dropping into the
+   poll.  If any port has buffered I/O available, the poll syscall is
+   still issued, but with a timeout of 0 milliseconds, and a full port
+   scan occurs after the poll returns.
+
    If timeout is given and is non-negative, the poll will return after that
    number of milliseconds if no fd became active.
    */
 #ifdef HAVE_POLL
 static SCM
-scm_primitive_poll (SCM pollfds, SCM nfds, SCM timeout)
+scm_primitive_poll (SCM pollfds, SCM nfds, SCM ports, SCM timeout)
 #define FUNC_NAME "primitive-poll"
 {
-  int rv;
+  int rv = 0;
+  nfds_t i;
   nfds_t c_nfds;
   int c_timeout;
+  int have_buffered_io = 0;
   struct pollfd *fds;
 
   SCM_VALIDATE_BYTEVECTOR (SCM_ARG1, pollfds);
@@ -80,15 +91,76 @@ scm_primitive_poll (SCM pollfds, SCM nfds, SCM timeout)
   
   if (SCM_UNLIKELY (SCM_BYTEVECTOR_LENGTH (pollfds)
                     < c_nfds * sizeof(struct pollfd)))
-    SCM_OUT_OF_RANGE (SCM_ARG1, nfds);
+    SCM_OUT_OF_RANGE (SCM_ARG2, nfds);
   
+  SCM_VALIDATE_VECTOR (SCM_ARG3, ports);
+  if (SCM_UNLIKELY (SCM_SIMPLE_VECTOR_LENGTH (ports) < c_nfds))
+    SCM_OUT_OF_RANGE (SCM_ARG3, ports);
+    
   fds = (struct pollfd*)SCM_BYTEVECTOR_CONTENTS (pollfds);
   
+  for (i = 0; i < c_nfds; i++)
+    {
+      SCM port = SCM_SIMPLE_VECTOR_REF (ports, i);
+      short int revents = 0;
+
+      if (SCM_PORTP (port))
+        {
+          if (SCM_CLOSEDP (port))
+            revents |= POLLERR;
+          else
+            {
+              scm_t_port *pt = SCM_PTAB_ENTRY (port);
+
+              if (pt->read_pos < pt->read_end)
+                /* Buffered input waiting to be read. */
+                revents |= POLLIN;
+              if (pt->write_pos < pt->write_end)
+                /* Buffered output possible. */
+                revents |= POLLOUT;
+            }
+        }
+
+      if (revents & fds[i].events)
+        {
+          have_buffered_io = 1;
+          c_timeout = 0;
+          break;
+        }
+    }
+
   SCM_SYSCALL (rv = poll (fds, c_nfds, c_timeout));
 
   if (rv == -1)
     SCM_SYSERROR;
 
+  if (have_buffered_io)
+    for (i = 0; i < c_nfds; i++)
+      {
+        SCM port = SCM_SIMPLE_VECTOR_REF (ports, i);
+        short int revents = 0;
+
+        if (SCM_PORTP (port))
+          {
+            if (SCM_CLOSEDP (port))
+              revents |= POLLERR;
+            else
+              {
+                scm_t_port *pt = SCM_PTAB_ENTRY (port);
+
+                if (pt->read_pos < pt->read_end)
+                  /* Buffered input waiting to be read. */
+                  revents |= POLLIN;
+                if (pt->write_pos < pt->write_end)
+                  /* Buffered output possible. */
+                  revents |= POLLOUT;
+              }
+          }
+
+        if ((fds[i].revents = revents & fds[i].events))
+          rv++;
+      }
+
   return scm_from_int (rv);
 }
 #undef FUNC_NAME
@@ -101,7 +173,7 @@ static void
 scm_init_poll (void)
 {
 #if HAVE_POLL
-  scm_c_define_gsubr ("primitive-poll", 3, 0, 0, scm_primitive_poll);
+  scm_c_define_gsubr ("primitive-poll", 4, 0, 0, scm_primitive_poll);
 #else
   scm_misc_error ("%init-poll", "`poll' unavailable on this platform", 
SCM_EOL);
 #endif
diff --git a/libguile/ports.c b/libguile/ports.c
index ff40a33..a9ba08e 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -347,8 +347,14 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
   if (pt->read_buf == pt->putback_buf)
     count += pt->saved_read_end - pt->saved_read_pos;
 
-  result = scm_i_make_string (count, &data);
-  scm_take_from_input_buffers (port, data, count);
+  if (count)
+    {
+      result = scm_i_make_string (count, &data);
+      scm_take_from_input_buffers (port, data, count);
+    }
+  else
+    result = scm_nullstr;
+  
   return result;
 }
 #undef FUNC_NAME
diff --git a/module/ice-9/poll.scm b/module/ice-9/poll.scm
index e506e2a..26b264b 100644
--- a/module/ice-9/poll.scm
+++ b/module/ice-9/poll.scm
@@ -172,4 +172,5 @@
 (define* (poll poll-set #:optional (timeout -1))
   (primitive-poll (pset-pollfds poll-set)
                   (poll-set-nfds poll-set)
+                  (pset-ports poll-set)
                   timeout))
diff --git a/module/web/server/http.scm b/module/web/server/http.scm
index bddbafa..0cbf43b 100644
--- a/module/web/server/http.scm
+++ b/module/web/server/http.scm
@@ -90,8 +90,8 @@
             ;;
             ;; FIXME: preserve meta-info.
             (let ((client (accept (poll-set-port poll-set idx))))
-              ;; Set line buffering while reading the request.
-              (setvbuf (car client) _IOLBF)
+              ;; Buffer input and output on this port.
+              (setvbuf (car client) _IOFBF)
               ;; From "HOP, A Fast Server for the Diffuse Web", Serrano.
               (setsockopt (car client) SOL_SOCKET SO_SNDBUF (* 12 1024))
               (poll-set-add! poll-set (car client) *events*)
@@ -117,8 +117,6 @@
                #t
                (lambda ()
                  (let ((req (read-request port)))
-                   ;; Block buffering for reading body and writing response.
-                   (setvbuf port _IOFBF)
                    (values port
                            req
                            (read-request-body/bytevector req))))
@@ -151,8 +149,6 @@
     (cond
      ((keep-alive? response)
       (force-output port)
-      ;; back to line buffered
-      (setvbuf port _IOLBF)
       (poll-set-add! (http-poll-set server) port *events*))
      (else
       (close-port port)))


hooks/post-receive
-- 
GNU Guile