cs: fix thread initial prompt and parameterization

The initial parameterization needs to be inside the initial prompt,
not outside.

racket/src/cs/demo/control.ss

@@ -431,11 +431,13 @@
 ;; ----------------------------------------
 ;; Engines
 
-(define e (make-engine (lambda () 'done) #f #f))
+(define engine-tag (default-continuation-prompt-tag))
+
+(define e (make-engine (lambda () 'done) engine-tag #f #f))
 (check (cdr (e 100 void list vector))
        '(done))
 
-(define e-forever (make-engine (lambda () (let loop () (loop))) #f #f))
+(define e-forever (make-engine (lambda () (let loop () (loop))) engine-tag #f #f))
 (check (vector? (e-forever 10 void list vector))
        #t)
 
@@ -448,6 +450,7 @@
                                [else
                                 (engine-block)
                                 (loop (sub1 n))])))
+                          engine-tag
                           #f #f))
 (check (let ([started 0])
          (let loop ([e e-10] [n 0])
@@ -472,6 +475,7 @@
                                      (lambda () (set! pre (add1 pre)))
                                      (lambda () (loop (sub1 n)))
                                      (lambda () (set! post (add1 post))))])))
+                              engine-tag
                               #f #f)])
     (check (let loop ([e e-10/dw] [n 0])
              (e 200
@@ -493,10 +497,10 @@
     (thread-cell-set! pt (add1 p-old))
     (list u-old
           p-old
-          (make-engine gen #f #f)
+          (make-engine gen engine-tag #f #f)
           (thread-cell-ref ut)
           (thread-cell-ref pt)))
-  (define l1 ((make-engine gen #f #f)
+  (define l1 ((make-engine gen engine-tag #f #f)
               100
               void
               (lambda (remain l) l)
@@ -522,7 +526,7 @@
 (check (procedure? my-param) #t)
 (let ([e (with-continuation-mark parameterization-key
              (extend-parameterization (continuation-mark-set-first #f parameterization-key) my-param 'set)
-           (make-engine (lambda () (|#%app| my-param)) #f #f))])
+           (make-engine (lambda () (|#%app| my-param)) engine-tag #f #f))])
   (check (|#%app| my-param) 'init)
   (check (e 1000 void (lambda (remain v) v) (lambda (e) (error 'engine "oops"))) 'set))
 
@@ -618,6 +622,7 @@
                                           (loop (sub1 n)))))
                                   (lambda ()
                                     (set! post (add1 post))))))))
+                          engine-tag
                           #f #f))
 
 (check (let ([prefixes 0])

racket/src/cs/rumble/engine.ss

@@ -24,17 +24,20 @@
 (define (set-engine-exit-handler! proc)
   (set! engine-exit proc))
 
-(define (make-engine thunk init-break-enabled-cell empty-config?)
+(define (make-engine thunk prompt-tag init-break-enabled-cell empty-config?)
   (let ([paramz (if empty-config?
                     empty-parameterization
                     (current-parameterization))])
     (create-engine empty-metacontinuation
                    (lambda (prefix)
-                     (with-continuation-mark
-                         parameterization-key paramz
-                         (begin
-                           (prefix)
-                           (call-with-values (lambda () (|#%app| thunk)) engine-return))))
+                     (call-with-continuation-prompt
+                      (lambda ()
+                        (with-continuation-mark
+                            parameterization-key paramz
+                          (begin
+                            (prefix)
+                            (call-with-values (lambda () (|#%app| thunk)) engine-return))))
+                      prompt-tag))
                    (if empty-config?
                        (make-empty-thread-cell-values)
                        (new-engine-thread-cell-values))

racket/src/thread/future.rkt

@@ -90,14 +90,11 @@
 
 (define (thunk-wrapper f thunk)
   (lambda ()
-    (call-with-continuation-prompt
-     (lambda ()
-       (let ([result (thunk)])
-         (with-lock ((future*-lock f) (current-future))
-           (set-future*-result! f result)
-           (set-future*-done?! f #t)
-           (future:condition-broadcast (future*-cond f)))))
-     (future*-prompt f))))
+    (let ([result (thunk)])
+      (with-lock ((future*-lock f) (current-future))
+        (set-future*-result! f result)
+        (set-future*-done?! f #t)
+        (future:condition-broadcast (future*-cond f))))))
 
 (define/who (future thunk)
   (check who (procedure-arity-includes/c 0) thunk)
@@ -106,7 +103,7 @@
      (would-be-future thunk)]
     [else
      (let ([f (create-future #f)])
-       (set-future*-engine! f (make-engine (thunk-wrapper f thunk) #f #t))
+       (set-future*-engine! f (make-engine (thunk-wrapper f thunk) (future*-prompt f) #f #t))
        (schedule-future f)
        f)]))
 

racket/src/thread/thread.rkt

@@ -150,8 +150,8 @@
   (define p (if (or at-root? initial?)
                 root-thread-group
                 (current-thread-group)))
-  (define e (make-engine (lambda ()
-                           (call-with-continuation-prompt proc))
+  (define e (make-engine proc
+                         (default-continuation-prompt-tag)
                          (if (or initial? at-root?)
                              break-enabled-default-cell
                              (current-break-enabled-cell))