static pic_value
pic_reg_make_register(pic_state *pic)
{
struct pic_reg *reg;
struct pic_proc *proc;
pic_get_args(pic, "");
reg = pic_make_reg(pic);
proc = pic_make_proc(pic, reg_call);
pic_proc_env_set(pic, proc, "reg", pic_obj_value(reg));
return pic_obj_value(proc);
}
struct pic_proc *
pic_make_cont(pic_state *pic, struct pic_cont *cont)
{
static const pic_data_type cont_type = { "cont", pic_free, NULL };
struct pic_proc *c;
struct pic_data *e;
c = pic_make_proc(pic, cont_call, "<cont-procedure>");
e = pic_data_alloc(pic, &cont_type, cont);
/* save the escape continuation in proc */
pic_proc_env_set(pic, c, "escape", pic_obj_value(e));
return c;
}
void
pic_push_try(pic_state *pic, struct pic_escape *escape)
{
struct pic_proc *cont, *handler;
size_t xp_len;
ptrdiff_t xp_offset;
cont = pic_make_econt(pic, escape);
handler = pic_make_proc(pic, native_exception_handler, "(native-exception-handler)");
pic_attr_set(pic, pic_obj_value(handler), "@@escape", pic_obj_value(cont));
if (pic->xp >= pic->xpend) {
xp_len = (size_t)(pic->xpend - pic->xpbase) * 2;
xp_offset = pic->xp - pic->xpbase;
pic->xpbase = pic_realloc(pic, pic->xpbase, sizeof(struct pic_proc *) * xp_len);
pic->xp = pic->xpbase + xp_offset;
pic->xpend = pic->xpbase + xp_len;
}
*pic->xp++ = handler;
}