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; }