From fd69c408753cb5c9643070a794232e06d223fa00 Mon Sep 17 00:00:00 2001
From: marting <marting>
Date: Mon, 10 Jul 2000 18:01:53 +0000
Subject: [PATCH] made sockets non/blocking. accept adds a non-ready fd to
 vm-queue and waits. Copied from socket.c. Maybe connect has to follow.

---
 scsh/network.scm | 33 +++++++++++++++++++--------------
 scsh/network1.c  | 29 +++++++++++++++++++----------
 scsh/network1.h  |  2 +-
 3 files changed, 39 insertions(+), 25 deletions(-)

diff --git a/scsh/network.scm b/scsh/network.scm
index 08119e7..912d4b6 100644
--- a/scsh/network.scm
+++ b/scsh/network.scm
@@ -164,6 +164,8 @@
 	(let* ((fd  (%socket pf type protocol))
 	       (in  (make-input-fdport fd 0))
 	       (out (dup->outport in)))
+	  (set-fdes-status in open/non-blocking)
+	  (set-fdes-status out open/non-blocking)
 	  (make-socket pf in out)))))
 
 (define-foreign %socket/errno
@@ -262,22 +264,25 @@
   (if (not (socket? sock))
       (error "accept-connection: socket expected ~s" sock)
       (let* ((family (socket:family sock))
-	     (name   (make-addr family))
-	     (fd     (%accept (socket->fdes sock) family name))
-	     (in     (make-input-fdport fd 0))
-	     (out    (dup->outport in)))
-	(values (make-socket family in out)
-		(make-socket-address family name)))))
+	     (name   (make-addr family)))
+	(let loop ()
+	  ((structure-ref interrupts disable-interrupts!))
+	  (let ((maybe-fd (%accept (socket->fdes sock) family name)))
+	    (cond ((number? maybe-fd)
+		   (let ((fd maybe-fd))
+		     ((structure-ref interrupts 
+				     enable-interrupts!)) 
+		     (let* ((in     (make-input-fdport fd 0))
+			    (out    (dup->outport in)))
+		       (values (make-socket family in out)
+			       (make-socket-address family name)))))
+		  (else (wait-for-channel 
+			 (fdport-data:channel 
+			  (fdport-data (socket:inport sock)))) 
+			(loop))))))))
 
-(define-foreign %accept/errno
-  (scheme_accept (fixnum     sockfd)
-		 (fixnum     family)
-		 (string-desc name))
-  (multi-rep (to-scheme fixnum errno_or_false)
-             fixnum))
+(define-stubless-foreign %accept (sockfd family name) "scheme_accept")
 
-(define-errno-syscall (%accept sock family name) %accept/errno
-  sockfd)
 
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 ;;; getpeername syscall
diff --git a/scsh/network1.c b/scsh/network1.c
index f4f1c46..87c91fe 100644
--- a/scsh/network1.c
+++ b/scsh/network1.c
@@ -16,10 +16,10 @@
 #include <arpa/inet.h>
 #include <string.h>
 #include <stdio.h>
-
+#include <fcntl.h>
 /* Make sure our exports match up w/the implementation: */
 #include "network1.h"
-
+#include "scheme48.h"
 //extern int h_errno;
 
 /* to extract a 4 byte long value from a scheme string */
@@ -107,9 +107,10 @@ int scheme_connect(int sockfd, int family, s48_value scheme_name)
 }
 
 /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
-int scheme_accept(int sockfd, int family, s48_value scheme_name)
+s48_value scheme_accept(s48_value sockfd_tagged, s48_value family, s48_value scheme_name)
 {
-  switch(family)
+  int  sockfd = s48_extract_fixnum (sockfd_tagged);
+  switch(s48_extract_fixnum (family))
     {
     case AF_UNIX: 
       {
@@ -118,26 +119,34 @@ int scheme_accept(int sockfd, int family, s48_value scheme_name)
 	int newsockfd=accept(sockfd,(struct sockaddr *)&name,&namelen);
 
 	if (newsockfd < 0)
-	  return(-1);
+	  s48_raise_os_error(errno);
 
-	return(newsockfd);
+	return(s48_enter_fixnum (newsockfd));
 	break;
       }
     case AF_INET: 
       {
 	struct sockaddr_in name;
 	int namelen=sizeof(name);
-	int newsockfd=accept(sockfd,(struct sockaddr *)&name,&namelen);
+	int newsockfd;
+	newsockfd=accept (sockfd, (struct sockaddr *)&name,&namelen);
 	
 	if (newsockfd < 0)
-	  return(-1);
+	  {
+	    if ((errno != EWOULDBLOCK) && (errno != EINTR) && (errno != EAGAIN))
+	      s48_raise_os_error(errno);
+	    if (! s48_add_pending_fd(sockfd, 1))// 1 for is_input
+	      s48_raise_out_of_memory_error();
+	    return S48_FALSE;
+	  }
+	fcntl(newsockfd, F_SETFL, O_NONBLOCK);
 	SET_LONG(scheme_name,0,name.sin_addr.s_addr);
 	SET_LONG(scheme_name,1,htonl((u_long)ntohs(name.sin_port)));
-	return(newsockfd);
+	return s48_enter_fixnum (newsockfd);
 	break;
       }
     default:
-      return(-1);		/* error unknown address family */
+      s48_raise_argtype_error (family);	    /* error unknown address family */
     }
 }
 
diff --git a/scsh/network1.h b/scsh/network1.h
index 78730de..d6ecffc 100644
--- a/scsh/network1.h
+++ b/scsh/network1.h
@@ -4,7 +4,7 @@ int scheme_bind(int sockfd, int family, s48_value scheme_name);
 
 int scheme_connect(int sockfd, int family, s48_value scheme_name);
 
-int scheme_accept(int sockfd, int family, s48_value scheme_name);
+s48_value scheme_accept(s48_value sockfd, s48_value family, s48_value scheme_name);
 
 int scheme_peer_name(int sockfd, int family, s48_value scheme_name);