diff --git a/collects/racket/future.rkt b/collects/racket/future.rkt
index 5871b0796c..416459d8ee 100644
--- a/collects/racket/future.rkt
+++ b/collects/racket/future.rkt
@@ -12,4 +12,5 @@
           fsemaphore-post 
           fsemaphore-wait 
           fsemaphore-try-wait?
-          would-be-future)
+          would-be-future
+          futures-enabled?)
diff --git a/collects/scribblings/reference/futures.scrbl b/collects/scribblings/reference/futures.scrbl
index 9a7f193d11..e71e54fa6d 100644
--- a/collects/scribblings/reference/futures.scrbl
+++ b/collects/scribblings/reference/futures.scrbl
@@ -71,6 +71,11 @@ execute through a call to @racket[touch], however.
       (list (+ 3 4) (touch f)))
 ]}
 
+@defproc[(futures-enabled?) boolean?]{
+  Returns whether futures are enabled in the current 
+  Racket build.
+}
+
 @defproc[(current-future) (or/c #f future?)]{
 
   Returns the descriptor of the future whose thunk execution is the
@@ -90,26 +95,26 @@ execute through a call to @racket[touch], however.
 }
 
 @defproc[(would-be-future [thunk (-> any)]) future?]{
-  Returns a special future which is bound to the runtime thread 
-  and logs all potentially blocking primitive invocations made during its lifetime. 
-  With a standard future, certain circumstances might prevent 
-  all primitive invocations that would have caused blocking behavior to 
-  be logged.  @racket[would-be-future] guarantees that all blocks will be 
-  shown.
+  Returns a future that never runs in parallel, but that consistently
+  logs all potentially ``unsafe'' operations during the execution of
+  the future's thunk (i.e., operations that interfere with parallel
+  execution).
+
+  With a normal future, certain circumstances might prevent the logging
+  of unsafe operations. For example, when executed with debug-level logging,
   
   @racketblock[
     (touch (future (lambda () 
-                      (printf "hello1") 
-                      (printf "hello2") 
-                      (printf "hello3"))))] 
+                     (printf "hello1") 
+                     (printf "hello2") 
+                     (printf "hello3"))))] 
 
-  The preceding code, when executed with logging output enabled, 
-  may log three messages for blocks (one for each @racket[printf] 
-  invocation).  However, if the @racket[touch] occurs before a worker 
-  OS-level thread has started executing the future, the thunk will 
-  be executed in the same manner as any ordinary thunk and no blocks 
-  will be logged.  Replacing @racket[future] with @racket[would-be-future] 
-  ensures the logging of all three. 
+  might log three messages, one for each @racket[printf] 
+  invocation.  However, if the @racket[touch] is performed before the future
+  has a chance to start running in parallel, the future thunk evaluates
+  in the same manner as any ordinary thunk, and no unsafe operations
+  are logged.  Replacing @racket[future] with @racket[would-be-future] 
+  ensures the logging of all three calls to @racket[printf]. 
 }
 
 @defproc[(processor-count) exact-positive-integer?]{
diff --git a/collects/tests/future/future.rkt b/collects/tests/future/future.rkt
index 24c1656de2..f0f1d4a31c 100644
--- a/collects/tests/future/future.rkt
+++ b/collects/tests/future/future.rkt
@@ -14,681 +14,755 @@ We should also test deep continuations.
 
 |# 
 
-;; ----------------------------------------
+;Tests specific to would-be-future 
+(define-struct future-event (future-id process-id what time prim-name) 
+    #:prefab)
 
-(check-equal?
- 'yes
- (let/ec k
-   (call-with-exception-handler
-    (lambda (exn)
-      (k (continuation-mark-set-first #f 'special)))
-    (lambda ()
-      (touch
-       (future
-        (lambda ()
-          (with-continuation-mark
-              'special 'yes
-            (set-box! 1 1)))))))))
+(define (get-events-of-type type log) 
+    (filter (λ (e) 
+              (equal? (future-event-what e) type)) 
+            log))
 
-(check-equal?
- 'yes
- (let/ec k
-   (call-with-exception-handler
-    (lambda (exn)
-      (k (continuation-mark-set-first #f 'special)))
-    (lambda ()
-      (touch
-       (future
-        (lambda ()
-          (with-continuation-mark
-              'special 'yes
-            (vector-ref (chaperone-vector
-                         (vector 1)
-                         (lambda (vec i val) 2)
-                         (lambda (vec i val) val))
-                        0)))))))))
+(define (get-blocks log)
+    (get-events-of-type 'block log))
+  
+  (define (get-touch-blocks log) 
+    (get-events-of-type 'touch log))
+  
+  (define (get-blocks-on prim log) 
+    (filter (λ (e) 
+              (equal? (future-event-prim-name e) 
+                      prim)) 
+            (get-blocks log)))
+
+(when (futures-enabled?)
+  (define recv (make-log-receiver (current-logger) 'debug)) 
+  (define RUNTIME-THREAD 0)  
+  (define (raw-log-output)
+    (let* ([info (sync/timeout 0 recv)]) 
+      (if info 
+          (let ([v (vector-ref info 2)]) 
+            (if (future-event? v) 
+                (cons v (raw-log-output)) 
+                (raw-log-output))) 
+          empty)))
+  
+  (let ([f (would-be-future (λ () 
+                              (printf "hello1") 
+                              (printf "hello2") 
+                              (printf "hello3")))]) 
+    (touch f) 
+    (let ([log (raw-log-output)])
+      (check-equal? 3 (length (get-blocks log))) 
+      (check-equal? 3 (length (get-blocks-on 'printf log))) 
+      (check-equal? 0 (length (get-touch-blocks log)))))
+  
+  (let ([f1 (would-be-future 
+             (λ () 
+               (printf "hello1") 
+               (printf "hello ~a\n" 
+                       (touch 
+                        (would-be-future (λ () 
+                                           (printf "hello2") 
+                                           (printf "hello3") 
+                                           42))))))]) 
+    (touch f1) 
+    (let ([log (raw-log-output)])
+      (check-equal? 5 (length (get-blocks log))) 
+      (check-equal? 1 (length (get-touch-blocks log)))
+      (check-equal? 4 (length (get-blocks-on 'printf log))) 
+      (check-equal? 1 (length (get-blocks-on 'would-be-future log))))))
 
 ;; ----------------------------------------
 
-(check-equal?
- #f
- (touch
-  (future
-   (lambda ()
-     (continuation-mark-set-first
-      #f
-      'key)))))
+(define (run-tests func) 
+  (check-equal?
+   'yes
+   (let/ec k
+     (call-with-exception-handler
+      (lambda (exn)
+        (k (continuation-mark-set-first #f 'special)))
+      (lambda ()
+        (touch
+         (func
+          (lambda ()
+            (with-continuation-mark
+                'special 'yes
+              (set-box! 1 1)))))))))
 
-(check-equal?
- 'an-arbitrary-value
- (touch
-  (future
-   (lambda ()
-     (with-continuation-mark
-         'key 'an-arbitrary-value
+  (check-equal?
+   'yes
+   (let/ec k
+     (call-with-exception-handler
+      (lambda (exn)
+        (k (continuation-mark-set-first #f 'special)))
+      (lambda ()
+        (touch
+         (func
+          (lambda ()
+            (with-continuation-mark
+                'special 'yes
+              (vector-ref (chaperone-vector
+                           (vector 1)
+                           (lambda (vec i val) 2)
+                           (lambda (vec i val) val))
+                          0)))))))))
+
+;; ----------------------------------------
+
+  (check-equal?
+   #f
+   (touch
+    (func
+     (lambda ()
        (continuation-mark-set-first
         #f
-        'key))))))
+        'key)))))
 
-(check-equal?
- 'an-arbitrary-value
- (let ([f (future
-           (lambda ()
-             (continuation-mark-set-first
-              #f
-              'key)))])
-   (with-continuation-mark
-       'key 'an-arbitrary-value
-     (touch f))))
-
-(check-equal?
- #f
- (touch
-  (future
-   (lambda ()
-     (with-continuation-mark
-         'key 'an-arbitrary-value
-       (continuation-mark-set-first
-        #f
-        'other-key))))))
-
-(check-equal?
- 'another-value
- (touch
-  (future
-   (lambda ()
-     (with-continuation-mark
-         'key 'an-arbitrary-value
+  (check-equal?
+   'an-arbitrary-value
+   (touch
+    (func
+     (lambda ()
        (with-continuation-mark
-           'other-key 'another-value
+           'key 'an-arbitrary-value
          (continuation-mark-set-first
           #f
-          'other-key)))))))
+          'key))))))
 
-(check-equal?
- 'an-arbitrary-value
- (touch
-  (future
-   (lambda ()
+  (check-equal?
+   'an-arbitrary-value
+   (let ([f (func
+             (lambda ()
+               (continuation-mark-set-first
+                #f
+                'key)))])
      (with-continuation-mark
          'key 'an-arbitrary-value
+       (touch f))))
+  
+  (check-equal?
+   #f
+   (touch
+    (func
+     (lambda ()
        (with-continuation-mark
-           'other-key 'another-value
+           'key 'an-arbitrary-value
          (continuation-mark-set-first
           #f
-          'key)))))))
+          'other-key))))))
 
-(check-equal?
- 'an-arbitrary-value
- (touch
-  (future
-   (lambda ()
-     (with-continuation-mark
-         'key 'an-arbitrary-value
-       (values
-        (with-continuation-mark
-            'other-key 'another-value
-          (continuation-mark-set-first
-           #f
-           'key))))))))
-
-(check-equal?
- 1
- (touch
-  (future
-   (lambda ()
-     (let nt-loop ([x 100])
-       (if (zero? x)
+  (check-equal?
+   'another-value
+   (touch
+    (func
+     (lambda ()
+       (with-continuation-mark
+           'key 'an-arbitrary-value
+         (with-continuation-mark
+             'other-key 'another-value
            (continuation-mark-set-first
             #f
-            'key)
-           (values
-            (with-continuation-mark
-                'key x
-              (nt-loop (sub1 x))))))))))
+            'other-key)))))))
 
-(check-equal?
- 77
- (touch
-  (future
-   (lambda ()
-     (with-continuation-mark
-         'deep-key 77
+  (check-equal?
+   'an-arbitrary-value
+   (touch
+    (func
+     (lambda ()
+       (with-continuation-mark
+           'key 'an-arbitrary-value
+         (with-continuation-mark
+             'other-key 'another-value
+           (continuation-mark-set-first
+            #f
+            'key)))))))
+
+  (check-equal?
+   'an-arbitrary-value
+   (touch
+    (func
+     (lambda ()
+       (with-continuation-mark
+           'key 'an-arbitrary-value
+         (values
+          (with-continuation-mark
+              'other-key 'another-value
+            (continuation-mark-set-first
+             #f
+             'key))))))))
+
+  (check-equal?
+   1
+   (touch
+    (func
+     (lambda ()
        (let nt-loop ([x 100])
          (if (zero? x)
              (continuation-mark-set-first
               #f
-              'deep-key)
+              'key)
              (values
               (with-continuation-mark
                   'key x
-                (nt-loop (sub1 x)))))))))))
-
-(check-equal?
- 77
- (touch
-  (future
-   (lambda ()
-     (with-continuation-mark
-         'early-key 77
-       (let nt-loop ([x 100])
-         (if (zero? x)
-             (continuation-mark-set-first
-              #f
-              'early-key)
-             (with-continuation-mark
-                 x (sqrt x)
-               (nt-loop (sub1 x))))))))))
-
-(check-equal?
- 1050
- (touch
-  (future
-   (lambda ()
-     (with-continuation-mark
-         'early-key 77
-       (let nt-loop ([x 100])
-         (if (zero? x)
-             (continuation-mark-set-first
-              #f
-              50)
-             (with-continuation-mark
-                 x (+ 1000 x)
-               (nt-loop (sub1 x))))))))))
+                (nt-loop (sub1 x))))))))))
+  
+  (check-equal?
+   77
+   (touch
+    (func
+     (lambda ()
+       (with-continuation-mark
+           'deep-key 77
+         (let nt-loop ([x 100])
+           (if (zero? x)
+               (continuation-mark-set-first
+                #f
+                'deep-key)
+               (values
+                (with-continuation-mark
+                    'key x
+                  (nt-loop (sub1 x)))))))))))
+  
+  (check-equal?
+   77
+   (touch
+    (func
+     (lambda ()
+       (with-continuation-mark
+           'early-key 77
+         (let nt-loop ([x 100])
+           (if (zero? x)
+               (continuation-mark-set-first
+                #f
+                'early-key)
+               (with-continuation-mark
+                   x (sqrt x)
+                 (nt-loop (sub1 x))))))))))
+  
+  (check-equal?
+   1050
+   (touch
+    (func
+     (lambda ()
+       (with-continuation-mark
+           'early-key 77
+         (let nt-loop ([x 100])
+           (if (zero? x)
+               (continuation-mark-set-first
+                #f
+                50)
+               (with-continuation-mark
+                   x (+ 1000 x)
+                 (nt-loop (sub1 x))))))))))
 
 ;; ----------------------------------------
-
-(check-equal? 2 
-              (touch (future (λ () 2))))
-
-(let ([f1 (future (λ () (+ 2 2)))] 
-      [f2 (future (λ () (+ 5 3)))]) 
-  (check-equal? 12 (+ (touch f2) (touch f1))))
-
-(let* ([v 5]
-       [f1 (future (λ () 
-                     (set! v 10) 
-                     v))]) 
-  (check-equal? 10 (touch f1)))
-
-(define (build-rand-list lst len) 
-  (case len 
-    [(0) lst] 
-    [else 
-     (build-rand-list (cons 
-                       (random) 
-                       lst) 
-                      (- len 1))]))
-
-(define (append-list-of-lists acc lst) 
-  (cond 
-    [(null? lst) acc] 
-    [else 
-      (append-list-of-lists 
+  
+  (check-equal? 2 
+                (touch (func (λ () 2))))
+  
+  (let ([f1 (func (λ () (+ 2 2)))] 
+        [f2 (func (λ () (+ 5 3)))]) 
+    (check-equal? 12 (+ (touch f2) (touch f1))))
+  
+  (let* ([v 5]
+         [f1 (func (λ () 
+                       (set! v 10) 
+                       v))]) 
+    (check-equal? 10 (touch f1)))
+  
+  (define (build-rand-list lst len) 
+    (case len 
+      [(0) lst] 
+      [else 
+       (build-rand-list (cons 
+                         (random) 
+                         lst) 
+                        (- len 1))]))
+  
+  (define (append-list-of-lists acc lst) 
+    (cond 
+      [(null? lst) acc] 
+      [else 
+       (append-list-of-lists 
         (append acc (car lst)) 
         (cdr lst))]))
   
-
-(let* ([nums '()]
-       [f1 (future (λ () 
-                     (build-rand-list nums 10)))])
-  (set! nums (touch f1)) 
-  (check-equal? 20 (length (touch (future (λ () (build-rand-list nums 10)))))))
-
-(let* ([f1 (future (λ () 
-                     (build-rand-list '() 20)))] 
-       [f2 (future (λ () (length (touch f1))))]) 
-  (check-equal? 20 (touch f2)))
-
-(check-equal? 50000
-              (let ([fts (for/list ([i (in-range 0 10000)]) 
-                           (future (λ () (build-rand-list '() 5))))]) 
-                (length (append-list-of-lists '() (map touch fts)))))
-
-(check-equal? 31 
-              (let* ([f1 (future (λ () (foldl + 0 '(1 2 3 4 5))))] 
-                     [f2 (future (λ () (+ (touch 
-                                           (future (λ () 
-                                                     (+ 6 
-                                                        (touch f1))))) 
-                                          10)))]) 
-                (touch f2)))
-
-(check-equal? 30000
-              (let ([fts (for/list ([i (in-range 0 100)]) 
-                           (future (λ () 
-                                     (build-rand-list '() 300))))]) 
-                (collect-garbage) 
-                (collect-garbage) 
-                (length (append-list-of-lists '() (map touch fts)))))
-
-(define (sum-to acc limit) 
-  (case limit 
-    [(0) acc] 
-    [else 
-     (sum-to (+ acc limit) (- limit 1))]))
-
-(check-equal? 
- 600030000 
- (let ([f1 (future (λ () (sum-to 0 20000)))] 
-       [f2 (future (λ () (sum-to 0 20000)))] 
-       [f3 (future (λ () (sum-to 0 20000)))]) 
-   (+ (+ (touch f3) (touch f1)) (touch f2))))
-
-(check-equal? 
- #t 
- (let* ( [f1 (future (λ () (build-rand-list '() 10000)))]
-         [f2 (future (λ () 
-                       (foldl (λ (a b) 
-                                (* a b)) 
-                              1 
-                              (touch f1))))] 
-         [f3 (future (λ () (< (touch f2) 1)))]) 
-   (touch f3)))
-
-(check-equal?
- '((1) (1))
- (let ([f1 (future (lambda ()
-                     (with-continuation-mark
-                         'x 1
-                       (current-continuation-marks))))]
-       [f2 (future (lambda ()
-                     (with-continuation-mark
-                         'x 1
-                       (current-continuation-marks))))])
-   (sleep 0.1)
-   (list (continuation-mark-set->list (touch f1) 'x)
-         (continuation-mark-set->list (touch f2) 'x))))
-
-(check-equal?
- '((1 0) (1 0))
- (let ([f1 (future (lambda ()
-                     (with-continuation-mark
-                         'x 1
-                       (current-continuation-marks))))]
-       [f2 (future (lambda ()
-                     (with-continuation-mark
-                         'x 1
-                       (current-continuation-marks))))])
-   (with-continuation-mark
-       'x 0
+  
+  (let* ([nums '()]
+         [f1 (func (λ () 
+                       (build-rand-list nums 10)))])
+    (set! nums (touch f1)) 
+    (check-equal? 20 (length (touch (func (λ () (build-rand-list nums 10)))))))
+  
+  (let* ([f1 (func (λ () 
+                       (build-rand-list '() 20)))] 
+         [f2 (func (λ () (length (touch f1))))]) 
+    (check-equal? 20 (touch f2)))
+  
+  (check-equal? 50000
+                (let ([fts (for/list ([i (in-range 0 10000)]) 
+                             (func (λ () (build-rand-list '() 5))))]) 
+                  (length (append-list-of-lists '() (map touch fts)))))
+  
+  (check-equal? 31 
+                (let* ([f1 (func (λ () (foldl + 0 '(1 2 3 4 5))))] 
+                       [f2 (func (λ () (+ (touch 
+                                             (func (λ () 
+                                                       (+ 6 
+                                                          (touch f1))))) 
+                                            10)))]) 
+                  (touch f2)))
+  
+  (check-equal? 30000
+                (let ([fts (for/list ([i (in-range 0 100)]) 
+                             (func (λ () 
+                                       (build-rand-list '() 300))))]) 
+                  (collect-garbage) 
+                  (collect-garbage) 
+                  (length (append-list-of-lists '() (map touch fts)))))
+  
+  (define (sum-to acc limit) 
+    (case limit 
+      [(0) acc] 
+      [else 
+       (sum-to (+ acc limit) (- limit 1))]))
+  
+  (check-equal? 
+   600030000 
+   (let ([f1 (func (λ () (sum-to 0 20000)))] 
+         [f2 (func (λ () (sum-to 0 20000)))] 
+         [f3 (func (λ () (sum-to 0 20000)))]) 
+     (+ (+ (touch f3) (touch f1)) (touch f2))))
+  
+  (check-equal? 
+   #t 
+   (let* ( [f1 (func (λ () (build-rand-list '() 10000)))]
+           [f2 (func (λ () 
+                         (foldl (λ (a b) 
+                                  (* a b)) 
+                                1 
+                                (touch f1))))] 
+           [f3 (func (λ () (< (touch f2) 1)))]) 
+     (touch f3)))
+  
+  (check-equal?
+   '((1) (1))
+   (let ([f1 (func (lambda ()
+                       (with-continuation-mark
+                           'x 1
+                         (current-continuation-marks))))]
+         [f2 (func (lambda ()
+                       (with-continuation-mark
+                           'x 1
+                         (current-continuation-marks))))])
+     (sleep 0.1)
      (list (continuation-mark-set->list (touch f1) 'x)
-           (continuation-mark-set->list (touch f2) 'x)))))
-
-(check-equal?
- '((1 0) (1) ())
- (let ([f1 (future (lambda ()
-                     (with-continuation-mark
-                         'x 1
-                       (current-continuation-marks))))]
-       [f2 (future (lambda ()
-                     (with-continuation-mark
-                         'x 1
-                       (current-continuation-marks))))])
-   (list (continuation-mark-set->list (with-continuation-mark 'x 0
-                                        (touch f1))
-                                      'x)
-         (continuation-mark-set->list (touch f2) 'x)
-         (continuation-mark-set->list (current-continuation-marks) 'x))))
-
-;Tests for current-future
-(check-equal? #f (current-future)) 
-(check-equal? #t (equal? (current-future) (current-future)))
-
-(let ([f (future (λ () (current-future)))]) 
-  (check-equal? #t (equal? f (touch f))))
-
-;Where futures might be touched before ever making it 
-;to a worker kernel thread
-(let ([f1 (future (λ () (current-future)))]
-      [f2 (future (λ () (current-future)))]) 
-  (check-equal? #t (equal? f1 (touch f1))) 
-  (check-equal? #f (equal? f2 (touch f1)))
-  (check-equal? #t (equal? f2 (touch f2)))
-  (check-equal? #f (equal? (touch f2) (touch f1)))
-  (check-equal? #f (equal? (current-future) (touch f1))) 
-  (check-equal? #f (equal? (current-future) (touch f2))))
-
-;Where futures are pretty much guaranteed to be running 
-;on a worker thread
-(let ([f1 (future (λ () (current-future)))]
-      [f2 (future (λ () (current-future)))]) 
-  (sleep 0.1)
-  (check-equal? #t (equal? f1 (touch f1))) 
-  (check-equal? #f (equal? f2 (touch f1)))
-  (check-equal? #t (equal? f2 (touch f2)))
-  (check-equal? #f (equal? (touch f2) (touch f1)))
-  (check-equal? #f (equal? (current-future) (touch f1))) 
-  (check-equal? #f (equal? (current-future) (touch f2))))
-
-;Preceding current-future with an obvious blocking call
-(let ([f1 (future (λ () (sleep 1) (current-future)))]
-      [f2 (future (λ () (sleep 1) (current-future)))]) 
-  (check-equal? #t (equal? f1 (touch f1))) 
-  (check-equal? #f (equal? f2 (touch f1)))
-  (check-equal? #t (equal? f2 (touch f2)))
-  (check-equal? #f (equal? (touch f2) (touch f1)))
-  (check-equal? #f (equal? (current-future) (touch f1))) 
-  (check-equal? #f (equal? (current-future) (touch f2))))            
-              
-(let* ([fs (build-list 20 (λ (n) (future (λ () (current-future)))))]
-       [retvalfs (map touch fs)]) 
-  (check-equal? 20 (length (remove-duplicates retvalfs))))
-
-;; Check `current-future' more, specially trying to get
-;; the runtime thread to nest `touch'es:
-(let loop ([i 20][f (future (lambda () (current-future)))])
-  (if (zero? i)
-      (check-equal? f (touch f))
-      (loop (sub1 i)
-            (future (lambda ()
-                      (and (eq? (touch f) f)
-                           (current-future)))))))
-
-;Future semaphore tests 
-(let* ([m1 (make-fsemaphore 1)] 
-       [m2 (make-fsemaphore 0)] 
-       [x 2] 
-       [lst '()] 
-       [rack-sema (make-semaphore 1)]
-       [f (future (λ () 
-                   (fsemaphore? m2)))]) 
-  (check-equal? #t (fsemaphore? m1)) 
-  (check-equal? #t (fsemaphore? m2)) 
-  (check-equal? #f (fsemaphore? x)) 
-  (check-equal? #f (fsemaphore? lst)) 
-  (check-equal? #f (fsemaphore? rack-sema)) 
-  (check-equal? #t (touch f)))
-
-(let ([m (make-fsemaphore 1)]) 
-  (fsemaphore-wait m) 
-  (check-equal? 0 (fsemaphore-count m)))
-
-(let ([m (make-fsemaphore 0)]) 
-  (fsemaphore-post m) 
-  (fsemaphore-wait m)
-  (check-equal? 0 (fsemaphore-count m)))
-
-(let ([m (make-fsemaphore 37)]) 
-  (check-equal? 37 (fsemaphore-count m))) 
-
-(let ([m (make-fsemaphore 37)]) 
-  (fsemaphore-wait m) 
-  (fsemaphore-wait m)
-  (fsemaphore-post m) 
-  (fsemaphore-wait m) 
-  (check-equal? 35 (fsemaphore-count m)))
-
-(let ([m1 (make-fsemaphore 38)] 
-      [m2 (make-fsemaphore 0)]) 
-  (check-equal? #t (fsemaphore-try-wait? m1)) 
-  (check-equal? #f (fsemaphore-try-wait? m2)))
-
-;Test for errors when passing bad arguments 
-(check-exn exn:fail:contract? (λ () (make-fsemaphore -1)))
-(check-exn exn:fail:contract? (λ () (make-fsemaphore (cons "a" "b"))))
-(check-exn exn:fail:contract? (λ () (fsemaphore-count (cons "foo" "goo"))))
-(check-exn exn:fail:contract? (λ () (fsemaphore-post (cons 1 2))))
-(check-exn exn:fail:contract? (λ () (fsemaphore-wait (cons 1 2)))) 
-(check-exn exn:fail:contract? (λ () (fsemaphore-try-wait? (cons 1 2))))
-
-(check-exn exn:fail:contract? (λ () 
-                                (let ([f (future (λ () 
-                                                   (make-fsemaphore (cons "go" 
-                                                                          "mavs"))))]) 
-                                  (sleep 0.5) 
-                                  (touch f))))
-
-(check-exn exn:fail:contract? (λ () 
-                                (let ([f (future (λ () 
-                                                   (make-fsemaphore -1)))]) 
-                                  (sleep 0.5) 
-                                  (touch f))))
-
-(let ([f (future (λ () 
-                   (fsemaphore-post 33)))]) 
-  (sleep 0.5) 
-  (check-exn exn:fail? (λ () (touch f))))
-
-(let ([f (future (λ () 
-                   (fsemaphore-count 33)))]) 
-  (sleep 0.5) 
-  (check-exn exn:fail? (λ () (touch f))))
-
-(let ([f (future (λ () 
-                   (fsemaphore-wait 33)))]) 
-  (sleep 0.5) 
-  (check-exn exn:fail? (λ () (touch f))))
-
-(let ([f (future (λ () 
-                   (fsemaphore-try-wait? 33)))]) 
-  (sleep 0.5) 
-  (check-exn exn:fail? (λ () (touch f))))
-
-;try-wait
-(let ([m1 (make-fsemaphore 20)] 
-      [m2 (make-fsemaphore 0)]) 
-  (check-equal? #t (fsemaphore-try-wait? m1)) 
-  (check-equal? #f (fsemaphore-try-wait? m2)))
-
-(let* ([m1 (make-fsemaphore 20)] 
-       [m2 (make-fsemaphore 0)] 
-       [f1 (future (λ () 
-                    (fsemaphore-try-wait? m2)))] 
-       [f2 (future (λ () 
-                    (fsemaphore-try-wait? m1)))]) 
-  (sleep 0.5)
-  (check-equal? #f (touch f1)) 
-  (check-equal? #t (touch f2)))
-
-(let ([m (make-fsemaphore 3)]) 
-  (fsemaphore-try-wait? m) 
-  (check-equal? 2 (fsemaphore-count m))) 
-
-(let* ([m (make-fsemaphore 0)] 
-       [f (future (λ () 
-                    (fsemaphore-post m) 
-                    42))]) 
-  (sleep 0.5) 
-  (fsemaphore-try-wait? m) 
-  (check-equal? 0 (fsemaphore-count m)))
-
-;Test fsemaphore wait on a future thread 
-;(here the future thread should be able to capture the cont. locally)
-(let* ([m (make-fsemaphore 0)] 
-       [f (future (λ () 
-                    (let ([l (cons 1 2)]) 
-                      (for ([i (in-range 0 10000)]) 
-                        (set! l (cons i l))) 
-                      (fsemaphore-wait m) 
-                      l)))]) 
-  (sleep 3) 
-  (fsemaphore-post m) 
-  (touch f)
-  (check-equal? 0 (fsemaphore-count m)))
-
-(let* ([m (make-fsemaphore 0)]
-       [dummy 5]
-       [f1 (future (λ () (fsemaphore-wait m) (set! dummy 42)))] 
-       [f2 (future (λ () 88))]) 
-  (check-equal? 88 (touch f2)) 
-  (sleep 1)
-  (check-equal? 0 (fsemaphore-count m))
-  (check-equal? 5 dummy)
-  (fsemaphore-post m) 
-  (touch f1)
-  (check-equal? 42 dummy))
-
-(let* ([m (make-fsemaphore 0)]
-       [dummy 5]
-       [f1 (future (λ () 
-                     (fsemaphore-wait m) 
-                     (set! dummy 42) 
-                     dummy))]
-       [f2 (future (λ () 
-                     (fsemaphore-post m) 
-                     #t))])
-  (sleep 1) 
-  (check-equal? #t (touch f2))
-  (check-equal? 42 (touch f1)) 
-  (check-equal? 0 (fsemaphore-count m)))
-
-(let* ([m1 (make-fsemaphore 0)] 
-       [m2 (make-fsemaphore 0)] 
-       [dummy 8]
-       [f1 (future (λ () 
-                     (fsemaphore-wait m2)
-                     (set! dummy 10)
-                     (fsemaphore-post m1) 
-                     #t))] 
-       [f2 (future (λ () 
-                     (fsemaphore-post m2) 
-                     (touch f1)
-                     (fsemaphore-wait m1) 
-                     (set! dummy (add1 dummy)) 
-                     dummy))]) 
-  (check-equal? 11 (touch f2)))
-
-(let* ([m (make-fsemaphore 0)] 
-       [f1 (future (λ () 
-                     (sleep 1) 
-                     (fsemaphore-wait m) 
-                     5))]) 
-  (fsemaphore-post m)
-  (check-equal? 5 (touch f1)))
-
-;Test fsemaphore ops after blocking runtime call 
-;Here one future will invoke fsemaphore-wait within the context 
-;of a touch.  Meanwhile, another future is allocating (requiring 
-;the help of the runtime thread which is also "blocked" waiting 
-;for the semaphore to become ready.
-(let* ([m (make-fsemaphore 0)] 
-       [f1 (future (λ () 
-                     (sleep 1) ;Currently a blocking RT call 
-                     (fsemaphore-wait m)))] 
-       [f2 (future (λ () 
-                     (let* ([lst '()]
-                            [retval (let loop ([index 10000] [l lst]) 
-                                      (cond 
-                                        [(zero? index) l] 
-                                        [else 
-                                         (loop (sub1 index) (cons index l))]))]) 
-                       (fsemaphore-post m) 
-                       (car retval))))])    
-  (sleep 1)
-  (thread (lambda () (touch f1)))
-  (check-equal? 1 (touch f2)))
-
-(let* ([m (make-fsemaphore 0)] 
-       [f1 (future (λ () 
-                     (fsemaphore-wait m)
-                     42))] 
-       [f2 (future (λ () 
-                     (fsemaphore-wait m) 
-                     99))]) 
-  ;sleep to ensure that both futures will queue up waiting for the fsema 
-  (sleep 1) 
-  (fsemaphore-post m) 
-  (fsemaphore-post m)
-  (check-equal? 42 (touch f1)) 
-  (check-equal? 99 (touch f2)))
-
-(let* ([m (make-fsemaphore 0)]
-       [fs (for/list ([i (in-range 0 19)]) 
-             (future (λ () 
+           (continuation-mark-set->list (touch f2) 'x))))
+  
+  (check-equal?
+   '((1 0) (1 0))
+   (let ([f1 (func (lambda ()
+                       (with-continuation-mark
+                           'x 1
+                         (current-continuation-marks))))]
+         [f2 (func (lambda ()
+                       (with-continuation-mark
+                           'x 1
+                         (current-continuation-marks))))])
+     (with-continuation-mark
+         'x 0
+       (list (continuation-mark-set->list (touch f1) 'x)
+             (continuation-mark-set->list (touch f2) 'x)))))
+  
+  (check-equal?
+   '((1 0) (1) ())
+   (let ([f1 (func (lambda ()
+                       (with-continuation-mark
+                           'x 1
+                         (current-continuation-marks))))]
+         [f2 (func (lambda ()
+                       (with-continuation-mark
+                           'x 1
+                         (current-continuation-marks))))])
+     (list (continuation-mark-set->list (with-continuation-mark 'x 0
+                                          (touch f1))
+                                        'x)
+           (continuation-mark-set->list (touch f2) 'x)
+           (continuation-mark-set->list (current-continuation-marks) 'x))))
+  
+  ;Tests for current-future
+  (check-equal? #f (current-future)) 
+  (check-equal? #t (equal? (current-future) (current-future)))
+  
+  (let ([f (func (λ () (current-future)))]) 
+    (check-equal? #t (equal? f (touch f))))
+  
+  ;Where futures might be touched before ever making it 
+  ;to a worker kernel thread
+  (let ([f1 (func (λ () (current-future)))]
+        [f2 (func (λ () (current-future)))]) 
+    (check-equal? #t (equal? f1 (touch f1))) 
+    (check-equal? #f (equal? f2 (touch f1)))
+    (check-equal? #t (equal? f2 (touch f2)))
+    (check-equal? #f (equal? (touch f2) (touch f1)))
+    (check-equal? #f (equal? (current-future) (touch f1))) 
+    (check-equal? #f (equal? (current-future) (touch f2))))
+  
+  ;Where futures are pretty much guaranteed to be running 
+  ;on a worker thread
+  (let ([f1 (func (λ () (current-future)))]
+        [f2 (func (λ () (current-future)))]) 
+    (sleep 0.1)
+    (check-equal? #t (equal? f1 (touch f1))) 
+    (check-equal? #f (equal? f2 (touch f1)))
+    (check-equal? #t (equal? f2 (touch f2)))
+    (check-equal? #f (equal? (touch f2) (touch f1)))
+    (check-equal? #f (equal? (current-future) (touch f1))) 
+    (check-equal? #f (equal? (current-future) (touch f2))))
+  
+  ;Preceding current-future with an obvious blocking call
+  (let ([f1 (func (λ () (sleep 1) (current-future)))]
+        [f2 (func (λ () (sleep 1) (current-future)))]) 
+    (check-equal? #t (equal? f1 (touch f1))) 
+    (check-equal? #f (equal? f2 (touch f1)))
+    (check-equal? #t (equal? f2 (touch f2)))
+    (check-equal? #f (equal? (touch f2) (touch f1)))
+    (check-equal? #f (equal? (current-future) (touch f1))) 
+    (check-equal? #f (equal? (current-future) (touch f2))))            
+  
+  (let* ([fs (build-list 20 (λ (n) (func (λ () (current-future)))))]
+         [retvalfs (map touch fs)]) 
+    (check-equal? 20 (length (remove-duplicates retvalfs))))
+  
+  ;; Check `current-future' more, specially trying to get
+  ;; the runtime thread to nest `touch'es:
+  (let loop ([i 20][f (func (lambda () (current-future)))])
+    (if (zero? i)
+        (check-equal? f (touch f))
+        (loop (sub1 i)
+              (func (lambda ()
+                        (and (eq? (touch f) f)
+                             (current-future)))))))
+  
+  ;Future semaphore tests 
+  (let* ([m1 (make-fsemaphore 1)] 
+         [m2 (make-fsemaphore 0)] 
+         [x 2] 
+         [lst '()] 
+         [rack-sema (make-semaphore 1)]
+         [f (func (λ () 
+                      (fsemaphore? m2)))]) 
+    (check-equal? #t (fsemaphore? m1)) 
+    (check-equal? #t (fsemaphore? m2)) 
+    (check-equal? #f (fsemaphore? x)) 
+    (check-equal? #f (fsemaphore? lst)) 
+    (check-equal? #f (fsemaphore? rack-sema)) 
+    (check-equal? #t (touch f)))
+  
+  (let ([m (make-fsemaphore 1)]) 
+    (fsemaphore-wait m) 
+    (check-equal? 0 (fsemaphore-count m)))
+  
+  (let ([m (make-fsemaphore 0)]) 
+    (fsemaphore-post m) 
+    (fsemaphore-wait m)
+    (check-equal? 0 (fsemaphore-count m)))
+  
+  (let ([m (make-fsemaphore 37)]) 
+    (check-equal? 37 (fsemaphore-count m))) 
+  
+  (let ([m (make-fsemaphore 37)]) 
+    (fsemaphore-wait m) 
+    (fsemaphore-wait m)
+    (fsemaphore-post m) 
+    (fsemaphore-wait m) 
+    (check-equal? 35 (fsemaphore-count m)))
+  
+  (let ([m1 (make-fsemaphore 38)] 
+        [m2 (make-fsemaphore 0)]) 
+    (check-equal? #t (fsemaphore-try-wait? m1)) 
+    (check-equal? #f (fsemaphore-try-wait? m2)))
+  
+  ;Test for errors when passing bad arguments 
+  (check-exn exn:fail:contract? (λ () (make-fsemaphore -1)))
+  (check-exn exn:fail:contract? (λ () (make-fsemaphore (cons "a" "b"))))
+  (check-exn exn:fail:contract? (λ () (fsemaphore-count (cons "foo" "goo"))))
+  (check-exn exn:fail:contract? (λ () (fsemaphore-post (cons 1 2))))
+  (check-exn exn:fail:contract? (λ () (fsemaphore-wait (cons 1 2)))) 
+  (check-exn exn:fail:contract? (λ () (fsemaphore-try-wait? (cons 1 2))))
+  
+  (check-exn exn:fail:contract? (λ () 
+                                  (let ([f (func (λ () 
+                                                     (make-fsemaphore (cons "go" 
+                                                                            "mavs"))))]) 
+                                    (sleep 0.5) 
+                                    (touch f))))
+  
+  (check-exn exn:fail:contract? (λ () 
+                                  (let ([f (func (λ () 
+                                                     (make-fsemaphore -1)))]) 
+                                    (sleep 0.5) 
+                                    (touch f))))
+  
+  (let ([f (func (λ () 
+                     (fsemaphore-post 33)))]) 
+    (sleep 0.5) 
+    (check-exn exn:fail? (λ () (touch f))))
+  
+  (let ([f (func (λ () 
+                     (fsemaphore-count 33)))]) 
+    (sleep 0.5) 
+    (check-exn exn:fail? (λ () (touch f))))
+  
+  (let ([f (func (λ () 
+                     (fsemaphore-wait 33)))]) 
+    (sleep 0.5) 
+    (check-exn exn:fail? (λ () (touch f))))
+  
+  (let ([f (func (λ () 
+                     (fsemaphore-try-wait? 33)))]) 
+    (sleep 0.5) 
+    (check-exn exn:fail? (λ () (touch f))))
+  
+  ;try-wait
+  (let ([m1 (make-fsemaphore 20)] 
+        [m2 (make-fsemaphore 0)]) 
+    (check-equal? #t (fsemaphore-try-wait? m1)) 
+    (check-equal? #f (fsemaphore-try-wait? m2)))
+  
+  (let* ([m1 (make-fsemaphore 20)] 
+         [m2 (make-fsemaphore 0)] 
+         [f1 (func (λ () 
+                       (fsemaphore-try-wait? m2)))] 
+         [f2 (func (λ () 
+                       (fsemaphore-try-wait? m1)))]) 
+    (sleep 0.5)
+    (check-equal? #f (touch f1)) 
+    (check-equal? #t (touch f2)))
+  
+  (let ([m (make-fsemaphore 3)]) 
+    (fsemaphore-try-wait? m) 
+    (check-equal? 2 (fsemaphore-count m))) 
+  
+  (let* ([m (make-fsemaphore 0)] 
+         [f (func (λ () 
+                      (fsemaphore-post m) 
+                      42))]) 
+    (sleep 0.5) 
+    (fsemaphore-try-wait? m) 
+    (check-equal? 0 (fsemaphore-count m)))
+  
+  ;Test fsemaphore wait on a future thread 
+  ;(here the future thread should be able to capture the cont. locally)
+  (let* ([m (make-fsemaphore 0)] 
+         [f (func (λ () 
+                      (let ([l (cons 1 2)]) 
+                        (for ([i (in-range 0 10000)]) 
+                          (set! l (cons i l))) 
+                        (fsemaphore-wait m) 
+                        l)))]) 
+    (sleep 3) 
+    (fsemaphore-post m) 
+    (touch f)
+    (check-equal? 0 (fsemaphore-count m)))
+  
+  (let* ([m (make-fsemaphore 0)]
+         [dummy 5]
+         [f1 (func (λ () (fsemaphore-wait m) (set! dummy 42)))] 
+         [f2 (func (λ () 88))]) 
+    (check-equal? 88 (touch f2)) 
+    (sleep 1)
+    (check-equal? 0 (fsemaphore-count m))
+    (check-equal? 5 dummy)
+    (fsemaphore-post m) 
+    (touch f1)
+    (check-equal? 42 dummy))
+  
+  (let* ([m (make-fsemaphore 0)]
+         [dummy 5]
+         [f1 (func (λ () 
                        (fsemaphore-wait m) 
-                       i)))]) 
-  (sleep 1)
-  (for ([i (in-range 0 19)]) 
-    (fsemaphore-post m)) 
-  (check-equal? 171 (foldl (λ (f acc) 
-                             (+ (touch f) acc)) 
-                           0 
-                           fs)))
+                       (set! dummy 42) 
+                       dummy))]
+         [f2 (func (λ () 
+                       (fsemaphore-post m) 
+                       #t))])
+    (sleep 1) 
+    (check-equal? #t (touch f2))
+    (check-equal? 42 (touch f1)) 
+    (check-equal? 0 (fsemaphore-count m)))
+  
+  (let* ([m1 (make-fsemaphore 0)] 
+         [m2 (make-fsemaphore 0)] 
+         [dummy 8]
+         [f1 (func (λ () 
+                       (fsemaphore-wait m2)
+                       (set! dummy 10)
+                       (fsemaphore-post m1) 
+                       #t))] 
+         [f2 (func (λ () 
+                       (fsemaphore-post m2) 
+                       (touch f1)
+                       (fsemaphore-wait m1) 
+                       (set! dummy (add1 dummy)) 
+                       dummy))]) 
+    (check-equal? 11 (touch f2)))
+  
+  (let* ([m (make-fsemaphore 0)] 
+         [f1 (func (λ () 
+                       (sleep 1) 
+                       (fsemaphore-wait m) 
+                       5))]) 
+    (fsemaphore-post m)
+    (check-equal? 5 (touch f1)))
+  
+  ;Test fsemaphore ops after blocking runtime call 
+  ;Here one future will invoke fsemaphore-wait within the context 
+  ;of a touch.  Meanwhile, another future is allocating (requiring 
+  ;the help of the runtime thread which is also "blocked" waiting 
+  ;for the semaphore to become ready.
+  (let* ([m (make-fsemaphore 0)] 
+         [f1 (func (λ () 
+                       (sleep 1) ;Currently a blocking RT call 
+                       (fsemaphore-wait m)))] 
+         [f2 (func (λ () 
+                       (let* ([lst '()]
+                              [retval (let loop ([index 10000] [l lst]) 
+                                        (cond 
+                                          [(zero? index) l] 
+                                          [else 
+                                           (loop (sub1 index) (cons index l))]))]) 
+                         (fsemaphore-post m) 
+                         (car retval))))])    
+    (sleep 1)
+    (thread (lambda () (touch f1)))
+    (check-equal? 1 (touch f2)))
+  
+  (let* ([m (make-fsemaphore 0)] 
+         [f1 (func (λ () 
+                       (fsemaphore-wait m)
+                       42))] 
+         [f2 (func (λ () 
+                       (fsemaphore-wait m) 
+                       99))]) 
+    ;sleep to ensure that both futures will queue up waiting for the fsema 
+    (sleep 1) 
+    (fsemaphore-post m) 
+    (fsemaphore-post m)
+    (check-equal? 42 (touch f1)) 
+    (check-equal? 99 (touch f2)))
+  
+  (let* ([m (make-fsemaphore 0)]
+         [fs (for/list ([i (in-range 0 19)]) 
+               (func (λ () 
+                         (fsemaphore-wait m) 
+                         i)))]) 
+    (sleep 1)
+    (for ([i (in-range 0 19)]) 
+      (fsemaphore-post m)) 
+    (check-equal? 171 (foldl (λ (f acc) 
+                               (+ (touch f) acc)) 
+                             0 
+                             fs)))
+  
+  ;; Make sure that `future' doesn't mishandle functions
+  ;; that aren't be JITted:
+  (check-equal?
+   (for/list ([i (in-range 10)]) (void))
+   (map
+    touch
+    (for/list ([i (in-range 10)])
+      (if (even? i)
+          (func void)
+          (func (parameterize ([eval-jit-enabled #f])
+                    (eval #'(lambda () (void)))))))))
+  
+  ;; A future shouldn't use up a background thread if its
+  ;; starting thread's custodian is shut down:
+  (let ()
+    (define f #f)
+    (define c (make-custodian))
+    (parameterize ([current-custodian c])
+      (sync (thread (lambda ()
+                      (set! f (func (lambda ()
+                                        (let loop () (loop)))))))))
+    (sleep 0.1)
+    (custodian-shutdown-all c))
+  
+  ;; If a future is suspended via a custodian, it should still
+  ;; work to touch it:
+  (let ()
+    (define f #f)
+    (define s (make-fsemaphore 0))
+    (define c (make-custodian))
+    (parameterize ([current-custodian c])
+      (sync (thread (lambda ()
+                      (set! f (func (lambda ()
+                                        (fsemaphore-wait s)
+                                        10)))))))
+    (sleep 0.1)
+    (custodian-shutdown-all c)
+    (fsemaphore-post s)
+    (check-equal? 10 (touch f)))
+  
+  
+  ;; Start a future in a custodian-suspended future:
+  (let ()
+    (define f #f)
+    (define s (make-fsemaphore 0))
+    (define c (make-custodian))
+    (parameterize ([current-custodian c])
+      (sync (thread (lambda ()
+                      (set! f (func (lambda ()
+                                        (fsemaphore-wait s)
+                                        (func
+                                         (lambda ()
+                                           11)))))))))
+    (sleep 0.1)
+    (custodian-shutdown-all c)
+    (fsemaphore-post s)
+    (check-equal? 11 (touch (touch f))))
+  
+  ;; Don't get stuck on a bunch of futures that
+  ;; have been disabled:
+  (let ()
+    (define c (make-custodian))
+    (define (loop) (loop))
+    (parameterize ([current-custodian c])
+      (sync (thread (lambda ()
+                      (for ([i (in-range 100)])
+                        (func loop))))))
+    (sleep 0.1)
+    (custodian-shutdown-all c)
+    (sleep 0.1))
+  
+  ;; Stress test:
+  (for-each
+   (lambda (v) (check-equal? 10 (touch (touch v))))
+   (for/list ([i (in-range 10000)])
+     (func (lambda () (func (lambda () 10))))))
+  
+  ;; Stress test:
+  (check-equal?
+   0
+   (touch
+    (for/fold ([t (func (lambda () 0))]) ([i (in-range 10000)])
+      (func (lambda () (touch t))))))
+  
+  )
 
-;; Make sure that `future' doesn't mishandle functions
-;; that aren't be JITted:
-(check-equal?
- (for/list ([i (in-range 10)]) (void))
- (map
-  touch
-  (for/list ([i (in-range 10)])
-    (if (even? i)
-        (future void)
-        (future (parameterize ([eval-jit-enabled #f])
-                  (eval #'(lambda () (void)))))))))
-
-;; A future shouldn't use up a background thread if its
-;; starting thread's custodian is shut down:
-(let ()
-  (define f #f)
-  (define c (make-custodian))
-  (parameterize ([current-custodian c])
-    (sync (thread (lambda ()
-                    (set! f (future (lambda ()
-                                      (let loop () (loop)))))))))
-  (sleep 0.1)
-  (custodian-shutdown-all c))
-
-;; If a future is suspended via a custodian, it should still
-;; work to touch it:
-(let ()
-  (define f #f)
-  (define s (make-fsemaphore 0))
-  (define c (make-custodian))
-  (parameterize ([current-custodian c])
-    (sync (thread (lambda ()
-                    (set! f (future (lambda ()
-                                      (fsemaphore-wait s)
-                                      10)))))))
-  (sleep 0.1)
-  (custodian-shutdown-all c)
-  (fsemaphore-post s)
-  (check-equal? 10 (touch f)))
+(run-tests future)
+(run-tests would-be-future)
 
 
-;; Start a future in a custodian-suspended future:
-(let ()
-  (define f #f)
-  (define s (make-fsemaphore 0))
-  (define c (make-custodian))
-  (parameterize ([current-custodian c])
-    (sync (thread (lambda ()
-                    (set! f (future (lambda ()
-                                      (fsemaphore-wait s)
-                                      (future
-                                       (lambda ()
-                                         11)))))))))
-  (sleep 0.1)
-  (custodian-shutdown-all c)
-  (fsemaphore-post s)
-  (check-equal? 11 (touch (touch f))))
-
-;; Don't get stuck on a bunch of futures that
-;; have been disabled:
-(let ()
-  (define c (make-custodian))
-  (define (loop) (loop))
-  (parameterize ([current-custodian c])
-    (sync (thread (lambda ()
-                    (for ([i (in-range 100)])
-                      (future loop))))))
-  (sleep 0.1)
-  (custodian-shutdown-all c)
-  (sleep 0.1))
-
-;; Stress test:
-(for-each
- (lambda (v) (check-equal? 10 (touch (touch v))))
- (for/list ([i (in-range 10000)])
-   (future (lambda () (future (lambda () 10))))))
-
-;; Stress test:
-(check-equal?
- 0
- (touch
-  (for/fold ([t (future (lambda () 0))]) ([i (in-range 10000)])
-    (future (lambda () (touch t))))))
-
-;; ----------------------------------------
+  
+  ;; ----------------------------------------
+  
 
+        
+        
+        
+        
+        
+        
\ No newline at end of file
diff --git a/src/racket/src/future.c b/src/racket/src/future.c
index 606a07c9a3..855d8e5cea 100644
--- a/src/racket/src/future.c
+++ b/src/racket/src/future.c
@@ -37,6 +37,15 @@ Scheme_Object *scheme_fsemaphore_p(int argc, Scheme_Object *argv[])
     return scheme_false;
 }
 
+static Scheme_Object *futures_enabled(int argc, Scheme_Object *argv[])
+{
+#ifdef MZ_USE_FUTURES 
+  return scheme_true;
+#else 
+  return scheme_false;
+#endif
+}
+
 
 #ifdef MZ_PRECISE_GC
 static void register_traversers(void);
@@ -244,6 +253,7 @@ void scheme_init_futures(Scheme_Env *newenv)
   FUTURE_PRIM_W_ARITY("fsemaphore-try-wait?", scheme_fsemaphore_try_wait, 1, 1, newenv);
   FUTURE_PRIM_W_ARITY("fsemaphore-count", scheme_fsemaphore_count, 1, 1, newenv);
   FUTURE_PRIM_W_ARITY("would-be-future", would_be_future, 1, 1, newenv);
+  FUTURE_PRIM_W_ARITY("futures-enabled?", futures_enabled, 0, 0, newenv);
 
   scheme_finish_primitive_module(newenv);
   scheme_protect_primitive_provide(newenv, NULL);
@@ -288,6 +298,7 @@ static Scheme_Object *touch(int argc, Scheme_Object *argv[]);
 static Scheme_Object *processor_count(int argc, Scheme_Object *argv[]);
 static void futures_init(void);
 static void init_future_thread(struct Scheme_Future_State *fs, int i);
+static Scheme_Future_Thread_State *alloc_future_thread_state();
 static void requeue_future(struct future_t *future, struct Scheme_Future_State *fs);
 static void future_do_runtimecall(Scheme_Future_Thread_State *fts,
                                   void *func,
@@ -522,6 +533,7 @@ void scheme_init_futures(Scheme_Env *newenv)
   scheme_add_global_constant("fsemaphore-try-wait?", p, newenv);  
 
   GLOBAL_PRIM_W_ARITY("would-be-future", would_be_future, 1, 1, newenv);
+  GLOBAL_PRIM_W_ARITY("futures-enabled?", futures_enabled, 0, 0, newenv);
 
   scheme_finish_primitive_module(newenv);
   scheme_protect_primitive_provide(newenv, NULL);
@@ -558,7 +570,7 @@ void futures_init(void)
   fs->thread_pool_size = pool_size;
 
   /* Create a 'dummy' FTS for the RT thread */
-  rt_fts = (Scheme_Future_Thread_State*)malloc(sizeof(Scheme_Future_Thread_State)); 
+  rt_fts = alloc_future_thread_state();
   rt_fts->is_runtime_thread = 1;
   rt_fts->gen0_size = 1;
   scheme_future_thread_state = rt_fts;
@@ -590,7 +602,7 @@ void futures_init(void)
   syms[FEVENT_HANDLE_RTCALL] = sym;
 
   sym = scheme_intern_symbol("future-event");
-  stype = scheme_lookup_prefab_type(sym, 4);
+  stype = scheme_lookup_prefab_type(sym, 5);
   fs->fevent_prefab = stype;
 
   init_fevent(&fs->runtime_fevents);
@@ -611,8 +623,7 @@ static void init_future_thread(Scheme_Future_State *fs, int i)
   /* Create the worker thread pool.  These threads will
      'queue up' and wait for futures to become available. */
 
-  fts = (Scheme_Future_Thread_State *)malloc(sizeof(Scheme_Future_Thread_State));
-  memset(fts, 0, sizeof(Scheme_Future_Thread_State));
+  fts = alloc_future_thread_state();
   fts->id = i;
 
   fts->gen0_size = 1;
@@ -629,7 +640,6 @@ static void init_future_thread(Scheme_Future_State *fs, int i)
   skeleton = MALLOC_ONE_TAGGED(Scheme_Thread);
   skeleton->so.type = scheme_thread_type;
 
-  scheme_register_static(&fts->thread, sizeof(Scheme_Thread*));
   fts->thread = skeleton;
 
   {
@@ -659,6 +669,17 @@ static void init_future_thread(Scheme_Future_State *fs, int i)
   fs->pool_threads[i] = fts;
 }
 
+static Scheme_Future_Thread_State *alloc_future_thread_state()
+{
+  Scheme_Future_Thread_State *fts;
+
+  fts = (Scheme_Future_Thread_State *)malloc(sizeof(Scheme_Future_Thread_State));
+  memset(fts, 0, sizeof(Scheme_Future_Thread_State));
+  scheme_register_static(&fts->thread, sizeof(Scheme_Thread*));  
+
+  return fts;
+}
+
 void scheme_end_futures_per_place()
 {
   Scheme_Future_State *fs = scheme_future_state;
@@ -997,6 +1018,11 @@ static void log_future_event(Scheme_Future_State *fs,
   ((Scheme_Structure *)data)->slots[2] = v;
   v = scheme_make_double(timestamp);
   ((Scheme_Structure *)data)->slots[3] = v;
+  if (what == FEVENT_HANDLE_RTCALL) {
+    v = scheme_intern_symbol(extra_str);
+    ((Scheme_Structure *)data)->slots[4] = v;
+  } else 
+    ((Scheme_Structure *)data)->slots[4] = scheme_false;
   
   scheme_log_w_data(scheme_main_logger, SCHEME_LOG_DEBUG, 0,
                     data,                 
@@ -1896,8 +1922,21 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[])
 /* can be called in future thread */
 {
   Scheme_Future_Thread_State *fts = scheme_future_thread_state;
-
   if (fts->is_runtime_thread) {
+    future_t *ft;
+    if (fts->thread 
+        && (ft = fts->thread->current_ft) 
+        && ft->in_tracing_mode) { 
+      Scheme_Future_State *fs = scheme_future_state;
+      log_future_event( fs,
+                        "future %d, process %d: %s: %s; time: %f",
+                        "touch",
+                        -1, 
+                        FEVENT_RTCALL_TOUCH, 
+                        get_future_timestamp(),
+                        ft->id);
+    }
+      
     return general_touch(argc, argv);
   } else {
     if (SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_future_type)) {
diff --git a/src/racket/src/schminc.h b/src/racket/src/schminc.h
index f089aee247..c0f851a006 100644
--- a/src/racket/src/schminc.h
+++ b/src/racket/src/schminc.h
@@ -16,7 +16,7 @@
 #define EXPECTED_PRIM_COUNT 1042
 #define EXPECTED_UNSAFE_COUNT 78
 #define EXPECTED_FLFXNUM_COUNT 68
-#define EXPECTED_FUTURES_COUNT 12
+#define EXPECTED_FUTURES_COUNT 13
 
 #ifdef MZSCHEME_SOMETHING_OMITTED
 # undef USE_COMPILED_STARTUP