From 4efe1a4cd89eceb391a44ad6a0a72b51f821f210 Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Thu, 21 Feb 2002 06:55:37 +0000
Subject: [PATCH] + Use S48's nonblocking facility to flush the ports + Deleted
 bogus select implementation

---
 scsh/newports.scm | 68 +++++------------------------------------------
 1 file changed, 6 insertions(+), 62 deletions(-)

diff --git a/scsh/newports.scm b/scsh/newports.scm
index b73e63e..bddd926 100644
--- a/scsh/newports.scm
+++ b/scsh/newports.scm
@@ -541,10 +541,12 @@
   (force-output fdport))
 
 (define (flush-all-ports)
-  (weak-table-walk
-   (lambda (i fdport)
-     (if (and fdport (open-output-port? fdport)) (flush-fdport fdport)))
-   fdports))
+  (let ((thunks (output-port-forcers #f)))
+    (cond ((null? thunks)
+	   #f)
+	  (else
+	   (for-each (structure-ref threads spawn) thunks)
+	   #t))))
 
 ;;; Extend R4RS i/o ops to handle file descriptors.
 ;;; -----------------------------------------------
@@ -695,63 +697,5 @@
       (let-fluid $current-output-port port thunk))))
 
 ;;; replace rts/channel-port.scm end
-
-
-
-(define (nselect rvec wvec evec timeout)
-  (let ((rlist (vector->list rvec))
-	(wlist (vector->list wvec)))
-    (let ((imm-r (filter char-ready? rlist))
-	  (imm-w (filter output-port-ready? wlist)))
-      (if (and (null? imm-r)
-	       (null? imm-w))
-	  (select-threaded rlist wlist timeout)
-	  (values (list->vector imm-r)
-		  (list->vector imm-w)
-		  '#())))))
-
-(define (timeout-thread result-lock timeout)
-  (lambda ()
-    ((structure-ref threads sleep) timeout)
-    (release-lock result-lock)))
-
-(define (select-threaded rlist wlist timeout)
-  (let ((result-lock (make-lock))
-	(ready-lock (make-lock))
-	(read-ready (cons 'cell '()))
-	(write-ready (cons 'cell '()))
-	(are-we-ready? #f))
-    (let* ((port-waiter
-	    (lambda (ready? ready-list)
-	      (lambda (port)
-		(lambda ()
-;		  ((structure-ref interrupts disable-interrupts!))
-;		  (if (ready? port)
-;		      ((structure-ref interrupts enable-interrupts!))
-;		      (wait-for-channel ; enables interrupts
-;		       (fdport-data:channel 
-;			(fdport-data port))))
-		  (let lp ()
-		    (if (ready? port)
-			(begin 
-			  (obtain-lock ready-lock)
-			  (set-cdr! ready-list (cons port (cdr ready-list)))
-			  (release-lock ready-lock)
-			  (release-lock result-lock))
-			(if (not are-we-ready?)
-			    (begin ((structure-ref threads sleep) 20)
-				   (lp)))))))))
-	   (read-waiter (port-waiter char-ready? read-ready))
-	   (write-waiter (port-waiter output-port-ready? write-ready)))
-      (obtain-lock result-lock)
-      (for-each spawn (map read-waiter rlist))
-      (for-each spawn (map write-waiter wlist))
-      (if timeout (spawn (timeout-thread result-lock timeout)))
-      (obtain-lock result-lock)
-      (set! are-we-ready? #t)
-;      (relinquish-timeslice) 
-      (values (cdr read-ready)
-	      (cdr write-ready)
-	      '#()))))
 	  
     
\ No newline at end of file