From 844fdd84452e5e4e4936ca37d9816bc5f820f344 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Thu, 9 Jul 2015 20:12:45 -0700 Subject: [PATCH] Assume there is always a first-running-thread. Punt checking. --- src/runtime/thread.scm | 111 +++++++++++++++-------------------------- 1 file changed, 39 insertions(+), 72 deletions(-) diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm index e947ae8b6..89786f040 100644 --- a/src/runtime/thread.scm +++ b/src/runtime/thread.scm @@ -275,10 +275,7 @@ USA. thunk)) (define (current-thread) - (or first-running-thread - (begin - (%outf-error "current-thread: no current thread") - #f))) + first-running-thread) (define (console-thread) (thread-mutex-owner (port/thread-mutex console-i/o-port))) @@ -345,7 +342,6 @@ USA. (define (suspend-current-thread) (set-interrupt-enables! interrupt-mask/in-threads) (%lock) - (%assert first-running-thread "suspend-current-thread: no current thread") (%suspend-thread first-running-thread)) (define (%suspend-thread thread) @@ -367,11 +363,9 @@ USA. (thread-not-running thread 'WAITING))))))) (define (stop-current-thread) - (%assert first-running-thread "stop-current-thread: no current thread") (call-with-current-continuation (lambda (continuation) (let ((thread first-running-thread)) - (%assert thread "stop-current-thread: lost current thread") (set-thread/continuation! thread continuation) (maybe-save-thread-float-environment! thread) (set-interrupt-enables! interrupt-mask/in-threads) @@ -432,7 +426,6 @@ USA. (lambda () (%lock) (let ((thread first-running-thread)) - (%assert thread "yield-current-thread: no current thread") ;; Allow preemption now, since the current thread has ;; volunteered to yield control. (set-thread/execution-state! thread 'RUNNING) @@ -481,7 +474,6 @@ USA. (define (join-thread thread event-constructor) (guarantee-thread thread 'JOIN-THREAD) (let ((self first-running-thread)) - (%assert self "join-thread: no current thread") (if (eq? thread self) (signal-thread-deadlock self "join thread" join-thread thread) (let ((mask (set-interrupt-enables! interrupt-mask/in-threads))) @@ -874,18 +866,15 @@ USA. (define (block-thread-events) (with-thread-lock (lambda () - (let ((thread first-running-thread)) - (if thread - (let ((result (thread/block-events? thread))) - (set-thread/block-events?! thread #t) - result) - #f))))) + (let* ((thread first-running-thread) + (result (thread/block-events? thread))) + (set-thread/block-events?! thread #t) + result)))) (define (unblock-thread-events) (with-thread-lock (lambda () (let ((thread first-running-thread)) - (%assert thread "unblock-thread-events: no current thread") (handle-thread-events thread) (set-thread/block-events?! thread #f))))) @@ -901,46 +890,34 @@ USA. value))) (define (get-thread-event-block) - (let ((thread first-running-thread)) - (if thread - (thread/block-events? thread) - (begin - (%outf-error "get-thread-event-block: no current thread") - #f)))) + (thread/block-events? first-running-thread)) (define (set-thread-event-block! block?) - (let ((thread first-running-thread)) - (if thread - (set-thread/block-events?! thread block?) - (%outf-error "set-thread-event-block!: no current thread"))) + (set-thread/block-events?! first-running-thread block?) unspecific) (define (signal-thread-event thread event) (guarantee-thread thread 'SIGNAL-THREAD-EVENT) - (let ((self first-running-thread)) - (if (eq? thread self) - (let ((block-events? (block-thread-events))) - (with-thread-lock - (lambda () - (%add-pending-event thread event))) - (if (not block-events?) - (unblock-thread-events))) - (let ((mask (set-interrupt-enables! interrupt-mask/in-threads))) - (%lock) - (if (eq? 'DEAD (thread/execution-state thread)) - (begin - (%unlock) - (set-interrupt-enables! mask) - (signal-thread-dead thread "signal event to" - signal-thread-event thread event)) - (begin - (%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))))))))) + (if (eq? thread first-running-thread) + (let ((block-events? (block-thread-events))) + (with-thread-lock + (lambda () + (%add-pending-event thread event))) + (if (not block-events?) + (unblock-thread-events))) + (let ((mask (set-interrupt-enables! interrupt-mask/in-threads))) + (%lock) + (if (eq? 'DEAD (thread/execution-state thread)) + (begin + (%unlock) + (set-interrupt-enables! mask) + (signal-thread-dead thread "signal event to" + signal-thread-event thread event)) + (begin + (%signal-thread-event thread event) + (%maybe-toggle-thread-timer) + (%unlock) + (set-interrupt-enables! mask)))))) (define (%signal-thread-event thread event) (%assert-locked '%signal-thread-event) @@ -985,17 +962,13 @@ USA. (define (allow-thread-event-delivery) (with-thread-lock (lambda () - (let ((thread first-running-thread)) - (if thread - (let ((block-events? (thread/block-events? thread))) - (set-thread/block-events?! thread #f) - (deliver-timer-events) - (maybe-signal-io-thread-events) - (handle-thread-events thread) - (set-thread/block-events?! thread block-events?)) - (begin - (deliver-timer-events) - (maybe-signal-io-thread-events)))) + (let* ((thread first-running-thread) + (block-events? (thread/block-events? thread))) + (set-thread/block-events?! thread #f) + (deliver-timer-events) + (maybe-signal-io-thread-events) + (handle-thread-events thread) + (set-thread/block-events?! thread block-events?)) (%maybe-toggle-thread-timer)))) ;;;; GC Events @@ -1202,9 +1175,7 @@ USA. (define (deregister-all-events) (with-thread-lock (lambda () - (let* ((thread - (or first-running-thread - (%outf-error "deregister-all-events: no current thread"))) + (let* ((thread first-running-thread) (block-events? (thread/block-events? thread))) (set-thread/block-events?! thread #t) (ring/discard-all (thread/pending-events thread)) @@ -1324,14 +1295,13 @@ USA. (guarantee-thread-mutex mutex 'LOCK-THREAD-MUTEX) (let ((mask (set-interrupt-enables! interrupt-mask/in-threads))) (%lock) - (let ((thread (or first-running-thread - (%outf-error "lock-thread-mutex: no current thread"))) + (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" + (signal-thread-deadlock thread "lock thread mutex" lock-thread-mutex mutex)) (begin (%lock-thread-mutex mutex thread owner) @@ -1353,8 +1323,7 @@ USA. (guarantee-thread-mutex mutex 'UNLOCK-THREAD-MUTEX) (let ((mask (set-interrupt-enables! interrupt-mask/in-threads))) (%lock) - (let ((thread (or first-running-thread - (%outf-error "unlock-thread-mutex: no current thread"))) + (let ((thread first-running-thread) (owner (thread-mutex/owner mutex))) (if (and owner (not (eq? owner thread))) (begin @@ -1384,9 +1353,7 @@ USA. (with-thread-lock (lambda () (and (not (thread-mutex/owner mutex)) - (let ((thread - (or first-running-thread - (%outf-error "try-lock-thread-mutex: no current thread")))) + (let ((thread first-running-thread)) (set-thread-mutex/owner! mutex thread) (add-thread-mutex! thread mutex) #t))))) -- 2.25.1