refactored nonblocking code in ikarus-io.c and ikarus.io.ss

lab/tcp-connect-nonblocking-example.ss

@@ -15,6 +15,7 @@
   (with-exception-handler
     (lambda (c)
       ;;; just return and let it retry until it succeeds
+      (print-condition c)
       (unless (i/o-would-block-condition? c)
         (raise c)))
     (lambda ()

scheme/ikarus.io.ss

@@ -2054,7 +2054,7 @@
                 cmd input-file-buffer-size #f #t
                 'process)))))
 
-  (define (socket->ports socket who id)
+  (define (socket->ports socket who id block?)
     (if (< socket 0)
         (io-error who id socket)
         (let ([close
@@ -2063,6 +2063,10 @@
                    (if closed-once?
                        ((file-close-proc id socket))
                        (set! closed-once? #t))))])
+          (unless block?
+            (let ([rv (foreign-call "ikrt_make_fd_nonblocking" socket)])
+              (unless (eq? rv 0) 
+                (io-error who id socket))))
           (values 
             (fh->output-port socket
                id output-file-buffer-size #f close who)
@@ -2071,7 +2075,7 @@
 
   (define-syntax define-connector 
     (syntax-rules ()
-      [(_ who foreign-name)
+      [(_ who foreign-name block?)
        (define (who host srvc)
          (unless (and (string? host) (string? srvc))
            (die 'who "host and service must both be strings" host srvc))
@@ -2079,12 +2083,13 @@
            (foreign-call foreign-name
              (string->utf8 host) (string->utf8 srvc))
            'who
-           (string-append host ":" srvc)))]))
+           (string-append host ":" srvc)
+           block?))]))
 
-  (define-connector tcp-connect             "ikrt_tcp_connect")
-  (define-connector udp-connect             "ikrt_udp_connect")
-  (define-connector tcp-connect-nonblocking "ikrt_tcp_connect_nonblocking")
-  (define-connector udp-connect-nonblocking "ikrt_udp_connect_nonblocking")
+  (define-connector tcp-connect             "ikrt_tcp_connect" #t)
+  (define-connector udp-connect             "ikrt_udp_connect" #t)
+  (define-connector tcp-connect-nonblocking "ikrt_tcp_connect" #f)
+  (define-connector udp-connect-nonblocking "ikrt_udp_connect" #f)
 
   )
 

scheme/last-revision

@@ -1 +1 @@
-1418
+1420

src/ikarus-io.c

@@ -32,9 +32,9 @@
 ikptr 
 ikrt_io_error(){
   int err = errno;
-//#if 0
+#if 0
   fprintf(stderr, "errno=%d %s\n", err, strerror(err));
-//#endif
+#endif
   switch(err){
     case EBADF           : return fix(-2);
     case EINTR           : return fix(-3);
@@ -191,31 +191,16 @@ ikrt_udp_connect(ikptr host, ikptr srvc, ikpcb* pcb){
   return do_connect(host, srvc, SOCK_DGRAM);
 }
 
-static ikptr
-do_unblock(ikptr fdptr){
+ikptr 
+ikrt_make_fd_nonblocking(ikptr fdptr, ikpcb* pcb){
   int fd = unfix(fdptr);
-  if(fd >= 0){
-    /* connected alright */
-    int err = fcntl(fd, F_SETFL, O_NONBLOCK);
-    if(err == -1){
-      ikptr errptr = ikrt_io_error();
-      close(fd);
-      return errptr;
-    }
+  int err = fcntl(fd, F_SETFL, O_NONBLOCK);
+  if(err == -1){
+    return ikrt_io_error();
   }
-  return fdptr;
+  return 0;
 }
 
-ikptr
-ikrt_tcp_connect_nonblocking(ikptr host, ikptr srvc, ikpcb* pcb){
-  return do_unblock(ikrt_tcp_connect(host, srvc, pcb));
-}
-
-ikptr
-ikrt_udp_connect_nonblocking(ikptr host, ikptr srvc, ikpcb* pcb){
-  return do_unblock(ikrt_udp_connect(host, srvc, pcb));
-}
-  
 
 ikptr
 ikrt_file_ctime(ikptr filename, ikptr res){