Remove call-with-current-thread.
authorMatt Birkholz <puck@birchwood-abbey.net>
Thu, 9 Jul 2015 06:29:09 +0000 (23:29 -0700)
committerMatt Birkholz <puck@birchwood-abbey.net>
Thu, 9 Jul 2015 06:29:09 +0000 (23:29 -0700)
src/runtime/thread.scm

index a05a3acda9302b11b1176f3237d38283e6099801..4a9c511390a3b82194eb5692e477dc4eed6b2faf 100644 (file)
@@ -269,16 +269,6 @@ USA.
        (%outf-error "current-thread: no current thread")
        #f)))
 
-(define (call-with-current-thread return? procedure)
-  (%assert (interrupt-mask-ok?)
-          "call-with-current-thread: wrong interrupt mask")
-  (let ((thread first-running-thread))
-    (cond (thread (procedure thread))
-         ((not return?)
-          (%outf-error "call-with-current-thread: starting one up")
-          (%lock)
-          (run-first-thread)))))
-
 (define (console-thread)
   (thread-mutex-owner (port/thread-mutex console-i/o-port)))
 
@@ -344,10 +334,8 @@ USA.
 (define (suspend-current-thread)
   (without-interrupts
    (lambda ()
-     (call-with-current-thread #f
-       (lambda (thread)
-        (%lock)
-        (%suspend-thread thread))))))
+     (%lock)
+     (%suspend-thread first-running-thread))))
 
 (define (%suspend-thread thread)
   (%assert-locked '%suspend-thread)
@@ -369,16 +357,14 @@ USA.
 
 (define (stop-current-thread)
   (%assert first-running-thread "stop-current-thread: no current thread")
-  (without-interrupts
-   (lambda ()
-     (call-with-current-thread #f
-       (lambda (thread)
-        (call-with-current-continuation
-         (lambda (continuation)
-           (set-thread/continuation! thread continuation)
-           (maybe-save-thread-float-environment! thread)
-           (%lock)
-           (thread-not-running thread 'STOPPED))))))))
+  (call-with-current-continuation
+   (lambda (continuation)
+     (let ((thread first-running-thread))
+       (set-thread/continuation! thread continuation)
+       (maybe-save-thread-float-environment! thread)
+       (set-interrupt-enables! interrupt-mask/in-threads)
+       (%lock)
+       (thread-not-running thread 'STOPPED)))))
 
 (define (restart-thread thread discard-events? event)
   (guarantee-thread thread 'RESTART-THREAD)
@@ -432,13 +418,12 @@ USA.
 (define (yield-current-thread)
   (without-interrupts
    (lambda ()
-     (call-with-current-thread #t
-       (lambda (thread)
-        (%lock)
-        ;; Allow preemption now, since the current thread has
-        ;; volunteered to yield control.
-        (set-thread/execution-state! thread 'RUNNING)
-        (yield-thread thread))))))
+     (let ((thread first-running-thread))
+       (%lock)
+       ;; Allow preemption now, since the current thread has
+       ;; volunteered to yield control.
+       (set-thread/execution-state! thread 'RUNNING)
+       (yield-thread thread)))))
 
 (define (yield-thread thread #!optional fp-env)
   (%assert-locked 'yield-thread)
@@ -884,10 +869,9 @@ USA.
 (define (unblock-thread-events)
   (with-thread-lock
    (lambda ()
-     (call-with-current-thread #t
-       (lambda (thread)
-        (handle-thread-events thread)
-        (set-thread/block-events?! thread #f))))))
+     (let ((thread first-running-thread))
+       (handle-thread-events thread)
+       (set-thread/block-events?! thread #f)))))
 
 (define (with-thread-events-blocked thunk)
   (let ((block-events? (block-thread-events)))