Added SELECT-PORT-CHANNELS.

RELEASE

@@ -188,9 +188,9 @@ We manage the project using SourceForge:
    checksums.
 
 ** API changes
-   select and select! are supported again.  Note however, that we
-   recommend to use the new select-ports procedure instead whenever
-   possible.
+   select and select! are supported again.
+   Note however, that we recommend to use the new select-ports and
+   select-port-channels procedures instead whenever possible.
    New interface to the uname function.
    New direct interface to the directory stream operations
    New structure scheme-with-scsh which combines the exports of the

doc/scsh-manual/syscalls.tex

@@ -837,22 +837,24 @@ Returns two ports, the read and write end-points of a {\Unix} pipe.
       that send requests to multiple alternate servers and discard all
       but one of them.
       
-      In any case, the \texttt{select-ports} procedure described below
-      is usually a preferable alternative to
-      \texttt{select}/\texttt{select!}: it is much simpler to use, and
-      also has a slightly more efficient implementation.}
+      In any case, the \texttt{select-ports} and
+      \texttt{select-port-channels} procedures described below
+      are usually a preferable alternative to
+      \texttt{select}/\texttt{select!}: they are much simpler to use, and
+      also have a slightly more efficient implementation.}
 \end{desc}
 
 \defun {select-ports}{timeout port \ldots}{ready-ports}
 \begin{desc}
-  The \ex{select-ports} call will block until at least one of the ports
-  passed to it is ready for operation.  For an input port this means
-  that it either has data sitting its buffer or that the underlying
-  file descriptor has data waiting.  For an output port this means
-  that it either has space available in the associated buffer or that
-  the underlying file descriptor can accept output.
+  The \ex{select-ports} call will block until at least one of the
+  ports passed to it is ready for operation or until the timeout has
+  expired.  For an input port this means that it either has data
+  sitting its buffer or that the underlying file descriptor has data
+  waiting.  For an output port this means that it either has space
+  available in the associated buffer or that the underlying file
+  descriptor can accept output.
     
-  The \var{timeout} value can be used to force the call to time-out
+  The \var{timeout} value can be used to force the call to time out
   after a given number of seconds.  A value of \ex{\#f} means to wait
   indefinitely.  A zero value can be used to poll the ports.
 
@@ -861,6 +863,23 @@ Returns two ports, the read and write end-points of a {\Unix} pipe.
   before any ports became ready.
 \end{desc}
 
+\defun {select-port-channels}{timeout port \ldots}{ready-ports}
+\begin{desc}
+  \texttt{Select-port-channels} is like \texttt{select-ports}, except
+  that it only looks at the operating system objects the ports refer
+  to, ignoring any buffering performed by the ports.
+
+  \remark{\texttt{Select-port-channels} should be used with care: for
+    example, if an input port has data in the buffer but no data
+    available on the underlying file descriptor,
+    \texttt{select-port-channels} will block, even though a read
+    operation on the port would be able to complete without blocking.
+    
+    \texttt{Select-port-channels} is intended for situations where the
+    program is not checking for available data, but rather for waiting
+    until a port has established a connection---for example, to a
+    network port.}
+\end{desc}
 
 \begin{defundescx}{write-string}{string [fd/port start end]}\undefined
     This procedure writes all the data requested. 

scsh/newports.scm

@@ -949,7 +949,6 @@
 
 		 (values n-read-ready n-write-ready 0)))))))))
 
-
 (define (select-ports timeout . ports)
   (let ((read-list (filter input-port? ports))
 	(write-list (filter output-port? ports)))
@@ -967,31 +966,46 @@
 	    ((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)))
+	  (really-select-port-channels timeout read-list write-list)))))
 
-	    (for-each (lambda (channel)
-			(add-pending-channel channel #t))
-		      read-channels)
+(define (select-port-channels timeout . ports)
+  (let ((read-list (filter input-port? ports))
+	(write-list (filter output-port? ports)))
 
-	    (for-each (lambda (channel)
-			(add-pending-channel channel #f))
-		      write-channels)
+    ((structure-ref interrupts disable-interrupts!))
+    
+    (for-each input-port/fdes-check-unlocked read-list)
+    (for-each output-port/fdes-check-unlocked write-list)
 
-	    (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)))))))))
+    (really-select-port-channels timeout read-list write-list)))
+
+;; assumes interrupts are disabled and that ports aren't locked
+
+(define (really-select-port-channels timeout read-list write-list)
+  (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

@@ -221,7 +221,7 @@
 			      read-string!/partial
 
 			      select select!
-			      select-ports
+			      select-ports select-port-channels
 
 			      (write-string (proc (:string &opt :value :exact-integer :exact-integer) :unspecific))
 			      write-string/partial)))