Update of /cvsroot/scsh/scsh-0.6/scsh
In directory usw-pr-cvs1:/tmp/cvs-serv28227/scsh
Modified Files:
newports.scm
Log Message:
Hand out the port and not just port-data to the handler.
Index: newports.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/newports.scm,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -r1.8 -r1.9
*** newports.scm 2001/03/25 17:14:31 1.8
--- newports.scm 2001/04/09 07:55:50 1.9
***************
*** 50,55 ****
;;; This applies to input- and output-ports
! (define (fdport-channel-ready? fdport*)
! (channel-ready? (fdport-data:channel fdport*)))
;Arbitrary, for now.
--- 50,55 ----
;;; This applies to input- and output-ports
! (define (fdport-channel-ready? fdport)
! (channel-ready? (fdport-data:channel (port-data fdport))))
;Arbitrary, for now.
***************
*** 178,181 ****
--- 178,185 ----
; That was easy.
+ (define (guess-output-policy port)
+ (if (= 0 (port-limit port))
+ bufpol/none
+ bufpol/block))
(define (set-port-buffering port policy . maybe-size)
***************
*** 519,525 ****
(vector-set! fdports old-fd #f)
(close-channel ch)
! (set-fdport-data:channel
fdport*
! ((if (input-port? port) make-input-fdchannel make-output-fdchannel) fd))
(vector-set! fdports fd old-vector-ref)
(%set-cloexec fd (not new-revealed)))
--- 523,529 ----
(vector-set! fdports old-fd #f)
(close-channel ch)
! (set-fdport-data:channel
fdport*
! (make-fd-channel port fd))
(vector-set! fdports fd old-vector-ref)
(%set-cloexec fd (not new-revealed)))
***************
*** 527,530 ****
--- 531,537 ----
#f) ; JMG: It used to return #f on succes in 0.5.1, so we do the same
+ (define (make-fd-channel port fd)
+ ((if (input-port? port) make-input-fdchannel make-output-fdchannel) fd))
+
(define (close-fdes fd)
(evict-ports fd)
***************
*** 675,676 ****
--- 682,743 ----
;;; 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
|