From e7460b6e74682bdca2b397834140acb7751344dc Mon Sep 17 00:00:00 2001
From: shivers <shivers>
Date: Thu, 26 Oct 1995 13:48:14 +0000
Subject: [PATCH] Completely rewrote the interface. - Added SELECT! procedure.
 - Fixed bug in SELECT -- it was side-effecting its parameters.

---
 scsh/select.c   |  26 ++++++++++--
 scsh/select.scm | 109 ++++++++++++++++++++++++++++++++++++------------
 scsh/select1.h  |  10 +++--
 3 files changed, 111 insertions(+), 34 deletions(-)

diff --git a/scsh/select.c b/scsh/select.c
index 38ba754..c8952b1 100644
--- a/scsh/select.c
+++ b/scsh/select.c
@@ -9,17 +9,35 @@
 /* Make sure foreign-function stubs interface to the C funs correctly: */
 #include "select1.h"
 
-scheme_value df_scm_select(long nargs, scheme_value *args)
+scheme_value df_select_copyback(long nargs, scheme_value *args)
 {
-    extern scheme_value scm_select(scheme_value , scheme_value , scheme_value , scheme_value , int *, int *, int *);
+    extern scheme_value select_copyback(scheme_value , scheme_value , scheme_value , scheme_value , int *, int *, int *);
     scheme_value ret1;
     scheme_value r1;
     int r2;
     int r3;
     int r4;
 
-    cig_check_nargs(5, nargs, "scm_select");
-    r1 = scm_select(args[4], args[3], args[2], args[1], &r2, &r3, &r4);
+    cig_check_nargs(5, nargs, "select_copyback");
+    r1 = select_copyback(args[4], args[3], args[2], args[1], &r2, &r3, &r4);
+    ret1 = r1;
+    VECTOR_REF(*args,0) = ENTER_FIXNUM(r2);
+    VECTOR_REF(*args,1) = ENTER_FIXNUM(r3);
+    VECTOR_REF(*args,2) = ENTER_FIXNUM(r4);
+    return ret1;
+    }
+
+scheme_value df_select_filter(long nargs, scheme_value *args)
+{
+    extern scheme_value select_filter(scheme_value , scheme_value , scheme_value , scheme_value , int *, int *, int *);
+    scheme_value ret1;
+    scheme_value r1;
+    int r2;
+    int r3;
+    int r4;
+
+    cig_check_nargs(5, nargs, "select_filter");
+    r1 = select_filter(args[4], args[3], args[2], args[1], &r2, &r3, &r4);
     ret1 = r1;
     VECTOR_REF(*args,0) = ENTER_FIXNUM(r2);
     VECTOR_REF(*args,1) = ENTER_FIXNUM(r3);
diff --git a/scsh/select.scm b/scsh/select.scm
index b4b1c88..dafe4f4 100644
--- a/scsh/select.scm
+++ b/scsh/select.scm
@@ -11,15 +11,28 @@
 ;;; The sets are vectors of file descriptors & fd ports.
 ;;; You get three new vectors back.
 
-(define (select read-set write-set exception-set . maybe-timeout)
-  (receive (errno rs ws es)
-           (apply select/errno read-set write-set exception-set maybe-timeout)
-     (if errno
-	 (apply errno-error errno select read-set write-set exception-set
-		maybe-timeout)
-	 (values rs ws es))))
+(define (select read-vec write-vec exception-vec . maybe-timeout)
+  (let ((rv (copy-vector read-vec))
+	(wv (copy-vector write-vec))
+	(ev (copy-vector exception-vec)))
+    (receive (nr nw ne) (apply select!/copyback rv wv ev maybe-timeout)
+      (values (vector-take rv nr)
+	      (vector-take wv nw)
+	      (vector-take ev ne)))))
 
-(define (select/errno read-set write-set exception-set . maybe-timeout)
+
+(define (select!/copyback read-vec write-vec exception-vec . maybe-timeout)
+  (receive (errno nr nw ne)
+           (apply select!/copyback/errno read-vec write-vec exception-vec
+		                         maybe-timeout)
+     (if errno
+	 (apply errno-error errno select!/copyback
+		read-vec write-vec exception-vec maybe-timeout)
+	 (values nr nw ne))))
+
+
+(define (select!/copyback/errno read-vec write-vec
+				exception-vec . maybe-timeout)
   (let ((timeout (optional-arg maybe-timeout #f))
 	(vec-ok? (lambda (v)
 		   (vector-every? (lambda (elt)
@@ -27,28 +40,25 @@
 					(fdport? elt)))
 				  v))))
     ;; Type-check input vectors.
-    (check-arg vec-ok?      read-set select/errno)
-    (check-arg vec-ok?     write-set select/errno)
-    (check-arg vec-ok? exception-set select/errno)
-    (check-arg (lambda (x) (or (not x) (integer? x))) timeout select/errno)
-	
+    (check-arg vec-ok?      read-vec select!/copyback/errno)
+    (check-arg vec-ok?     write-vec select!/copyback/errno)
+    (check-arg vec-ok? exception-vec select!/copyback/errno)
+    (check-arg (lambda (x) (or (not x) (integer? x))) timeout
+	       select!/copyback/errno)
+
     (let lp ()
-      (receive (errno rsize wsize esize)
-	       (%select/errno read-set write-set exception-set timeout)
-	(cond ((not errno)
-	       (values errno
-		       (vector-take read-set      rsize)
-		       (vector-take write-set     wsize)
-		       (vector-take exception-set esize)))
-	      ((= errno errno/intr) (lp))
-	      (else (values errno '#() '#() '#())))))))
+      (receive (errno nr nw ne)
+	       (%select/copyback/errno read-vec write-vec exception-vec timeout)
+	(if (and errno (= errno errno/intr))	; Retry on interrupts.
+	    (lp)
+	    (values errno nr nw ne))))))
 
 
-(define-foreign %select/errno
-  (scm_select (vector-desc rvec)
-	      (vector-desc wvec)
-	      (vector-desc evec)
-	      (desc nsecs))		; Integer or #f for infinity.
+(define-foreign %select/copyback/errno
+  (select_copyback (vector-desc rvec)
+		   (vector-desc wvec)
+		   (vector-desc evec)
+		   (desc nsecs))	; Integer or #f for infinity.
   desc		; errno or #f
   fixnum	; nread   - number of hits in RVEC
   fixnum	; nwrite  - number of hits in WVEC
@@ -61,3 +71,48 @@
 	((< i 0))
       (vector-set! short i (vector-ref vec i)))
     short))
+
+
+;;; SELECT!
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; The side-effecting variant. To be documented.
+
+(define (select! read-vec write-vec exception-vec . maybe-timeout)
+  (receive (errno nr nw ne)
+           (apply select!/errno read-vec write-vec exception-vec maybe-timeout)
+     (if errno
+	 (apply errno-error errno select! read-vec write-vec exception-vec
+		maybe-timeout)
+	 (values nr nw ne))))
+
+(define (select!/errno read-vec write-vec exception-vec . maybe-timeout)
+  (let ((timeout (optional-arg maybe-timeout #f))
+	(vec-ok? (lambda (v)
+		   (vector-every? (lambda (elt)
+				    (or (and (integer? elt) (>= elt 0))
+					(not elt)
+					(fdport? elt)))
+				  v))))
+    ;; Type-check input vectors.
+    (check-arg vec-ok?      read-vec select!/errno)
+    (check-arg vec-ok?     write-vec select!/errno)
+    (check-arg vec-ok? exception-vec select!/errno)
+    (check-arg (lambda (x) (or (not x) (integer? x))) timeout select!/errno)
+	
+    (let lp ()
+      (receive (errno nr nw ne)
+	       (%select!/errno read-vec write-vec exception-vec timeout)
+	(if (and errno (= errno errno/intr))	; Retry on interrupts.
+	    (lp)
+	    (values errno nr nw ne))))))
+
+
+(define-foreign %select!/errno
+  (select_filter (vector-desc rvec)
+		 (vector-desc wvec)
+		 (vector-desc evec)
+		 (desc nsecs))		; Integer or #f for infinity.
+  desc		; errno or #f
+  fixnum	; nread   - number of hits in RVEC
+  fixnum	; nwrite  - number of hits in WVEC
+  fixnum)	; nexcept - number of hits in EVEC
diff --git a/scsh/select1.h b/scsh/select1.h
index 43602ad..fde8bfb 100644
--- a/scsh/select1.h
+++ b/scsh/select1.h
@@ -1,5 +1,9 @@
 /* Exports from select1.c. */
 
-scheme_value scm_select(scheme_value rvec, scheme_value wvec,
-			scheme_value evec, scheme_value nsecs,
-			int *r_numrdy, int *w_numrdy, int *e_numrdy);
+scheme_value select_copyback(scheme_value rvec, scheme_value wvec,
+			     scheme_value evec, scheme_value nsecs,
+			     int *r_numrdy, int *w_numrdy, int *e_numrdy);
+
+scheme_value select_filter(scheme_value rvec, scheme_value wvec,
+			   scheme_value evec, scheme_value nsecs,
+			   int *r_numrdy, int *w_numrdy, int *e_numrdy);