Add WAIT-PORTS.

scsh/newports.scm

@@ -949,3 +949,49 @@
 
 		 (values n-read-ready n-write-ready 0)))))))))
 
+
+(define (wait-ports timeout . ports)
+  (let ((read-list (filter input-port? ports))
+	(write-list (filter output-port? ports)))
+
+    ((structure-ref interrupts disable-interrupts!))
+    
+    (for-each input-port/fdes-check-unlocked read-list)
+    (for-each output-port/fdes-check-unlocked write-list)
+
+    (let ((any-read (any-input-ready read-list))
+	  (any-write (any-output-ready write-list)))
+
+      (if (or (pair? any-read) (pair? any-write))
+	  (begin
+	    ((structure-ref interrupts enable-interrupts!))
+	    (append any-read any-write))
+	    
+	  ;; we need to block
+	  (let ((read-channels (map port/fdes->input-channel read-list))
+		(write-channels (map port/fdes->output-channel write-list)))
+
+	    (for-each (lambda (channel)
+			(add-pending-channel channel #t))
+		      read-channels)
+
+	    (for-each (lambda (channel)
+			(add-pending-channel channel #f))
+		      write-channels)
+
+	    (call-with-values
+	     (lambda ()
+	       (wait-for-channels read-channels write-channels timeout))
+	     ;; re-enables interrupts
+	     (lambda (ready-read-channels ready-write-channels)
+	       (append (filter (lambda (read-port)
+				 (any (lambda (read-channel)
+					(eq? read-channel
+					     (port/fdes->input-channel read-port)))
+				      ready-read-channels))
+			       read-list)
+		       (filter (lambda (write-port)
+				 (any (lambda (write-channel)
+					(eq? write-channel
+					     (port/fdes->output-channel write-port)))))
+			       write-list)))))))))

scsh/scsh-interfaces.scm

@@ -140,9 +140,6 @@
 			      seek/delta
 			      seek/end
 
-;			      select
-;			      select!
-
 			      flush-all-ports
 			      flush-all-ports-no-threads
 			      y-or-n?
@@ -224,6 +221,7 @@
 			      read-string!/partial
 
 			      select select!
+			      wait-ports
 
 			      (write-string (proc (:string &opt :value :exact-integer :exact-integer) :unspecific))
 			      write-string/partial)))

scsh/scsh-package.scm

@@ -187,7 +187,7 @@
 	bitwise
 	signals
 	conditions
-	(subset srfi-1 (filter reverse! fold delete))
+	(subset srfi-1 (filter reverse! fold delete any))
 	scsh-utilities
 	handle
 	fluids thread-fluids
@@ -252,7 +252,6 @@
 	  scheme)	; For accessing the normal I/O operators.
   (files syntax
 	 syscalls
-;	 select
 	 fname
 	 rw
 	 newports