Delimited dynamic binding for Gauche. failed on test/error.scm yet. discrepancies found. Errors are: test restart & dynamic-wind: expects (a b c x e f z a b x e f z) => got (a b c x e f z b x e f z)

ddbind.patch

diff --git a/src/gauche.h b/src/gauche.h
index 9ae7aa2..106b115 100644
--- a/src/gauche.h
+++ b/src/gauche.h
@@ -1456,6 +1456,7 @@ SCM_EXTERN ScmObj Scm_MakeSubr(ScmSubrProc *func,
   		       int required, int optional,
 			       ScmObj info);
 SCM_EXTERN ScmObj Scm_NullProc(void);
+SCM_EXTERN ScmObj Scm_BoundaryProc(void);
 
 SCM_EXTERN ScmObj Scm_SetterSet(ScmProcedure *proc, ScmProcedure *setter,
 				int lock);
diff --git a/src/proc.c b/src/proc.c
index ca16676..1c61cc7 100644
--- a/src/proc.c
+++ b/src/proc.c
@@ -120,6 +120,17 @@ ScmObj Scm_NullProc(void)
     return SCM_OBJ(theNullProc);
 }
 
+static ScmObj theBoundaryProc = SCM_NIL;
+
+ScmObj Scm_BoundaryProc(void)
+{
+    if (SCM_NULLP(theBoundaryProc)) {
+        theBoundaryProc = Scm_MakeSubr(null_proc, NULL, 0, 1,
+                                       SCM_MAKE_STR("boundaryproc"));
+    }
+    return SCM_OBJ(theBoundaryProc);
+}
+
 /*=================================================================
  * Currying
  */
diff --git a/src/vm.c b/src/vm.c
index c53e9cc..2f5e567 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -67,6 +67,9 @@ static ScmWord boundaryFrameMark = SCM_VM_INSN(SCM_VM_NOP);
 /* return true if cont is a boundary continuation frame */
 #define BOUNDARY_FRAME_P(cont) ((cont)->pc == &boundaryFrameMark)
 
+
+#define BOUNDARY_HANDLER_P(obj) (SCM_PAIRP(obj) && (SCM_CAR(obj) == Scm_BoundaryProc()))
+
 /* A stub VM code to make VM return immediately */
 static ScmWord return_code[] = { SCM_VM_INSN(SCM_VM_RET) };
 #define PC_TO_RETURN  return_code
@@ -1394,6 +1397,8 @@ static ScmObj user_eval_inner(ScmObj program, ScmWord *codevec)
        it should return to C frame when it sees a boundary frame.
        A boundary frame also keeps the unfinished argument frame at
        the point when Scm_Eval or Scm_Apply is called. */
+    ScmObj boundaryProc = Scm_BoundaryProc();
+    vm->handlers = Scm_Cons(Scm_Cons(boundaryProc, boundaryProc), vm->handlers);
     CHECK_STACK(CONT_FRAME_SIZE);
     PUSH_CONT(&boundaryFrameMark);
     SCM_ASSERT(SCM_COMPILED_CODE_P(program));
@@ -2240,7 +2245,9 @@ static ScmObj throw_cont_body(ScmObj handlers,    /* after/before thunks
      */
     vm->pc = PC_TO_RETURN;
     vm->cont = ep->cont;
-    vm->handlers = ep->handlers;
+
+    if (ep->cstack != NULL)
+        vm->handlers = ep->handlers;
 
     nargs = Scm_Length(args);
     if (nargs == 1) {
@@ -2293,7 +2300,17 @@ static ScmObj throw_continuation(ScmObj *argframe, int nargs, void *data)
         }
     }
 
-    handlers_to_call = throw_cont_calculate_handlers(ep, vm);
+    if (ep->cstack == NULL) {
+        ScmObj h = SCM_NIL, handlers = vm->handlers;
+        handlers_to_call = SCM_NIL;
+        SCM_FOR_EACH(h, ep->handlers) {
+            handlers_to_call =
+                Scm_Cons(Scm_Cons(SCM_CAAR(h), handlers), handlers_to_call);
+            handlers = Scm_Cons(SCM_CAR(h), handlers);
+        }
+    } else {
+        handlers_to_call = throw_cont_calculate_handlers(ep, vm);
+    }
     return throw_cont_body(handlers_to_call, ep, args);
 }
 
@@ -2316,6 +2333,31 @@ ScmObj Scm_VMCallCC(ScmObj proc)
     return Scm_VMApply1(proc, contproc);
 }
 
+static ScmObj shift_cont_cc(ScmObj result, void **data);
+
+static ScmObj shift_cont_body(ScmObj handlers, ScmObj proc, ScmObj contproc)
+{
+    ScmVM *vm = theVM;
+    if (!SCM_NULLP(handlers) && !BOUNDARY_HANDLER_P(SCM_CAR(handlers))) {
+        void *data[3];
+        data[0] = (void *)SCM_CDR(handlers);
+        data[1] = (void *)proc;
+        data[2] = (void *)contproc;
+        Scm_VMPushCC(shift_cont_cc, data, 3);
+        vm->handlers = SCM_CDR(vm->handlers);
+        return Scm_VMApply0(SCM_CDAR(handlers));
+    }
+    return Scm_VMApply1(proc, contproc);
+}
+
+static ScmObj shift_cont_cc(ScmObj result, void **data)
+{
+    ScmObj handlers = SCM_OBJ(data[0]);
+    ScmObj proc = SCM_OBJ(data[1]);
+    ScmObj contproc = SCM_OBJ(data[2]);
+    return shift_cont_body(handlers, proc, contproc);
+}
+
 /* call with partial continuation.  this corresponds to the 'shift' operator
    in shift/reset controls (Gasbichler&Sperber, "Final Shift for Call/cc",
    ICFP02.)   Note that we treat the boundary frame as the bottom of
@@ -2323,6 +2365,8 @@ ScmObj Scm_VMCallCC(ScmObj proc)
 ScmObj Scm_VMCallPC(ScmObj proc)
 {
     ScmObj contproc;
+    ScmObj handlers = SCM_NIL, handlers_tail = SCM_NIL;
+    ScmObj hp;
     ScmEscapePoint *ep;
     ScmContFrame *c, *cp;
     ScmVM *vm = theVM;
@@ -2339,13 +2383,19 @@ ScmObj Scm_VMCallPC(ScmObj proc)
          cp = c, c = c->prev)
         /*empty*/;
 
+    SCM_FOR_EACH(hp, vm->handlers) {
+        if (BOUNDARY_HANDLER_P(SCM_CAR(hp)))
+            break;
+        SCM_APPEND1(handlers, handlers_tail, SCM_CAR(hp));
+    }
+
     if (cp != NULL) cp->prev = NULL; /* cut the dynamic chain */
 
     ep = SCM_NEW(ScmEscapePoint);
     ep->prev = NULL;
     ep->ehandler = SCM_FALSE;
     ep->cont = (cp? vm->cont : NULL);
-    ep->handlers = vm->handlers;
+    ep->handlers = handlers;
     ep->cstack = NULL; /* so that the partial continuation can be run
                           on any cstack state. */
     contproc = Scm_MakeSubr(throw_continuation, ep, 0, 1,
@@ -2355,7 +2405,7 @@ ScmObj Scm_VMCallPC(ScmObj proc)
        It's ok, for a continuation pointed by cstack will be restored
        in user_eval_inner. */
     vm->cont = c;
-    return Scm_VMApply1(proc, contproc);
+    return shift_cont_body(vm->handlers, proc, contproc);
 }
 
 /*==============================================================