diff --git a/lib/error.c b/lib/error.c index 1c22960c..21118df7 100644 --- a/lib/error.c +++ b/lib/error.c @@ -43,7 +43,7 @@ pic_prepare_try(pic_state *pic) cxt->fp = NULL; cxt->sp = NULL; cxt->irep = NULL; - + cxt->conts = pic_nil_value(pic); cxt->prev = pic->cxt; pic->cxt = cxt; return &cxt->jmp; @@ -84,7 +84,11 @@ void pic_exit_try(pic_state *pic) { struct context *cxt = pic->cxt; + pic_value c, it; pic->dyn_env = pic_cdr(pic, pic->dyn_env); + pic_for_each (c, cxt->conts, it) { + proc_ptr(pic, c)->env->regs[0] = pic_false_value(pic); + } pic->cxt = cxt->prev; pic_free(pic, cxt); /* don't rewind ai here */ @@ -94,7 +98,11 @@ pic_value pic_abort_try(pic_state *pic) { struct context *cxt = pic->cxt; + pic_value c, it; pic_value err = cxt->sp->regs[1]; + pic_for_each (c, cxt->conts, it) { + proc_ptr(pic, c)->env->regs[0] = pic_false_value(pic); + } pic->cxt = cxt->prev; pic_free(pic, cxt); pic_protect(pic, err); diff --git a/lib/ext/cont.c b/lib/ext/cont.c index be1bb928..dd46d729 100644 --- a/lib/ext/cont.c +++ b/lib/ext/cont.c @@ -53,27 +53,27 @@ cont_call(pic_state *pic) { int argc; pic_value *argv, k, dyn_env; - struct context *cxt, *c; + struct context *cxt; pic_get_args(pic, "*", &argc, &argv); - cxt = pic_data(pic, pic_closure_ref(pic, 0)); - k = pic_closure_ref(pic, 1); - dyn_env = pic_closure_ref(pic, 2); - - /* check if continuation is alive */ - for (c = pic->cxt; c != NULL; c = c->prev) { - if (c == cxt) { - break; - } - } - if (c == NULL) { + if (! pic_bool(pic, pic_closure_ref(pic, 0))) { pic_error(pic, "calling dead escape continuation", 0); } + cxt = pic_data(pic, pic_closure_ref(pic, 1)); + k = pic_closure_ref(pic, 2); + dyn_env = pic_closure_ref(pic, 3); + CONTEXT_INIT(pic, cxt, k, argc, argv); - pic->cxt = cxt; + while (pic->cxt != cxt) { + pic_value c, it; + pic_for_each (c, pic->cxt->conts, it) { + proc_ptr(pic, c)->env->regs[0] = pic_false_value(pic); + } + pic->cxt = pic->cxt->prev; + } pic->dyn_env = dyn_env; longjmp(cxt->jmp, 1); @@ -84,7 +84,10 @@ pic_value pic_make_cont(pic_state *pic, pic_value k) { static const pic_data_type cxt_type = { "cxt", NULL }; - return pic_lambda(pic, cont_call, 3, pic_data_value(pic, pic->cxt, &cxt_type), k, pic->dyn_env); + pic_value c; + c = pic_lambda(pic, cont_call, 4, pic_true_value(pic), pic_data_value(pic, pic->cxt, &cxt_type), k, pic->dyn_env); + pic->cxt->conts = pic_cons(pic, c, pic->cxt->conts); + return c; } static pic_value diff --git a/lib/gc.c b/lib/gc.c index e5c558a0..2e995436 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -329,6 +329,7 @@ gc_mark_phase(pic_state *pic) if (cxt->fp) gc_mark_object(pic, (struct object *)cxt->fp); if (cxt->sp) gc_mark_object(pic, (struct object *)cxt->sp); if (cxt->irep) gc_mark_object(pic, (struct object *)cxt->irep); + gc_mark(pic, cxt->conts); } /* arena */ diff --git a/lib/proc.c b/lib/proc.c index ed9e1a06..3ef120e4 100644 --- a/lib/proc.c +++ b/lib/proc.c @@ -567,6 +567,7 @@ pic_vm(pic_state *pic, struct context *cxt) assert(cxt->fp == NULL); assert(cxt->irep == NULL); + cxt->conts = pic_nil_value(pic); cxt->prev = pic->cxt; pic->cxt = cxt; @@ -608,6 +609,10 @@ pic_vm(pic_state *pic, struct context *cxt) VM_LOOP { CASE(OP_HALT) { + pic_value c, it; + pic_for_each (c, pic->cxt->conts, it) { + proc_ptr(pic, c)->env->regs[0] = pic_false_value(pic); + } pic->cxt = pic->cxt->prev; return; } diff --git a/lib/state.c b/lib/state.c index dc017ce6..5af3580c 100644 --- a/lib/state.c +++ b/lib/state.c @@ -177,6 +177,7 @@ pic_open(pic_allocf allocf, void *userdata) pic->default_cxt.sp = NULL; pic->default_cxt.irep = NULL; pic->default_cxt.prev = NULL; + pic->default_cxt.conts = pic_nil_value(pic); pic->cxt = &pic->default_cxt; /* arena */ diff --git a/lib/state.h b/lib/state.h index 8d23ee02..c25c12ee 100644 --- a/lib/state.h +++ b/lib/state.h @@ -25,6 +25,7 @@ struct context { struct irep *irep; code_t tmpcode[2]; + pic_value conts; struct context *prev; };