static pic_value
pic_port_call_with_port(pic_state *pic)
{
struct pic_port *port;
struct pic_proc *proc;
pic_value value;
pic_get_args(pic, "pl", &port, &proc);
value = pic_apply1(pic, proc, pic_obj_value(port));
pic_close_port(pic, port);
return value;
}
pic_value
pic_native_exception_handler(pic_state *pic)
{
pic_value err;
struct pic_proc *cont;
pic_get_args(pic, "o", &err);
pic->err = err;
cont = pic_proc_ptr(pic_proc_env_ref(pic, pic_get_proc(pic), "cont"));
pic_apply1(pic, cont, pic_false_value());
PIC_UNREACHABLE();
}
pic_value
pic_raise_continuable(pic_state *pic, pic_value err)
{
struct pic_proc *handler;
pic_value v;
handler = pic_pop_handler(pic);
pic_gc_protect(pic, pic_obj_value(handler));
v = pic_apply1(pic, handler, err);
pic_push_handler(pic, handler);
return v;
}
static pic_value
native_exception_handler(pic_state *pic)
{
pic_value err;
struct pic_proc *cont;
pic_get_args(pic, "o", &err);
pic->err = err;
cont = pic_proc_ptr(pic_attr_ref(pic, pic_obj_value(pic_get_proc(pic)), "@@escape"));
pic_apply1(pic, cont, pic_false_value());
PIC_UNREACHABLE();
}
pic_value
pic_raise_continuable(pic_state *pic, pic_value err)
{
struct pic_proc *handler;
pic_value v;
if (pic->xp == pic->xpbase) {
pic_panic(pic, "no exception handler registered");
}
handler = *--pic->xp;
pic_gc_protect(pic, pic_obj_value(handler));
v = pic_apply1(pic, handler, err);
*pic->xp++ = handler;
return v;
}
static pic_value
pic_dict_dictionary_for_each(pic_state *pic)
{
struct pic_proc *proc;
struct pic_dict *dict;
khiter_t it;
khash_t(dict) *kh;
pic_get_args(pic, "ld", &proc, &dict);
kh = &dict->hash;
for (it = kh_begin(kh); it != kh_end(kh); ++it) {
if (kh_exist(kh, it)) {
pic_apply1(pic, proc, pic_obj_value(kh_key(kh, it)));
}
}
return pic_undef_value();
}
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;
}
}
