[Guile-commits] 06/10: Non-blocking accept/connect Scheme support

[Andy Wingo]

wingo pushed a commit to branch +wip-ethreads
in repository guile.

commit cb431bca167cffc7754984bfcd0e38a2eb2488f6
Author: Andy Wingo <address@hidden>
Date:   Thu Jun 2 23:02:21 2016 +0200

    Non-blocking accept/connect Scheme support
    
    * module/ice-9/sports.scm (accept, connect): New Scheme functions.
---
 module/ice-9/sports.scm |   23 ++++++++++++++++++++++-
 1 file changed, 22 insertions(+), 1 deletion(-)

diff --git a/module/ice-9/sports.scm b/module/ice-9/sports.scm
index 9341d0a..ac134bd 100644
--- a/module/ice-9/sports.scm
+++ b/module/ice-9/sports.scm
@@ -686,11 +686,32 @@
     (when (and (eqv? char #\newline) (port-line-buffered? port))
       (flush-output port))))
 
+(define accept
+  (let ((%accept (@ (guile) accept)))
+    (lambda (port)
+      (let lp ()
+        (or (%accept port)
+            (begin
+              (wait-for-readable port)
+              (lp)))))))
+
+(define connect
+  (let ((%connect (@ (guile) connect)))
+    (lambda (port sockaddr . args)
+      (unless (apply %connect port sockaddr args)
+        ;; Clownshoes semantics; see connect(2).
+        (wait-for-writable port)
+        (let ((err (getsockopt port SOL_SOCKET SO_ERROR)))
+          (unless (zero? err)
+            (scm-error 'system-error "connect" "~A"
+                       (list (strerror err)) #f)))))))
+
 (define saved-port-bindings #f)
 (define port-bindings
   '(((guile)
      read-char peek-char force-output close-port
-     put-char put-string)
+     put-char put-string
+     accept connect)
     ((ice-9 binary-ports)
      get-u8 lookahead-u8 get-bytevector-n
      put-u8 put-bytevector)