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.

test-suite/tests/ports.test

@@ -23,6 +23,7 @@
   #:use-module (test-suite guile-test)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 threads)
   #:use-module (rnrs bytevectors)
   #:use-module ((ice-9 binary-ports) #:select (open-bytevector-input-port
                                                open-bytevector-output-port
@@ -601,20 +602,18 @@
                           (pass-if "unread residue"
                                    (string=? (read-line) "moon"))))
 
-;;; non-blocking mode on a port.  create a pipe and set O_NONBLOCK on
-;;; the reading end.  try to read a byte: should get EAGAIN or
-;;; EWOULDBLOCK error.
-(let* ((p (pipe))
-       (r (car p)))
-  (fcntl r F_SETFL (logior (fcntl r F_GETFL) O_NONBLOCK))
-  (pass-if "non-blocking-I/O"
-           (catch 'system-error
-                  (lambda () (read-char r) #f)
-                  (lambda (key . args)
-                    (and (eq? key 'system-error)
-                         (let ((errno (car (list-ref args 3))))
-                           (or (= errno EAGAIN)
-                               (= errno EWOULDBLOCK))))))))
+(when (provided? 'threads)
+  (let* ((p (pipe))
+         (r (car p))
+         (w (cdr p)))
+    (fcntl r F_SETFL (logior (fcntl r F_GETFL) O_NONBLOCK))
+    (let ((thread (call-with-new-thread
+                   (lambda ()
+                     (usleep (* 250 1000))
+                     (write-char #\a w)
+                     (force-output w)))))
+      (pass-if-equal "non-blocking-I/O" #\a (read-char r))
+      (join-thread thread))))
 
 
 ;;;; Pipe (popen) ports.