pic_value
pic_callcc(pic_state *pic, struct pic_proc *proc)
{
struct pic_cont cont;
pic_save_point(pic, &cont);
if (PIC_SETJMP(pic, cont.jmp)) {
return pic_values_by_list(pic, cont.results);
}
else {
pic_value val;
val = pic_apply1(pic, proc, pic_obj_value(pic_make_cont(pic, &cont)));
pic->cc = pic->cc->prev;
return val;
}
}
pic_value
pic_callcc(pic_state *pic, struct pic_proc *proc)
{
struct pic_cont *cont = pic_malloc(pic, sizeof(struct pic_cont));
pic_save_point(pic, cont);
if (PIC_SETJMP(pic, cont->jmp.buf)) {
pic->jmp = pic->jmp->prev;
return pic_values_by_list(pic, cont->results);
}
else {
pic_value val;
val = pic_apply1(pic, proc, pic_obj_value(pic_make_cont(pic, cont)));
pic->jmp = pic->jmp->prev;
return val;
}
}
pic_value
pic_start_try(pic_state *pic, PIC_JMPBUF *jmp)
{
struct cont *cont;
pic_value handler;
pic_value var, old_val, new_val;
pic_value in, out;
struct checkpoint *here;
/* call/cc */
cont = pic_alloca_cont(pic);
pic_save_point(pic, cont, jmp);
handler = pic_lambda(pic, native_exception_handler, 1, pic_make_cont(pic, cont));
/* with-exception-handler */
var = pic_ref(pic, "picrin.base", "current-exception-handlers");
old_val = pic_call(pic, var, 0);
new_val = pic_cons(pic, handler, old_val);
in = pic_lambda(pic, dynamic_set, 2, var, new_val);
out = pic_lambda(pic, dynamic_set, 2, var, old_val);
/* dynamic-wind */
pic_call(pic, in, 0); /* enter */
here = pic->cp;
pic->cp = (struct checkpoint *)pic_obj_alloc(pic, sizeof(struct checkpoint), PIC_TYPE_CP);
pic->cp->prev = here;
pic->cp->depth = here->depth + 1;
pic->cp->in = pic_proc_ptr(pic, in);
pic->cp->out = pic_proc_ptr(pic, out);
return pic_cons(pic, pic_obj_value(here), out);
}