Beispiel #1
0
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);
}
Beispiel #2
0
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;
}
Beispiel #3
0
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;
}