Assume there is always a first-running-thread. Punt checking.
authorMatt Birkholz <puck@birchwood-abbey.net>
Fri, 10 Jul 2015 03:12:45 +0000 (20:12 -0700)
committerMatt Birkholz <puck@birchwood-abbey.net>
Fri, 10 Jul 2015 03:12:45 +0000 (20:12 -0700)
src/runtime/thread.scm

index e947ae8b64a2f2e101392ca1685394c1d862e53b..89786f0407b5686f4cb35df34066b3ca09a58c24 100644 (file)
@@ -275,10 +275,7 @@ USA.
     thunk))
 \f
 (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)
 \f
 (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))))
 \f
 ;;;; 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)))))