More checking for no-current-thread.

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 4a9c511390a3b82194eb5692e477dc4eed6b2faf..71ecfe30f8823a2fabef563aae049b31c784b016 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -332,10 +332,10 @@ USA.
   (%unlock))
 
 (define (suspend-current-thread)
-  (without-interrupts
-   (lambda ()
-     (%lock)
-     (%suspend-thread first-running-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)
   (%assert-locked '%suspend-thread)
@@ -360,6 +360,7 @@ USA.
   (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)
@@ -418,8 +419,9 @@ USA.
 (define (yield-current-thread)
   (without-interrupts
    (lambda ()
+     (%lock)
      (let ((thread first-running-thread))
-       (%lock)
+       (%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)
@@ -467,7 +469,8 @@ USA.
 
 (define (join-thread thread event-constructor)
   (guarantee-thread thread 'JOIN-THREAD)
-  (let ((self (current-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)))
@@ -492,7 +495,8 @@ USA.
                   (set-interrupt-enables! mask)
                   (signal-thread-event
                    self
-                    (event-constructor thread value)))))))))
+                   ;; Executed in the dynamic state of SELF, not THREAD(!).
+                   (event-constructor thread value)))))))))
 
 (define (detach-thread thread)
   (guarantee-thread thread 'DETACH-THREAD)
@@ -870,6 +874,7 @@ USA.
   (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)))))
 
@@ -1186,7 +1191,9 @@ USA.
 (define (deregister-all-events)
   (with-thread-lock
    (lambda ()
-     (let* ((thread first-running-thread)
+     (let* ((thread
+            (or first-running-thread
+                (%outf-error "deregister-all-events: no current thread")))
            (block-events? (thread/block-events? thread)))
       (set-thread/block-events?! thread #t)
       (ring/discard-all (thread/pending-events thread))
@@ -1306,7 +1313,8 @@ USA.
   (guarantee-thread-mutex mutex 'LOCK-THREAD-MUTEX)
   (let ((mask (set-interrupt-enables! interrupt-mask/in-threads)))
     (%lock)
-    (let ((thread first-running-thread)
+    (let ((thread (or first-running-thread
+                     (%outf-error "lock-thread-mutex: no current thread")))
          (owner (thread-mutex/owner mutex)))
       (if (eq? owner thread)
          (begin
@@ -1334,8 +1342,10 @@ USA.
   (guarantee-thread-mutex mutex 'UNLOCK-THREAD-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))))
+    (let ((thread (or first-running-thread
+                   (%outf-error "unlock-thread-mutex: no current thread")))
+         (owner (thread-mutex/owner mutex)))
+      (if (and owner (not (eq? owner thread)))
          (begin
            (%unlock)
            (set-interrupt-enables! mask)
@@ -1363,7 +1373,9 @@ USA.
   (with-thread-lock
    (lambda ()
      (and (not (thread-mutex/owner mutex))
-         (let ((thread (current-thread)))
+         (let ((thread
+                (or first-running-thread
+                    (%outf-error "try-lock-thread-mutex: no current thread"))))
            (set-thread-mutex/owner! mutex thread)
            (add-thread-mutex! thread mutex)
            #t)))))