(%suspend-current-thread)
result)
(lambda ()
- (%deregister-io-thread-event registration-2)
- (%deregister-io-thread-event registration-1)
+ (%maybe-deregister-io-thread-event registration-2)
+ (%maybe-deregister-io-thread-event registration-1)
(%maybe-toggle-thread-timer)))))))
+ (define (%maybe-deregister-io-thread-event tentry)
+ ;; Ensure that another thread does not unwind our registration.
+ (if (eq? (current-thread) (tentry/thread tentry))
+ (delete-tentry! tentry)))
++
+(define (block-on-process-status-change)
+ (without-interrupts
+ (lambda ()
+ (let ((registration))
+ (dynamic-wind
+ (lambda ()
+ (let ((thread (current-thread)))
+ (set! registration
+ (%register-io-thread-event
+ 'PROCESS-STATUS-CHANGE
+ 'READ
+ thread
+ (lambda (mode)
+ (declare (ignore mode))
+ unspecific)
+ #f #t)))
+ (%maybe-toggle-thread-timer))
+ (lambda ()
+ (%suspend-current-thread))
+ (lambda ()
+ (%deregister-io-thread-event registration)
+ (%maybe-toggle-thread-timer)))))))
\f
(define (permanently-register-io-thread-event descriptor mode thread event)
(register-io-thread-event-1 descriptor mode thread event