Support for non-blocking I/O

* doc/ref/api-io.texi (I/O Extensions): Document read_wait_fd /
  write_wait_fd members.
  (Non-Blocking I/O): New section.
* libguile/fports.c (fport_read, fport_write): Return -1 if the
  operation would block.
  (fport_wait_fd, scm_make_fptob): Add read/write wait-fd
  implementation.
* libguile/ports-internal.h (scm_t_port_type): Add read_wait_fd /
  write_wait_fd.
* libguile/ports.c (default_read_wait_fd, default_write_wait_fd): New
  functions.
  (scm_make_port_type): Initialize default read/write wait fd impls.
  (trampoline_to_c_read, trampoline_to_scm_read)
  (trampoline_to_c_write, trampoline_to_scm_write): To Scheme, a return
  of #f indicates EWOULDBLOCk.
  (scm_set_port_read_wait_fd, scm_set_port_write_wait_fd): New
  functions.
  (port_read_wait_fd, port_write_wait_fd, scm_port_read_wait_fd)
  (scm_port_write_wait_fd, port_poll, scm_port_poll): New functions.
  (scm_i_read_bytes, scm_i_write_bytes): Poll if the read or write would
  block.
* libguile/ports.h (scm_set_port_read_wait_fd)
  (scm_set_port_write_wait_fd): Add declarations.
* module/ice-9/ports.scm: Shunt port-poll and port-{read,write}-wait-fd
  to the internals module.
* module/ice-9/sports.scm (current-write-waiter):
  (current-read-waiter): Implement.
* test-suite/tests/ports.test: Adapt non-blocking test to new behavior.
* NEWS: Add entry.

1 files changed, 38 insertions, 8 deletions

diff --git a/libguile/fports.c b/libguile/fports.c
index 046a844e9..271f3a0a1 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -573,14 +573,24 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
 static size_t
 fport_read (SCM port, SCM dst, size_t start, size_t count)
 {
-  long res;
   scm_t_fport *fp = SCM_FSTREAM (port);
   signed char *ptr = SCM_BYTEVECTOR_CONTENTS (dst) + start;
+  ssize_t ret;
 
-  SCM_SYSCALL (res = read (fp->fdes, ptr, count));
-  if (res == -1)
-    scm_syserror ("fport_read");
-  return res;
+ retry:
+  ret = read (fp->fdes, ptr, count);
+  if (ret < 0)
+    {
+      if (errno == EINTR)
+        {
+          SCM_ASYNC_TICK;
+          goto retry;
+        }
+      if (errno == EWOULDBLOCK || errno == EAGAIN)
+        return -1;
+      scm_syserror ("fport_read");
+    }
+  return ret;
 }
 
 static size_t
@@ -588,11 +598,23 @@ fport_write (SCM port, SCM src, size_t start, size_t count)
 {
   int fd = SCM_FPORT_FDES (port);
   signed char *ptr = SCM_BYTEVECTOR_CONTENTS (src) + start;
+  ssize_t ret;
 
-  if (full_write (fd, ptr, count) < count)
-    scm_syserror ("fport_write");
+ retry:
+  ret = write (fd, ptr, count);
+  if (ret < 0)
+    {
+      if (errno == EINTR)
+        {
+          SCM_ASYNC_TICK;
+          goto retry;
+        }
+      if (errno == EWOULDBLOCK || errno == EAGAIN)
+        return -1;
+      scm_syserror ("fport_write");
+    }
 
-  return count;
+  return ret;
 }
 
 static scm_t_off
@@ -637,6 +659,12 @@ fport_random_access_p (SCM port)
   return SCM_FDES_RANDOM_P (SCM_FSTREAM (port)->fdes);
 }
 
+static int
+fport_wait_fd (SCM port)
+{
+  return SCM_FSTREAM (port)->fdes;
+}
+
 /* Query the OS to get the natural buffering for FPORT, if available.  */
 static void
 fport_get_natural_buffer_sizes (SCM port, size_t *read_size, size_t *write_size)
@@ -660,6 +688,8 @@ scm_make_fptob ()
   scm_set_port_close                    (ptob, fport_close);
   scm_set_port_seek                     (ptob, fport_seek);
   scm_set_port_truncate                 (ptob, fport_truncate);
+  scm_set_port_read_wait_fd             (ptob, fport_wait_fd);
+  scm_set_port_write_wait_fd            (ptob, fport_wait_fd);
   scm_set_port_input_waiting            (ptob, fport_input_waiting);
   scm_set_port_random_access_p          (ptob, fport_random_access_p);
   scm_set_port_get_natural_buffer_sizes (ptob, fport_get_natural_buffer_sizes);