Esempio n. 1
0
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;
  }
}
Esempio n. 2
0
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;
  }
}
Esempio n. 3
0
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);
}