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