diff --git a/scheme/rts/channel-io.scm b/scheme/rts/channel-io.scm index 850aae4..3f24ae3 100644 --- a/scheme/rts/channel-io.scm +++ b/scheme/rts/channel-io.scm @@ -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!))))