pic_value pic_dynamic_wind(pic_state *pic, struct pic_proc *in, struct pic_proc *thunk, struct pic_proc *out) { pic_checkpoint *here; pic_value val; if (in != NULL) { pic_apply0(pic, in); /* enter */ } here = pic->cp; pic->cp = pic_malloc(pic, sizeof(pic_checkpoint)); pic->cp->prev = here; pic->cp->depth = here->depth + 1; pic->cp->in = in; pic->cp->out = out; val = pic_apply0(pic, thunk); pic->cp = here; if (out != NULL) { pic_apply0(pic, out); /* exit */ } return val; }
void pic_wind(pic_state *pic, pic_checkpoint *here, pic_checkpoint *there) { if (here == there) return; if (here->depth < there->depth) { pic_wind(pic, here, there->prev); pic_apply0(pic, there->in); } else { pic_apply0(pic, there->out); pic_wind(pic, here->prev, there); } }
static pic_value pic_error_with_exception_handler(pic_state *pic) { struct pic_proc *handler, *thunk; pic_value val; size_t xp_len; ptrdiff_t xp_offset; pic_get_args(pic, "ll", &handler, &thunk); 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; val = pic_apply0(pic, thunk); --pic->xp; return val; }
void pic_close(pic_state *pic) { xh_entry *it; /* invoke exit handlers */ while (pic->wind) { if (pic->wind->out) { pic_apply0(pic, pic->wind->out); } pic->wind = pic->wind->prev; } /* free symbol names */ for (it = xh_begin(&pic->syms); it != NULL; it = xh_next(it)) { free(xh_key(it, char *)); } /* clear out root objects */ pic->sp = pic->stbase; pic->ci = pic->cibase; pic->xp = pic->xpbase; pic->arena_idx = 0; pic->err = pic_undef_value(); pic->globals = NULL; pic->macros = NULL; xh_clear(&pic->syms); xh_clear(&pic->attrs); pic->features = pic_nil_value(); pic->libs = pic_nil_value(); /* free all heap objects */ pic_gc_run(pic); /* free heaps */ pic_heap_close(pic->heap); /* free runtime context */ free(pic->stbase); free(pic->cibase); free(pic->xpbase); /* free reader struct */ xh_destroy(&pic->reader->labels); pic_trie_delete(pic, pic->reader->trie); free(pic->reader); /* free global stacks */ xh_destroy(&pic->syms); xh_destroy(&pic->attrs); /* free GC arena */ free(pic->arena); free(pic); }
static pic_value pic_error_with_exception_handler(pic_state *pic) { struct pic_proc *handler, *thunk; pic_value val; pic_get_args(pic, "ll", &handler, &thunk); pic_push_handler(pic, handler); val = pic_apply0(pic, thunk); pic_pop_handler(pic); return val; }
static pic_value pic_cont_call_with_values(pic_state *pic) { struct pic_proc *producer, *consumer; int argc; pic_vec *args; pic_get_args(pic, "ll", &producer, &consumer); pic_apply0(pic, producer); argc = pic_receive(pic, 0, NULL); args = pic_make_vec(pic, argc); pic_receive(pic, argc, args->data); return pic_apply_trampoline(pic, consumer, argc, args->data); }