fix exn chaining to be insensitive to prompts

svn: r5220

src/mzscheme/src/error.c

@@ -2493,33 +2493,27 @@ do_raise(Scheme_Object *arg, int need_debug)
   Scheme_Object *v, *p[1], *h, *marks;
   Scheme_Cont_Mark_Chain *chain;
   Scheme_Cont_Frame_Data cframe, cframe2;
+  int got_chain;
 
  if (scheme_current_thread->skip_error) {
    scheme_longjmp (scheme_error_buf, 1);
  }
 
- /* In case we need to chain to the previous exception
-    handler, collect all marks. In the common case, getting the
-    marks will be cheap, because we just got them for
-    the exception record (and they're cached) or we're getting
-    them now for the exception record.
-    Continuation jumps into an exception handler are
-    disallowed, so we don't have to worry about the
-    context changing by the time an exception handler
-    returns. */
- marks = scheme_current_continuation_marks(NULL);
- chain = NULL;
-
  if (need_debug) {
+   marks = scheme_current_continuation_marks(NULL);
    ((Scheme_Structure *)arg)->slots[1] = marks;
  }
 
  h = scheme_extract_one_cc_mark(NULL, scheme_exn_handler_key);
 
+ chain = NULL;
+ got_chain = 0;
+
  while (1) {
    if (!h) {
      h = scheme_get_param(scheme_current_config(), MZCONFIG_INIT_EXN_HANDLER);
-     marks = NULL;
+     chain = NULL;
+     got_chain = 1;
    }
 
    v = scheme_make_byte_string_without_copying("exception handler");
@@ -2541,7 +2535,8 @@ do_raise(Scheme_Object *arg, int need_debug)
    /* Getting a value back means that we should chain to the
       next exception handler; we supply the returned value to
       the next exception handler (if any). */
-   if (marks) {
+   if (!got_chain) {
+     marks = scheme_all_current_continuation_marks();
      chain = ((Scheme_Cont_Mark_Set *)marks)->chain;
      marks = NULL;
      /* Init chain to position of the handler we just
@@ -2549,6 +2544,7 @@ do_raise(Scheme_Object *arg, int need_debug)
      while (chain->key != scheme_exn_handler_key) {
        chain = chain->next;
      }
+     got_chain = 1;
    }
 
    if (chain) {

src/mzscheme/src/fun.c

@@ -5720,6 +5720,8 @@ static Scheme_Object *continuation_marks(Scheme_Thread *p,
 
   if (cont && SAME_OBJ(cont->prompt_tag, prompt_tag))
     found_tag = 1;
+  if (!prompt_tag)
+    found_tag = 1;
 
   do {
     if (econt) {
@@ -5972,6 +5974,14 @@ Scheme_Object *scheme_current_continuation_marks(Scheme_Object *prompt_tag)
                             0);
 }
 
+Scheme_Object *scheme_all_current_continuation_marks()
+{
+  return continuation_marks(scheme_current_thread, NULL, NULL, NULL, 
+                            NULL,
+                            "continuation-marks",
+                            0);
+}
+
 static Scheme_Object *
 cc_marks(int argc, Scheme_Object *argv[])
 {

src/mzscheme/src/schpriv.h

@@ -1125,6 +1125,8 @@ int scheme_is_cm_deeper(struct Scheme_Meta_Continuation *m1, MZ_MARK_POS_TYPE p1
                         struct Scheme_Meta_Continuation *m2, MZ_MARK_POS_TYPE p2);
 void scheme_recheck_prompt_and_barrier(struct Scheme_Cont *c);
 
+Scheme_Object *scheme_all_current_continuation_marks(void);
+
 void scheme_about_to_move_C_stack(void);
 
 /*========================================================================*/