Use manager thread for blocking-box.

blocking-box.rkt

@@ -7,24 +7,32 @@
 	 blocking-box-value
 	 set-blocking-box!)
 
-(struct blocking-box (semaphore ch))
+(struct blocking-box (thread set-ch get-ch))
 
 (define (make-blocking-box)
-  (blocking-box (make-semaphore 1) (make-channel)))
+  (define set-ch (make-channel))
+  (define get-ch (make-channel))
+  (blocking-box (thread/suspend-to-kill (lambda () (manager set-ch get-ch)))
+		set-ch
+		get-ch))
+
+(define (manager s g)
+  (define v (channel-get s))
+  (let loop ()
+    (sync (handle-evt s (lambda (ignored-new-v) (loop)))
+	  (handle-evt (channel-put-evt g v) (lambda (dummy) (loop))))))
 
 (define (blocking-box-evt b)
-  ;; wrap the event to avoid exposing too much authority
-  (wrap-evt (blocking-box-ch b) values))
+  (guard-evt
+   (lambda ()
+     ;; Ensure the manager is running within our custodian:
+     (thread-resume (blocking-box-thread b) (current-thread))
+     (blocking-box-get-ch b))))
 
 (define (blocking-box-value b)
   (sync (blocking-box-evt b)))
 
 (define (set-blocking-box! b v)
-  (define c (blocking-box-ch b))
-  (thread (lambda ()
-	    (when (semaphore-try-wait? (blocking-box-semaphore b))
-	      ;; We are first (and therefore only) claimant of the box.
-	      (let loop ()
-		(channel-put c v)
-		(loop)))))
-  (void))
+  ;; Ensure the manager is running within our custodian:
+  (thread-resume (blocking-box-thread b) (current-thread))
+  (channel-put (blocking-box-set-ch b) v))