scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix some problems with WAIT-FOR-CHANNELS: 

- Initialize READY-{READ,WRITE}-CHANNELS to () instead of #f, because
  the #f's don't get overwritten when the whole thing is interrupted.
- Fix the cleanup code which was conditionalized the wrong way.
This commit is contained in:
sperber 2003-01-17 13:30:26 +00:00
parent c0cccd7c7a
commit ad18648afa
1 changed files with 26 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
scheme/rts/channel-io.scm
View File

@ -84,14 +84,14 @@
(dynamic-wind nothing (dynamic-wind nothing
block block
(lambda () (lambda ()
(disable-interrupts!) (with-interrupts-inhibited
(if (cell-ref cell) (lambda ()
;; we're being terminated (if (cell-ref cell)
(begin ;; we're being terminated
(fetch-channel-wait-cell! channel) (begin
(channel-abort channel) (fetch-channel-wait-cell! channel)
(wait-for-channel channel))) (channel-abort channel)
(enable-interrupts!)))))))) (wait-for-channel channel))))))))))))
(define (nothing) #f) (define (nothing) #f)
@ -108,8 +108,8 @@
(let ((thread-cell (make-cell (current-thread))) (let ((thread-cell (make-cell (current-thread)))
(ready-channels-cell (make-cell (cons '() '()))) (ready-channels-cell (make-cell (cons '() '())))
(ready-read-channels #f) (ready-read-channels '())
(ready-write-channels #f)) (ready-write-channels '()))
(if (or (not timeout) (if (or (not timeout)
(register-dozer thread-cell timeout)) (register-dozer thread-cell timeout))
@ -138,23 +138,22 @@
;; clean up ;; clean up
(lambda () (lambda ()
(let ((aborting? (and (cell-ref thread-cell) #t))) (let ((aborting? (and (cell-ref thread-cell) #t)))
(disable-interrupts!) (with-interrupts-inhibited
;; this ain't so great ... (lambda ()
(let ((make-cleanup ;; this ain't so great ...
(lambda (ready-channels) (let ((make-cleanup
(lambda (channel) (lambda (ready-channels)
(if (memq channel ready-channels) (lambda (channel)
(begin (if (not (memq channel ready-channels))
(fetch-channel-wait-cell! channel) (begin
(if (not aborting?) (fetch-channel-wait-cell! channel)
(decrement-channel-wait-count!) (if (not aborting?)
(begin (decrement-channel-wait-count!)
(channel-abort channel) (begin
(wait-for-channel channel))))))))) (channel-abort channel)
(for-each (make-cleanup ready-read-channels) read-channels) (wait-for-channel channel)))))))))
(for-each (make-cleanup ready-write-channels) write-channels)) (for-each (make-cleanup ready-read-channels) read-channels)
(for-each (make-cleanup ready-write-channels) write-channels))))))))
(enable-interrupts!)))))
;; the timeout was zero or less ;; the timeout was zero or less
(enable-interrupts!)))) (enable-interrupts!))))