n = SELECT_INTERRUPT;
}
UX_sigprocmask (SIG_SETMASK, &old, NULL);
- return (n);
- #else
- /* Wait-for-io must spin. */
- return
- ((OS_process_any_status_change ())
- ? SELECT_PROCESS_STATUS_CHANGE
- : SELECT_INTERRUPT);
+ #else /* not HAVE_SIGSUSPEND */
+ INTERRUPTABLE_EXTENT
+ (n, (((OS_process_any_status_change ())
+ || (pending_interrupts_p ()))
+ ? ((errno = EINTR), (-1))
+ : ((UX_pause ()), (0))));
+ if (OS_process_any_status_change())
+ n = SELECT_PROCESS_STATUS_CHANGE;
+ else
+ n = SELECT_INTERRUPT;
#endif
+ return (n);
}
+
+int
+OS_pause (int blockp)
+{
+ if (!blockp)
+ {
+ return ((OS_process_any_status_change ())
+ ? SELECT_PROCESS_STATUS_CHANGE
+ : SELECT_INTERRUPT);
+ }
+ else
+ return (safe_pause ());
+}
process))
(define (subprocess-delete process)
- (without-interrupts
- (lambda ()
- (if (subprocess-index process)
- (begin
- (remove-from-gc-finalizer! subprocess-finalizer process)
- (%close-subprocess-i/o process))))))
+ (if (subprocess-index process)
+ (begin
+ (poll-subprocess-status process)
+ (close-subprocess-i/o process)
+ (deregister-subprocess process)
+ (remove-from-gc-finalizer! subprocess-finalizer process))))
\f
- (define (subprocess-status process)
- (convert-subprocess-status (%subprocess-status process)))
-
(define (subprocess-wait process)
- (let loop ()
- (hook/subprocess-wait process)
- (let ((status (%subprocess-status process)))
- (if (eqv? status 0)
- (loop)
- (convert-subprocess-status status)))))
+ (let ((result #f)
+ (registration))
+ (dynamic-wind
+ (lambda ()
+ (set! registration
+ (register-subprocess-event
+ process 'RUNNING (current-thread)
+ (named-lambda (subprocess-wait-event status)
+ (set! result status)))))
+ (lambda ()
+ (let loop ()
+ (with-thread-events-blocked
+ (lambda ()
+ (if (eq? result '#f)
+ (suspend-current-thread))
+ (if (eq? result 'RUNNING)
+ (set! result #f))))
+ (if (not result)
+ (loop)
+ result)))
+ (lambda ()
+ (deregister-subprocess-event registration)))))
+(define (normal/subprocess-wait process)
+ ((ucode-primitive process-wait 1) (subprocess-index process)))
+
+(define (nonblocking/subprocess-wait process)
+ (without-interrupts
+ (lambda ()
+ (let ((status (%subprocess-status process)))
+ (if (eqv? status 0)
+ (block-on-process-status-change))))))
+
+(define hook/subprocess-wait normal/subprocess-wait)
+
(define (subprocess-continue-foreground process)
(let loop ()
((ucode-primitive process-continue-foreground 1)
prev
next)
- (define (initialize-io-blocking)
- (set! io-registry (and have-select? (make-select-registry)))
- (set! io-registrations #f)
- unspecific)
-
(define (wait-for-io)
(%maybe-toggle-thread-timer #f)
+ (%trace ";wait-for-io: next timeout = "next-scheduled-timeout"\n")
(let ((catch-errors
(lambda (thunk)
(let ((thread (console-thread)))