fix continuation-marks on thread without prompt

Closes #3675

pkgs/racket-test-core/tests/racket/contmark.rktl

@@ -610,7 +610,18 @@
 	     (c 4 5))))
   (test '(1 2 4 5) values l))
 
-  
+(err/rt-test (continuation-marks (current-thread) (make-continuation-prompt-tag)))
+(let ([t (thread (lambda () (semaphore-wait (make-semaphore))))])
+  (err/rt-test (continuation-marks t (make-continuation-prompt-tag)))
+  (sync (system-idle-evt))
+  (err/rt-test (continuation-marks t (make-continuation-prompt-tag))))
+
+(let ([t (thread void)])
+  (sync (system-idle-evt))
+  (define m (continuation-marks t (make-continuation-prompt-tag)))
+  (test #t continuation-mark-set? m)
+  (test null continuation-mark-set->list m 'anything))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Try to test internal caching strategies
 

racket/src/bc/src/fun.c

@@ -8003,14 +8003,20 @@ static Scheme_Object *make_empty_marks()
   return (Scheme_Object *)set;
 }
 
-Scheme_Object *scheme_current_continuation_marks(Scheme_Object *prompt_tag)
+Scheme_Object *scheme_current_continuation_marks_as(const char *who, Scheme_Object *prompt_tag)
+/* if who is NULL, the result can be NULL instead of a prompt-tag error */
 {
   return continuation_marks(scheme_current_thread, NULL, NULL, NULL, 
                             prompt_tag ? prompt_tag : scheme_default_prompt_tag,
-                            "continuation-marks",
+                            who,
                             0, 1);
 }
 
+Scheme_Object *scheme_current_continuation_marks(Scheme_Object *prompt_tag)
+{
+  return scheme_current_continuation_marks_as("continuation-marks", prompt_tag);
+}
+
 Scheme_Object *scheme_all_current_continuation_marks()
 {
   return continuation_marks(scheme_current_thread, NULL, NULL, NULL, 
@@ -8123,6 +8129,12 @@ cont_marks(int argc, Scheme_Object *argv[])
       
       scheme_end_atomic_no_swap();
 
+      if (!m)
+        scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION,
+                         "%s: no corresponding prompt in the continuation\n"
+                         "  tag: %V",
+                         "continuation-marks", prompt_tag);
+
       return m;
     }
   } else {

racket/src/bc/src/schpriv.h

@@ -2035,6 +2035,7 @@ int scheme_is_cm_deeper(struct Scheme_Meta_Continuation *m1, MZ_MARK_POS_TYPE p1
 void scheme_recheck_prompt_and_barrier(struct Scheme_Cont *c);
 
 Scheme_Object *scheme_all_current_continuation_marks(void);
+Scheme_Object *scheme_current_continuation_marks_as(const char *who, Scheme_Object *prompt_tag);
 
 void scheme_about_to_move_C_stack(void);
 

racket/src/bc/src/thread.c

@@ -2959,7 +2959,7 @@ int scheme_in_main_thread(void)
 static void stash_current_marks()
 {
   Scheme_Object *m;
-  m = scheme_current_continuation_marks(scheme_current_thread->returned_marks);
+  m = scheme_current_continuation_marks_as(NULL, scheme_current_thread->returned_marks);
   scheme_current_thread->returned_marks = m;
   swap_target = scheme_current_thread->return_marks_to;
   scheme_current_thread->return_marks_to = NULL;

racket/src/cs/rumble/control.ss

@@ -1540,6 +1540,10 @@
            (prune-mark-chain-prefix (escape-continuation-tag k) (current-mark-chain)))
           null)]
         [else
+         ;; A `#f` is used to get the marks for a completed thread.
+         ;; It would make sense to raise an error for any prompt,
+         ;; since the continuaiton is empty, but `continuation-marks`
+         ;; is defined to return empty marks in this case.
          (make-continuation-mark-set null null)]))]))
 
 (define (get-metacontinuation-traces mc)

racket/src/cs/schemified/thread.scm

@@ -12981,7 +12981,7 @@
                       (if (eq? e_0 'done)
                         (|#%app| host:continuation-marks #f prompt-tag_0)
                         (if (eq? e_0 'running)
-                          (current-continuation-marks)
+                          (current-continuation-marks prompt-tag_0)
                           (|#%app| host:continuation-marks e_0 prompt-tag_0))))
                     (|#%app| host:continuation-marks k2_0 prompt-tag_0)))))))))
     (|#%name|

racket/src/thread/continuation-mark.rkt

@@ -15,7 +15,7 @@
      (define e (thread-engine k))
      (cond
        [(eq? e 'done) (host:continuation-marks #f prompt-tag)]
-       [(eq? e 'running) (current-continuation-marks)]
+       [(eq? e 'running) (current-continuation-marks prompt-tag)]
        [else (host:continuation-marks e prompt-tag)])]
     [else
      (host:continuation-marks k prompt-tag)]))