From 73824d99f9ea7207a329576c1b0ff3185a179c0b Mon Sep 17 00:00:00 2001
From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Wed, 8 Jul 2015 23:29:09 -0700
Subject: [PATCH] Remove call-with-current-thread.

---
 src/runtime/thread.scm | 54 +++++++++++++++---------------------------
 1 file changed, 19 insertions(+), 35 deletions(-)

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index a05a3acda..4a9c51139 100644
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -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)))
-- 
2.25.1