Merge branch 'exception-handling-and-dynamic-wind'
This commit is contained in:
Yuichi Nishiwaki
commit
7e3d33d86c
60
cont.c
60
cont.c
|
|
@ -121,7 +121,7 @@ save_cont(pic_state *pic, struct pic_cont **c)
|
|||
|
||||
cont = *c = (struct pic_cont *)pic_obj_alloc(pic, sizeof(struct pic_cont), PIC_TT_CONT);
|
||||
|
||||
cont->blk = pic->blk;
|
||||
cont->wind = pic->wind;
|
||||
|
||||
cont->stk_len = native_stack_length(pic, &pos);
|
||||
cont->stk_pos = pos;
|
||||
|
|
@ -131,14 +131,19 @@ save_cont(pic_state *pic, struct pic_cont **c)
|
|||
|
||||
cont->sp_offset = pic->sp - pic->stbase;
|
||||
cont->st_len = pic->stend - pic->stbase;
|
||||
cont->st_ptr = (pic_value *)pic_alloc(pic, sizeof(pic_value) * cont->st_len);
|
||||
cont->st_ptr = pic_alloc(pic, sizeof(pic_value) * cont->st_len);
|
||||
memcpy(cont->st_ptr, pic->stbase, sizeof(pic_value) * cont->st_len);
|
||||
|
||||
cont->ci_offset = pic->ci - pic->cibase;
|
||||
cont->ci_len = pic->ciend - pic->cibase;
|
||||
cont->ci_ptr = (pic_callinfo *)pic_alloc(pic, sizeof(pic_callinfo) * cont->ci_len);
|
||||
cont->ci_ptr = pic_alloc(pic, sizeof(pic_callinfo) * cont->ci_len);
|
||||
memcpy(cont->ci_ptr, pic->cibase, sizeof(pic_callinfo) * cont->ci_len);
|
||||
|
||||
cont->xp_offset = pic->xp - pic->xpbase;
|
||||
cont->xp_len = pic->xpend - pic->xpbase;
|
||||
cont->xp_ptr = pic_alloc(pic, sizeof(struct pic_proc *) * cont->xp_len);
|
||||
memcpy(cont->xp_ptr, pic->xpbase, sizeof(struct pic_proc *) * cont->xp_len);
|
||||
|
||||
cont->ip = pic->ip;
|
||||
|
||||
cont->arena_idx = pic->arena_idx;
|
||||
|
|
@ -146,11 +151,6 @@ save_cont(pic_state *pic, struct pic_cont **c)
|
|||
cont->arena = (struct pic_object **)pic_alloc(pic, sizeof(struct pic_object *) * pic->arena_size);
|
||||
memcpy(cont->arena, pic->arena, sizeof(struct pic_object *) * pic->arena_size);
|
||||
|
||||
cont->try_jmp_idx = pic->try_jmp_idx;
|
||||
cont->try_jmp_size = pic->try_jmp_size;
|
||||
cont->try_jmps = pic_alloc(pic, sizeof(struct pic_jmpbuf) * pic->try_jmp_size);
|
||||
memcpy(cont->try_jmps, pic->try_jmps, sizeof(struct pic_jmpbuf) * pic->try_jmp_size);
|
||||
|
||||
cont->results = pic_undef_value();
|
||||
}
|
||||
|
||||
|
|
@ -168,7 +168,6 @@ restore_cont(pic_state *pic, struct pic_cont *cont)
|
|||
{
|
||||
char v;
|
||||
struct pic_cont *tmp = cont;
|
||||
struct pic_block *blk;
|
||||
|
||||
if (&v < pic->native_stack_start) {
|
||||
if (&v > cont->stk_pos) native_stack_extend(pic, cont);
|
||||
|
|
@ -177,19 +176,23 @@ restore_cont(pic_state *pic, struct pic_cont *cont)
|
|||
if (&v > cont->stk_pos + cont->stk_len) native_stack_extend(pic, cont);
|
||||
}
|
||||
|
||||
blk = pic->blk;
|
||||
pic->blk = cont->blk;
|
||||
pic->wind = cont->wind;
|
||||
|
||||
pic->stbase = (pic_value *)pic_realloc(pic, pic->stbase, sizeof(pic_value) * cont->st_len);
|
||||
pic->stbase = pic_realloc(pic, pic->stbase, sizeof(pic_value) * cont->st_len);
|
||||
memcpy(pic->stbase, cont->st_ptr, sizeof(pic_value) * cont->st_len);
|
||||
pic->sp = pic->stbase + cont->sp_offset;
|
||||
pic->stend = pic->stbase + cont->st_len;
|
||||
|
||||
pic->cibase = (pic_callinfo *)pic_realloc(pic, pic->cibase, sizeof(pic_callinfo) * cont->ci_len);
|
||||
pic->cibase = pic_realloc(pic, pic->cibase, sizeof(pic_callinfo) * cont->ci_len);
|
||||
memcpy(pic->cibase, cont->ci_ptr, sizeof(pic_callinfo) * cont->ci_len);
|
||||
pic->ci = pic->cibase + cont->ci_offset;
|
||||
pic->ciend = pic->cibase + cont->ci_len;
|
||||
|
||||
pic->xpbase = pic_realloc(pic, pic->xpbase, sizeof(struct pic_proc *) * cont->xp_len);
|
||||
memcpy(pic->xpbase, cont->xp_ptr, sizeof(struct pic_proc *) * cont->xp_len);
|
||||
pic->xp = pic->xpbase + cont->xp_offset;
|
||||
pic->xpend = pic->xpbase + cont->xp_len;
|
||||
|
||||
pic->ip = cont->ip;
|
||||
|
||||
pic->arena = (struct pic_object **)pic_realloc(pic, pic->arena, sizeof(struct pic_object *) * cont->arena_size);
|
||||
|
|
@ -197,52 +200,47 @@ restore_cont(pic_state *pic, struct pic_cont *cont)
|
|||
pic->arena_size = cont->arena_size;
|
||||
pic->arena_idx = cont->arena_idx;
|
||||
|
||||
pic->try_jmps = pic_realloc(pic, pic->try_jmps, sizeof(struct pic_jmpbuf) * cont->try_jmp_size);
|
||||
memcpy(pic->try_jmps, cont->try_jmps, sizeof(struct pic_jmpbuf) * cont->try_jmp_size);
|
||||
pic->try_jmp_size = cont->try_jmp_size;
|
||||
pic->try_jmp_idx = cont->try_jmp_idx;
|
||||
|
||||
memcpy(cont->stk_pos, cont->stk_ptr, cont->stk_len);
|
||||
|
||||
longjmp(tmp->jmp, 1);
|
||||
}
|
||||
|
||||
static void
|
||||
walk_to_block(pic_state *pic, struct pic_block *here, struct pic_block *there)
|
||||
void
|
||||
pic_wind(pic_state *pic, struct pic_winder *here, struct pic_winder *there)
|
||||
{
|
||||
if (here == there)
|
||||
return;
|
||||
|
||||
if (here->depth < there->depth) {
|
||||
walk_to_block(pic, here, there->prev);
|
||||
pic_wind(pic, here, there->prev);
|
||||
pic_apply0(pic, there->in);
|
||||
}
|
||||
else {
|
||||
pic_apply0(pic, there->out);
|
||||
walk_to_block(pic, here->prev, there);
|
||||
pic_wind(pic, here->prev, there);
|
||||
}
|
||||
}
|
||||
|
||||
static pic_value
|
||||
pic_dynamic_wind(pic_state *pic, struct pic_proc *in, struct pic_proc *thunk, struct pic_proc *out)
|
||||
{
|
||||
struct pic_block *here;
|
||||
struct pic_winder *here;
|
||||
pic_value val;
|
||||
|
||||
if (in != NULL) {
|
||||
pic_apply0(pic, in); /* enter */
|
||||
}
|
||||
|
||||
here = pic->blk;
|
||||
pic->blk = (struct pic_block *)pic_obj_alloc(pic, sizeof(struct pic_block), PIC_TT_BLK);
|
||||
pic->blk->prev = here;
|
||||
pic->blk->depth = here->depth + 1;
|
||||
pic->blk->in = in;
|
||||
pic->blk->out = out;
|
||||
here = pic->wind;
|
||||
pic->wind = pic_alloc(pic, sizeof(struct pic_winder));
|
||||
pic->wind->prev = here;
|
||||
pic->wind->depth = here->depth + 1;
|
||||
pic->wind->in = in;
|
||||
pic->wind->out = out;
|
||||
|
||||
val = pic_apply0(pic, thunk);
|
||||
|
||||
pic->blk = here;
|
||||
pic->wind = here;
|
||||
|
||||
if (out != NULL) {
|
||||
pic_apply0(pic, out); /* exit */
|
||||
|
|
@ -266,7 +264,7 @@ cont_call(pic_state *pic)
|
|||
cont->results = pic_list_by_array(pic, argc, argv);
|
||||
|
||||
/* execute guard handlers */
|
||||
walk_to_block(pic, pic->blk, cont->blk);
|
||||
pic_wind(pic, pic->wind, cont->wind);
|
||||
|
||||
restore_cont(pic, cont);
|
||||
}
|
||||
|
|
|
|||
199
error.c
199
error.c
|
|
@ -8,6 +8,8 @@
|
|||
|
||||
#include "picrin.h"
|
||||
#include "picrin/pair.h"
|
||||
#include "picrin/proc.h"
|
||||
#include "picrin/cont.h"
|
||||
#include "picrin/string.h"
|
||||
#include "picrin/error.h"
|
||||
|
||||
|
|
@ -34,41 +36,94 @@ pic_warnf(pic_state *pic, const char *fmt, ...)
|
|||
}
|
||||
|
||||
void
|
||||
pic_push_try(pic_state *pic, struct pic_proc *handler)
|
||||
pic_errorf(pic_state *pic, const char *fmt, ...)
|
||||
{
|
||||
struct pic_jmpbuf *try_jmp;
|
||||
va_list ap;
|
||||
pic_value err_line, irrs;
|
||||
const char *msg;
|
||||
|
||||
if (pic->try_jmp_idx >= pic->try_jmp_size) {
|
||||
pic->try_jmp_size *= 2;
|
||||
pic->try_jmps = pic_realloc(pic, pic->try_jmps, sizeof(struct pic_jmpbuf) * pic->try_jmp_size);
|
||||
va_start(ap, fmt);
|
||||
err_line = pic_xvformat(pic, fmt, ap);
|
||||
va_end(ap);
|
||||
|
||||
msg = pic_str_cstr(pic_str_ptr(pic_car(pic, err_line)));
|
||||
irrs = pic_cdr(pic, err_line);
|
||||
|
||||
pic_error(pic, msg, irrs);
|
||||
}
|
||||
|
||||
const char *
|
||||
pic_errmsg(pic_state *pic)
|
||||
{
|
||||
pic_str *str;
|
||||
|
||||
assert(! pic_undef_p(pic->err));
|
||||
|
||||
if (! pic_error_p(pic->err)) {
|
||||
str = pic_format(pic, "~s", pic->err);
|
||||
} else {
|
||||
str = pic_error_ptr(pic->err)->msg;
|
||||
}
|
||||
|
||||
try_jmp = pic->try_jmps + pic->try_jmp_idx++;
|
||||
return pic_str_cstr(str);
|
||||
}
|
||||
|
||||
try_jmp->handler = handler;
|
||||
static pic_value
|
||||
native_exception_handler(pic_state *pic)
|
||||
{
|
||||
pic_value err;
|
||||
struct pic_proc *cont;
|
||||
|
||||
try_jmp->ci_offset = pic->ci - pic->cibase;
|
||||
try_jmp->sp_offset = pic->sp - pic->stbase;
|
||||
try_jmp->ip = pic->ip;
|
||||
pic_get_args(pic, "o", &err);
|
||||
|
||||
try_jmp->prev_jmp = pic->jmp;
|
||||
pic->jmp = &try_jmp->here;
|
||||
pic->err = err;
|
||||
|
||||
cont = pic_proc_ptr(pic_attr_ref(pic, pic_get_proc(pic), "@@escape"));
|
||||
|
||||
pic_apply1(pic, cont, pic_false_value());
|
||||
|
||||
UNREACHABLE();
|
||||
}
|
||||
|
||||
static pic_value
|
||||
native_push_try(pic_state *pic)
|
||||
{
|
||||
struct pic_proc *cont, *handler;
|
||||
size_t xp_len, xp_offset;
|
||||
|
||||
pic_get_args(pic, "l", &cont);
|
||||
|
||||
handler = pic_make_proc(pic, native_exception_handler, "(native-exception-handler)");
|
||||
|
||||
pic_attr_set(pic, handler, "@@escape", pic_obj_value(cont));
|
||||
|
||||
if (pic->xp >= pic->xpend) {
|
||||
xp_len = (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;
|
||||
|
||||
return pic_true_value();
|
||||
}
|
||||
|
||||
bool
|
||||
pic_push_try(pic_state *pic)
|
||||
{
|
||||
pic_value val;
|
||||
|
||||
val = pic_callcc(pic, pic_make_proc(pic, native_push_try, "(native-push-try)"));
|
||||
|
||||
return pic_test(val);
|
||||
}
|
||||
|
||||
void
|
||||
pic_pop_try(pic_state *pic)
|
||||
{
|
||||
struct pic_jmpbuf *try_jmp;
|
||||
|
||||
try_jmp = pic->try_jmps + --pic->try_jmp_idx;
|
||||
|
||||
/* assert(pic->jmp == &try_jmp->here); */
|
||||
|
||||
pic->ci = try_jmp->ci_offset + pic->cibase;
|
||||
pic->sp = try_jmp->sp_offset + pic->stbase;
|
||||
pic->ip = try_jmp->ip;
|
||||
|
||||
pic->jmp = try_jmp->prev_jmp;
|
||||
--pic->xp;
|
||||
}
|
||||
|
||||
struct pic_error *
|
||||
|
|
@ -88,20 +143,37 @@ pic_make_error(pic_state *pic, pic_sym type, const char *msg, pic_value irrs)
|
|||
return e;
|
||||
}
|
||||
|
||||
pic_value
|
||||
pic_raise_continuable(pic_state *pic, pic_value err)
|
||||
{
|
||||
struct pic_proc *handler;
|
||||
pic_value v;
|
||||
|
||||
if (pic->xp == pic->xpbase) {
|
||||
pic_panic(pic, "no exception handler registered");
|
||||
}
|
||||
|
||||
handler = *--pic->xp;
|
||||
|
||||
pic_gc_protect(pic, pic_obj_value(handler));
|
||||
|
||||
v = pic_apply1(pic, handler, err);
|
||||
|
||||
*pic->xp++ = handler;
|
||||
|
||||
return v;
|
||||
}
|
||||
|
||||
noreturn void
|
||||
pic_raise(pic_state *pic, pic_value err)
|
||||
{
|
||||
void pic_vm_tear_off(pic_state *);
|
||||
pic_value val;
|
||||
|
||||
pic_vm_tear_off(pic); /* tear off */
|
||||
val = pic_raise_continuable(pic, err);
|
||||
|
||||
pic->err = err;
|
||||
if (! pic->jmp) {
|
||||
puts(pic_errmsg(pic));
|
||||
pic_panic(pic, "no handler found on stack");
|
||||
}
|
||||
pic_pop_try(pic);
|
||||
|
||||
longjmp(*pic->jmp, 1);
|
||||
pic_errorf(pic, "error handler returned with ~s on error ~s", val, err);
|
||||
}
|
||||
|
||||
noreturn void
|
||||
|
|
@ -120,59 +192,29 @@ pic_error(pic_state *pic, const char *msg, pic_value irrs)
|
|||
pic_throw(pic, pic_intern_cstr(pic, ""), msg, irrs);
|
||||
}
|
||||
|
||||
const char *
|
||||
pic_errmsg(pic_state *pic)
|
||||
{
|
||||
pic_str *str;
|
||||
|
||||
assert(! pic_undef_p(pic->err));
|
||||
|
||||
if (! pic_error_p(pic->err)) {
|
||||
str = pic_format(pic, "~s", pic->err);
|
||||
} else {
|
||||
str = pic_error_ptr(pic->err)->msg;
|
||||
}
|
||||
|
||||
return pic_str_cstr(str);
|
||||
}
|
||||
|
||||
void
|
||||
pic_errorf(pic_state *pic, const char *fmt, ...)
|
||||
{
|
||||
va_list ap;
|
||||
pic_value err_line, irrs;
|
||||
const char *msg;
|
||||
|
||||
va_start(ap, fmt);
|
||||
err_line = pic_xvformat(pic, fmt, ap);
|
||||
va_end(ap);
|
||||
|
||||
msg = pic_str_cstr(pic_str_ptr(pic_car(pic, err_line)));
|
||||
irrs = pic_cdr(pic, err_line);
|
||||
|
||||
pic_error(pic, msg, irrs);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
pic_error_with_exception_handler(pic_state *pic)
|
||||
{
|
||||
struct pic_proc *handler, *thunk;
|
||||
pic_value val;
|
||||
size_t xp_len, xp_offset;
|
||||
|
||||
pic_get_args(pic, "ll", &handler, &thunk);
|
||||
|
||||
pic_try_with_handler(handler) {
|
||||
val = pic_apply0(pic, thunk);
|
||||
if (pic->xp >= pic->xpend) {
|
||||
xp_len = (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_catch {
|
||||
pic_value e = pic->err;
|
||||
|
||||
pic->err = pic_undef_value();
|
||||
*pic->xp++ = handler;
|
||||
|
||||
val = pic_apply1(pic, handler, e);
|
||||
val = pic_apply0(pic, thunk);
|
||||
|
||||
--pic->xp;
|
||||
|
||||
pic_errorf(pic, "error handler returned with ~s on error ~s", val, e);
|
||||
}
|
||||
return val;
|
||||
}
|
||||
|
||||
|
|
@ -193,18 +235,7 @@ pic_error_raise_continuable(pic_state *pic)
|
|||
|
||||
pic_get_args(pic, "o", &v);
|
||||
|
||||
if (pic->try_jmp_idx == 0) {
|
||||
pic_errorf(pic, "no exception handler registered");
|
||||
}
|
||||
if (pic->try_jmps[pic->try_jmp_idx - 1].handler == NULL) {
|
||||
pic_errorf(pic, "uncontinuable exception handler is on top");
|
||||
}
|
||||
else {
|
||||
pic->try_jmp_idx--;
|
||||
v = pic_apply1(pic, pic->try_jmps[pic->try_jmp_idx].handler, v);
|
||||
++pic->try_jmp_idx;
|
||||
}
|
||||
return v;
|
||||
return pic_raise_continuable(pic, v);
|
||||
}
|
||||
|
||||
noreturn static pic_value
|
||||
|
|
|
|||
74
gc.c
74
gc.c
|
|
@ -333,6 +333,20 @@ gc_unmark(union header *p)
|
|||
p->s.mark = PIC_GC_UNMARK;
|
||||
}
|
||||
|
||||
static void
|
||||
gc_mark_winder(pic_state *pic, struct pic_winder *wind)
|
||||
{
|
||||
if (wind->prev) {
|
||||
gc_mark_object(pic, (struct pic_object *)wind->prev);
|
||||
}
|
||||
if (wind->in) {
|
||||
gc_mark_object(pic, (struct pic_object *)wind->in);
|
||||
}
|
||||
if (wind->out) {
|
||||
gc_mark_object(pic, (struct pic_object *)wind->out);
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
gc_mark_object(pic_state *pic, struct pic_object *obj)
|
||||
{
|
||||
|
|
@ -402,10 +416,11 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
|
|||
struct pic_cont *cont = (struct pic_cont *)obj;
|
||||
pic_value *stack;
|
||||
pic_callinfo *ci;
|
||||
struct pic_proc **xhandler;
|
||||
size_t i;
|
||||
|
||||
/* block */
|
||||
gc_mark_object(pic, (struct pic_object *)cont->blk);
|
||||
/* winder */
|
||||
gc_mark_winder(pic, cont->wind);
|
||||
|
||||
/* stack */
|
||||
for (stack = cont->st_ptr; stack != cont->st_ptr + cont->sp_offset; ++stack) {
|
||||
|
|
@ -419,18 +434,16 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
|
|||
}
|
||||
}
|
||||
|
||||
/* exception handlers */
|
||||
for (xhandler = cont->xp_ptr; xhandler != cont->xp_ptr + cont->xp_offset; ++xhandler) {
|
||||
gc_mark_object(pic, (struct pic_object *)*xhandler);
|
||||
}
|
||||
|
||||
/* arena */
|
||||
for (i = 0; i < (size_t)cont->arena_idx; ++i) {
|
||||
gc_mark_object(pic, cont->arena[i]);
|
||||
}
|
||||
|
||||
/* error handlers */
|
||||
for (i = 0; i < cont->try_jmp_idx; ++i) {
|
||||
if (cont->try_jmps[i].handler) {
|
||||
gc_mark_object(pic, (struct pic_object *)cont->try_jmps[i].handler);
|
||||
}
|
||||
}
|
||||
|
||||
/* result values */
|
||||
gc_mark(pic, cont->results);
|
||||
break;
|
||||
|
|
@ -504,20 +517,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
|
|||
}
|
||||
break;
|
||||
}
|
||||
case PIC_TT_BLK: {
|
||||
struct pic_block *blk = (struct pic_block *)obj;
|
||||
|
||||
if (blk->prev) {
|
||||
gc_mark_object(pic, (struct pic_object *)blk->prev);
|
||||
}
|
||||
if (blk->in) {
|
||||
gc_mark_object(pic, (struct pic_object *)blk->in);
|
||||
}
|
||||
if (blk->out) {
|
||||
gc_mark_object(pic, (struct pic_object *)blk->out);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case PIC_TT_NIL:
|
||||
case PIC_TT_BOOL:
|
||||
case PIC_TT_FLOAT:
|
||||
|
|
@ -562,12 +561,13 @@ gc_mark_phase(pic_state *pic)
|
|||
{
|
||||
pic_value *stack;
|
||||
pic_callinfo *ci;
|
||||
size_t i, j;
|
||||
struct pic_proc **xhandler;
|
||||
size_t j;
|
||||
xh_entry *it;
|
||||
|
||||
/* block */
|
||||
if (pic->blk) {
|
||||
gc_mark_object(pic, (struct pic_object *)pic->blk);
|
||||
/* winder */
|
||||
if (pic->wind) {
|
||||
gc_mark_winder(pic, pic->wind);
|
||||
}
|
||||
|
||||
/* stack */
|
||||
|
|
@ -582,8 +582,10 @@ gc_mark_phase(pic_state *pic)
|
|||
}
|
||||
}
|
||||
|
||||
/* error object */
|
||||
gc_mark(pic, pic->err);
|
||||
/* exception handlers */
|
||||
for (xhandler = pic->xpbase; xhandler != pic->xp; ++xhandler) {
|
||||
gc_mark_object(pic, (struct pic_object *)*xhandler);
|
||||
}
|
||||
|
||||
/* arena */
|
||||
for (j = 0; j < pic->arena_idx; ++j) {
|
||||
|
|
@ -600,13 +602,10 @@ gc_mark_phase(pic_state *pic)
|
|||
gc_mark_object(pic, xh_val(it, struct pic_object *));
|
||||
}
|
||||
|
||||
/* error handlers */
|
||||
for (i = 0; i < pic->try_jmp_idx; ++i) {
|
||||
if (pic->try_jmps[i].handler) {
|
||||
gc_mark_object(pic, (struct pic_object *)pic->try_jmps[i].handler);
|
||||
}
|
||||
}
|
||||
/* error object */
|
||||
gc_mark(pic, pic->err);
|
||||
|
||||
/* features */
|
||||
gc_mark(pic, pic->features);
|
||||
|
||||
/* readers */
|
||||
|
|
@ -669,8 +668,8 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
|
|||
pic_free(pic, cont->stk_ptr);
|
||||
pic_free(pic, cont->st_ptr);
|
||||
pic_free(pic, cont->ci_ptr);
|
||||
pic_free(pic, cont->xp_ptr);
|
||||
pic_free(pic, cont->arena);
|
||||
pic_free(pic, cont->try_jmps);
|
||||
break;
|
||||
}
|
||||
case PIC_TT_SENV: {
|
||||
|
|
@ -709,9 +708,6 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
|
|||
xh_destroy(&rec->hash);
|
||||
break;
|
||||
}
|
||||
case PIC_TT_BLK: {
|
||||
break;
|
||||
}
|
||||
case PIC_TT_NIL:
|
||||
case PIC_TT_BOOL:
|
||||
case PIC_TT_FLOAT:
|
||||
|
|
|
|||
|
|
@ -46,6 +46,13 @@ extern "C" {
|
|||
|
||||
typedef struct pic_code pic_code;
|
||||
|
||||
struct pic_winder {
|
||||
struct pic_proc *in;
|
||||
struct pic_proc *out;
|
||||
int depth;
|
||||
struct pic_winder *prev;
|
||||
};
|
||||
|
||||
typedef struct {
|
||||
int argc, retc;
|
||||
pic_code *ip;
|
||||
|
|
@ -60,7 +67,7 @@ typedef struct {
|
|||
int argc;
|
||||
char **argv, **envp;
|
||||
|
||||
struct pic_block *blk;
|
||||
struct pic_winder *wind;
|
||||
|
||||
pic_value *sp;
|
||||
pic_value *stbase, *stend;
|
||||
|
|
@ -68,6 +75,9 @@ typedef struct {
|
|||
pic_callinfo *ci;
|
||||
pic_callinfo *cibase, *ciend;
|
||||
|
||||
struct pic_proc **xp;
|
||||
struct pic_proc **xpbase, **xpend;
|
||||
|
||||
pic_code *ip;
|
||||
|
||||
struct pic_lib *lib;
|
||||
|
|
@ -104,17 +114,14 @@ typedef struct {
|
|||
|
||||
struct pic_reader *reader;
|
||||
|
||||
jmp_buf *jmp;
|
||||
pic_value err;
|
||||
struct pic_jmpbuf *try_jmps;
|
||||
size_t try_jmp_size, try_jmp_idx;
|
||||
|
||||
struct pic_heap *heap;
|
||||
struct pic_object **arena;
|
||||
size_t arena_size, arena_idx;
|
||||
|
||||
struct pic_port *xSTDIN, *xSTDOUT, *xSTDERR;
|
||||
|
||||
pic_value err;
|
||||
|
||||
char *native_stack_start;
|
||||
} pic_state;
|
||||
|
||||
|
|
|
|||
|
|
@ -9,18 +9,11 @@
|
|||
extern "C" {
|
||||
#endif
|
||||
|
||||
struct pic_block {
|
||||
PIC_OBJECT_HEADER
|
||||
struct pic_block *prev;
|
||||
int depth;
|
||||
struct pic_proc *in, *out;
|
||||
};
|
||||
|
||||
struct pic_cont {
|
||||
PIC_OBJECT_HEADER
|
||||
jmp_buf jmp;
|
||||
|
||||
struct pic_block *blk;
|
||||
struct pic_winder *wind;
|
||||
|
||||
char *stk_pos, *stk_ptr;
|
||||
ptrdiff_t stk_len;
|
||||
|
|
@ -31,15 +24,15 @@ struct pic_cont {
|
|||
pic_callinfo *ci_ptr;
|
||||
size_t ci_offset, ci_len;
|
||||
|
||||
struct pic_proc **xp_ptr;
|
||||
size_t xp_offset, xp_len;
|
||||
|
||||
pic_code *ip;
|
||||
|
||||
struct pic_object **arena;
|
||||
size_t arena_size;
|
||||
int arena_idx;
|
||||
|
||||
struct pic_jmpbuf *try_jmps;
|
||||
size_t try_jmp_idx, try_jmp_size;
|
||||
|
||||
pic_value results;
|
||||
};
|
||||
|
||||
|
|
@ -54,6 +47,7 @@ pic_value pic_values_by_list(pic_state *, pic_value);
|
|||
size_t pic_receive(pic_state *, size_t, pic_value *);
|
||||
|
||||
pic_value pic_callcc(pic_state *, struct pic_proc *);
|
||||
void pic_wind(pic_state *, struct pic_winder *, struct pic_winder *);
|
||||
|
||||
#if defined(__cplusplus)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -9,35 +9,6 @@
|
|||
extern "C" {
|
||||
#endif
|
||||
|
||||
struct pic_jmpbuf {
|
||||
jmp_buf here;
|
||||
struct pic_proc *handler;
|
||||
ptrdiff_t ci_offset;
|
||||
ptrdiff_t sp_offset;
|
||||
pic_code *ip;
|
||||
jmp_buf *prev_jmp;
|
||||
};
|
||||
|
||||
/* do not return from try block! */
|
||||
|
||||
#define pic_try \
|
||||
pic_try_with_handler(NULL)
|
||||
#define pic_try_with_handler(handler) \
|
||||
pic_push_try(pic, handler); \
|
||||
if (setjmp(*pic->jmp) == 0) \
|
||||
do
|
||||
#define pic_catch \
|
||||
while (pic_pop_try(pic), 0); \
|
||||
else \
|
||||
if (pic_pop_try(pic), 1)
|
||||
|
||||
void pic_push_try(pic_state *, struct pic_proc *);
|
||||
void pic_pop_try(pic_state *);
|
||||
|
||||
noreturn void pic_raise(pic_state *, pic_value);
|
||||
noreturn void pic_throw(pic_state *, pic_sym, const char *, pic_list);
|
||||
noreturn void pic_error(pic_state *, const char *, pic_list);
|
||||
|
||||
struct pic_error {
|
||||
PIC_OBJECT_HEADER
|
||||
pic_sym type;
|
||||
|
|
@ -51,6 +22,24 @@ struct pic_error {
|
|||
|
||||
struct pic_error *pic_make_error(pic_state *, pic_sym, const char *, pic_list);
|
||||
|
||||
/* do not return from try block! */
|
||||
|
||||
#define pic_try \
|
||||
if (pic_push_try(pic)) \
|
||||
do
|
||||
#define pic_catch \
|
||||
while (pic_pop_try(pic), 0); \
|
||||
else \
|
||||
if (pic_pop_try(pic), 1)
|
||||
|
||||
bool pic_push_try(pic_state *);
|
||||
void pic_pop_try(pic_state *);
|
||||
|
||||
pic_value pic_raise_continuable(pic_state *, pic_value);
|
||||
noreturn void pic_raise(pic_state *, pic_value);
|
||||
noreturn void pic_throw(pic_state *, pic_sym, const char *, pic_list);
|
||||
noreturn void pic_error(pic_state *, const char *, pic_list);
|
||||
|
||||
#if defined(__cplusplus)
|
||||
}
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -125,7 +125,6 @@ enum pic_tt {
|
|||
PIC_TT_DATA,
|
||||
PIC_TT_DICT,
|
||||
PIC_TT_RECORD,
|
||||
PIC_TT_BLK,
|
||||
};
|
||||
|
||||
#define PIC_OBJECT_HEADER \
|
||||
|
|
@ -274,8 +273,6 @@ pic_type_repr(enum pic_tt tt)
|
|||
return "dict";
|
||||
case PIC_TT_RECORD:
|
||||
return "record";
|
||||
case PIC_TT_BLK:
|
||||
return "block";
|
||||
}
|
||||
UNREACHABLE();
|
||||
}
|
||||
|
|
|
|||
31
state.c
31
state.c
|
|
@ -27,7 +27,7 @@ pic_open(int argc, char *argv[], char **envp)
|
|||
pic = malloc(sizeof(pic_state));
|
||||
|
||||
/* root block */
|
||||
pic->blk = NULL;
|
||||
pic->wind = NULL;
|
||||
|
||||
/* command line */
|
||||
pic->argc = argc;
|
||||
|
|
@ -42,6 +42,10 @@ pic_open(int argc, char *argv[], char **envp)
|
|||
pic->cibase = pic->ci = calloc(PIC_STACK_SIZE, sizeof(pic_callinfo));
|
||||
pic->ciend = pic->cibase + PIC_STACK_SIZE;
|
||||
|
||||
/* exception handler */
|
||||
pic->xpbase = pic->xp = calloc(PIC_RESCUE_SIZE, sizeof(struct pic_proc *));
|
||||
pic->xpend = pic->xpbase + PIC_RESCUE_SIZE;
|
||||
|
||||
/* memory heap */
|
||||
pic->heap = pic_heap_open();
|
||||
|
||||
|
|
@ -70,12 +74,8 @@ pic_open(int argc, char *argv[], char **envp)
|
|||
pic->reader->trie = pic_make_trie(pic);
|
||||
xh_init_int(&pic->reader->labels, sizeof(pic_value));
|
||||
|
||||
/* error handling */
|
||||
pic->jmp = NULL;
|
||||
/* raised error object */
|
||||
pic->err = pic_undef_value();
|
||||
pic->try_jmps = calloc(PIC_RESCUE_SIZE, sizeof(struct pic_jmpbuf));
|
||||
pic->try_jmp_idx = 0;
|
||||
pic->try_jmp_size = PIC_RESCUE_SIZE;
|
||||
|
||||
/* standard ports */
|
||||
pic->xSTDIN = NULL;
|
||||
|
|
@ -153,10 +153,10 @@ pic_open(int argc, char *argv[], char **envp)
|
|||
pic_gc_arena_restore(pic, ai);
|
||||
|
||||
/* root block */
|
||||
pic->blk = (struct pic_block *)pic_obj_alloc(pic, sizeof(struct pic_block), PIC_TT_BLK);
|
||||
pic->blk->prev = NULL;
|
||||
pic->blk->depth = 0;
|
||||
pic->blk->in = pic->blk->out = NULL;
|
||||
pic->wind = pic_alloc(pic, sizeof(struct pic_winder));
|
||||
pic->wind->prev = NULL;
|
||||
pic->wind->depth = 0;
|
||||
pic->wind->in = pic->wind->out = NULL;
|
||||
|
||||
/* init readers */
|
||||
pic_init_reader(pic);
|
||||
|
|
@ -182,16 +182,17 @@ pic_close(pic_state *pic)
|
|||
xh_entry *it;
|
||||
|
||||
/* invoke exit handlers */
|
||||
while (pic->blk) {
|
||||
if (pic->blk->out) {
|
||||
pic_apply0(pic, pic->blk->out);
|
||||
while (pic->wind) {
|
||||
if (pic->wind->out) {
|
||||
pic_apply0(pic, pic->wind->out);
|
||||
}
|
||||
pic->blk = pic->blk->prev;
|
||||
pic->wind = pic->wind->prev;
|
||||
}
|
||||
|
||||
/* 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();
|
||||
xh_clear(&pic->macros);
|
||||
|
|
@ -207,6 +208,7 @@ pic_close(pic_state *pic)
|
|||
/* free runtime context */
|
||||
free(pic->stbase);
|
||||
free(pic->cibase);
|
||||
free(pic->xpbase);
|
||||
|
||||
/* free reader struct */
|
||||
xh_destroy(&pic->reader->labels);
|
||||
|
|
@ -214,7 +216,6 @@ pic_close(pic_state *pic)
|
|||
free(pic->reader);
|
||||
|
||||
/* free global stacks */
|
||||
free(pic->try_jmps);
|
||||
xh_destroy(&pic->syms);
|
||||
xh_destroy(&pic->globals);
|
||||
xh_destroy(&pic->macros);
|
||||
|
|
|
|||
16
vm.c
16
vm.c
|
|
@ -755,20 +755,28 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
|
|||
}
|
||||
CASE(OP_LREF) {
|
||||
pic_callinfo *ci = pic->ci;
|
||||
struct pic_irep *irep;
|
||||
|
||||
if (ci->env != NULL && ci->env->regs == ci->env->storage) {
|
||||
PUSH(ci->env->regs[c.u.i - (ci->regs - ci->fp)]);
|
||||
NEXT;
|
||||
irep = pic_get_proc(pic)->u.irep;
|
||||
if (c.u.i >= irep->argc + irep->localc) {
|
||||
PUSH(ci->env->regs[c.u.i - (ci->regs - ci->fp)]);
|
||||
NEXT;
|
||||
}
|
||||
}
|
||||
PUSH(pic->ci->fp[c.u.i]);
|
||||
NEXT;
|
||||
}
|
||||
CASE(OP_LSET) {
|
||||
pic_callinfo *ci = pic->ci;
|
||||
struct pic_irep *irep;
|
||||
|
||||
if (ci->env != NULL && ci->env->regs == ci->env->storage) {
|
||||
ci->env->regs[c.u.i - (ci->regs - ci->fp)] = POP();
|
||||
NEXT;
|
||||
irep = pic_get_proc(pic)->u.irep;
|
||||
if (c.u.i >= irep->argc + irep->localc) {
|
||||
ci->env->regs[c.u.i - (ci->regs - ci->fp)] = POP();
|
||||
NEXT;
|
||||
}
|
||||
}
|
||||
pic->ci->fp[c.u.i] = POP();
|
||||
NEXT;
|
||||
|
|
|
|||
Loading…
Reference in New Issue