--- chicken-core/tcp.scm	2013-02-21 16:53:18.000000000 +0100
+++ chicken-askemos/tcp.scm	2013-03-11 21:31:19.000000000 +0100
@@ -1,6 +1,6 @@
 ;;;; tcp.scm - Networking stuff
 ;
-; Copyright (c) 2008-2013, The Chicken Team
+; Copyright (c) 2008-2012, The Chicken Team
 ; Copyright (c) 2000-2007, Felix L. Winkelmann
 ; All rights reserved.
 ;
@@ -50,6 +50,7 @@
 # ifndef EINPROGRESS
 #  define EINPROGRESS     0
 # endif
+# define EAGAIN          0
 # define typecorrect_getsockopt(socket, level, optname, optval, optlen)	\
     getsockopt(socket, level, optname, (char *)optval, optlen)
 #else
@@ -80,6 +81,9 @@
 #endif
 
 static char addr_buffer[ 20 ];
+
+#include <poll.h>
+
 EOF
 ) )
 
@@ -181,6 +185,8 @@
      if((se = getservbyname(serv, proto)) == NULL) C_return(0);
      else C_return(ntohs(se->s_port));") )     
 
+(cond-expand
+ (never
 (define ##net#select
   (foreign-lambda* int ((int fd))
     "fd_set in;
@@ -205,6 +211,18 @@
      if(rv > 0) { rv = FD_ISSET(fd, &out) ? 1 : 0; }
      C_return(rv);") )
 
+) (else
+
+(define ##net#select
+  (foreign-lambda* int ((int fd))
+		   "struct pollfd ps; ps.fd = fd; ps.events = POLLIN|POLLPRI;"
+		   "C_return(poll(&ps, 1, 0));"))
+(define ##net#select-write
+  (foreign-lambda* int ((int fd))
+		   "struct pollfd ps; ps.fd = fd; ps.events = POLLOUT;"
+		   "C_return(poll(&ps, 1, 0));"))
+))
+
 (define ##net#gethostaddr
   (foreign-lambda* bool ((scheme-pointer saddr) (c-string host) (unsigned-short port))
     "struct hostent *he = gethostbyname(host);"
@@ -353,7 +371,7 @@
 		(let loop ()
 		  (let ((n (##net#recv fd buf +input-buffer-size+ 0)))
 		    (cond ((eq? -1 n)
-			   (cond ((or (eq? errno _ewouldblock) 
+			   (cond ((or (eq? errno _ewouldblock)
 				      (eq? errno _eagain))
 				  (when tmr
 				    (##sys#thread-block-for-timeout! 
@@ -608,21 +626,26 @@
 	  (cond ((eq? errno _einprogress)
 		 (let loop2 ()
 		   (let ((f (##net#select-write s)))
-		     (when (eq? f -1) (fail))
-		     (unless (eq? f 1)
+		     (cond
+		      ((eq? f 1))	; done
+		      ((eq? f -1)
+		       (if (eq? errno _eintr)
+			   (##sys#dispatch-interrupt loop)
+			   (fail)))
+		      (else
 		       (when tmc
-			 (##sys#thread-block-for-timeout!
-			  ##sys#current-thread
-			  (+ (current-milliseconds) tmc) ) )
+			     (##sys#thread-block-for-timeout!
+			      ##sys#current-thread
+			      (+ (current-milliseconds) tmc) ) )
 		       (##sys#thread-block-for-i/o! ##sys#current-thread s #:all)
 		       (yield)
 		       (when (##sys#slot ##sys#current-thread 13)
-			 (##net#close s)
-			 (##sys#signal-hook
-			  #:network-timeout-error
-			  'tcp-connect
-			  "connect operation timed out" tmc s) )
-		       (loop2) ) ) ))
+			     (##net#close s)
+			     (##sys#signal-hook
+			      #:network-timeout-error
+			      'tcp-connect
+			      "connect operation timed out" tmc s) )
+			      (loop2) )) ) ))
 		((eq? errno _eintr)
 		 (##sys#dispatch-interrupt loop))
 		(else (fail) ) )))