(prompt-for-confirmation
"Restarting other thread; discard events in its queue")
discard-events?)))
- (with-thread-lock
- (lambda ()
- (if (not (eq? 'STOPPED (thread/execution-state thread)))
- (error:bad-range-argument thread restart-thread))
- (if discard-events? (ring/discard-all (thread/pending-events thread)))
- (if event (%signal-thread-event thread event))
- (thread-running thread)))))
+ (let ((mask (set-interrupt-enables! interrupt-mask/in-threads)))
+ (%lock)
+ (if (not (eq? 'STOPPED (thread/execution-state thread)))
+ (begin
+ (%unlock)
+ (set-interrupt-enables! mask)
+ (error:bad-range-argument thread restart-thread))
+ (begin
+ (if discard-events?
+ (ring/discard-all (thread/pending-events thread)))
+ (if event
+ (%signal-thread-event thread event))
+ (thread-running thread))))))
\f
(define (disallow-preempt-current-thread)
(set-thread/execution-state! (current-thread) 'RUNNING-WITHOUT-PREEMPTION))
;; Preserve the floating-point environment here to guarantee that the
;; thread timer won't raise or clear exceptions (particularly the
;; inexact result exception) that the interrupted thread cares about.
- (%lock)
(let ((fp-env (enter-default-float-environment first-running-thread)))
+ (%lock)
(set! next-scheduled-timeout #f)
(deliver-timer-events)
(maybe-signal-io-thread-events)
(let ((self (current-thread)))
(if (eq? thread self)
(signal-thread-deadlock self "join thread" join-thread thread)
- (without-interrupts
- (lambda ()
- (%lock)
- (let ((value (thread/exit-value thread)))
- (cond ((eq? value no-exit-value-marker)
- (set-thread/joined-threads!
- thread
- (cons (cons self event-constructor)
- (thread/joined-threads thread)))
- (set-thread/joined-to!
- self
- (cons thread (thread/joined-to self)))
- (%unlock))
- ((eq? value detached-thread-marker)
- (%unlock)
- (signal-thread-detached thread))
- (else
- (%unlock)
- (signal-thread-event
- self
- (event-constructor thread value))))))))))
+ (let ((mask (set-interrupt-enables! interrupt-mask/in-threads)))
+ (%lock)
+ (let ((value (thread/exit-value thread)))
+ (cond ((eq? value no-exit-value-marker)
+ (set-thread/joined-threads!
+ thread
+ (cons (cons self event-constructor)
+ (thread/joined-threads thread)))
+ (set-thread/joined-to!
+ self
+ (cons thread (thread/joined-to self)))
+ (%unlock)
+ (set-interrupt-enables! mask))
+ ((eq? value detached-thread-marker)
+ (%unlock)
+ (set-interrupt-enables! mask)
+ (signal-thread-detached thread))
+ (else
+ (%unlock)
+ (set-interrupt-enables! mask)
+ (signal-thread-event
+ self
+ (event-constructor thread value)))))))))
(define (detach-thread thread)
(guarantee-thread thread 'DETACH-THREAD)
- (without-interrupts
- (lambda ()
- (%lock)
- (if (eq? (thread/exit-value thread) detached-thread-marker)
- (begin
- (%unlock)
- (signal-thread-detached thread))
- (begin
- (release-joined-threads thread detached-thread-marker)
- (%unlock)))))
+ (let ((mask (set-interrupt-enables! interrupts-mask/in-threads)))
+ (%lock)
+ (if (eq? (thread/exit-value thread) detached-thread-marker)
+ (begin
+ (%unlock)
+ (set-interrupt-enables! mask)
+ (signal-thread-detached thread))
+ (begin
+ (release-joined-threads thread detached-thread-marker)
+ (%unlock)
+ (set-interrupt-enables! mask))))
thread)
(define detached-thread-marker
(if (eq? 'DEAD (thread/execution-state thread))
(signal-thread-dead thread "signal event to"
signal-thread-event thread event))
- (without-interrupts
- (lambda ()
- (%lock)
- (%signal-thread-event thread event)
- (if (and (not self) first-running-thread)
- (run-thread first-running-thread)
- (begin
- (%maybe-toggle-thread-timer)
- (%unlock)))))))))
+ (let ((mask (set-interrupt-enables! interrupt-mask/in-threads)))
+ (%lock)
+ (%signal-thread-event thread event)
+ (if (and (not self) first-running-thread)
+ (run-thread first-running-thread)
+ (begin
+ (%maybe-toggle-thread-timer)
+ (%unlock)
+ (set-interrupt-enables! mask))))))))
(define (%signal-thread-event thread event)
(%assert-locked '%signal-thread-event)
(define (lock-thread-mutex mutex)
(guarantee-thread-mutex mutex 'LOCK-THREAD-MUTEX)
- (if (with-thread-lock
- (lambda ()
- (let ((thread first-running-thread)
- (owner (thread-mutex/owner mutex)))
- (if (eq? owner thread)
- #t
- (begin
- (%lock-thread-mutex mutex thread owner)
- #f)))))
- (signal-thread-deadlock first-running-thread "lock thread mutex"
- lock-thread-mutex mutex)))
+ (let ((mask (set-interrupt-enables! interrupt-mask/in-threads)))
+ (%lock)
+ (let ((thread first-running-thread)
+ (owner (thread-mutex/owner mutex)))
+ (if (eq? owner thread)
+ (begin
+ (%unlock)
+ (set-interrupt-enables! mask)
+ (signal-thread-deadlock first-running-thread "lock thread mutex"
+ lock-thread-mutex mutex))
+ (begin
+ (%lock-thread-mutex mutex thread owner)
+ (%unlock)
+ (set-interrupt-enables! mask))))))
(define (%lock-thread-mutex mutex thread owner)
(%assert-locked '%lock-thread-mutex)
(define (unlock-thread-mutex mutex)
(guarantee-thread-mutex mutex 'UNLOCK-THREAD-MUTEX)
- (if (with-thread-lock
- (lambda ()
- (let ((owner (thread-mutex/owner mutex)))
- (if (and owner (not (eq? owner (current-thread))))
- #t
- (begin
- (%unlock-thread-mutex mutex owner)
- #f)))))
- (error "Don't own mutex:" mutex)))
+ (let ((mask (set-interrupt-enables! interrupt-mask/in-threads)))
+ (%lock)
+ (let ((owner (thread-mutex/owner mutex)))
+ (if (and owner (not (eq? owner (current-thread))))
+ (begin
+ (%unlock)
+ (set-interrupt-enables! mask)
+ (error "Don't own mutex:" mutex))
+ (begin
+ (%unlock-thread-mutex mutex owner)
+ (%unlock)
+ (set-interrupt-enables! mask))))))
(define (%unlock-thread-mutex mutex owner)
(%assert-locked '%unlock-thread-mutex)
(lambda () (unlock-thread-mutex mutex))))
(define (without-thread-mutex-lock mutex thunk)
- (guarantee-thread-mutex mutex 'WITH-THREAD-MUTEX-LOCK)
+ (guarantee-thread-mutex mutex 'WITHOUT-THREAD-MUTEX-LOCK)
(dynamic-wind (lambda () (unlock-thread-mutex mutex))
thunk
(lambda () (lock-thread-mutex mutex))))
projects / mit-scheme.git / commitdiff