diff --git a/cont.c b/cont.c index 695e39b0..563332aa 100644 --- a/cont.c +++ b/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); } diff --git a/error.c b/error.c index bc618630..8023c0be 100644 --- a/error.c +++ b/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 diff --git a/gc.c b/gc.c index 38be3150..7ac019ff 100644 --- a/gc.c +++ b/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: diff --git a/include/picrin.h b/include/picrin.h index 3df0c538..b00e451d 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -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; diff --git a/include/picrin/cont.h b/include/picrin/cont.h index eeabb798..503651f1 100644 --- a/include/picrin/cont.h +++ b/include/picrin/cont.h @@ -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) } diff --git a/include/picrin/error.h b/include/picrin/error.h index 1b96f3ee..5be65502 100644 --- a/include/picrin/error.h +++ b/include/picrin/error.h @@ -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 diff --git a/include/picrin/value.h b/include/picrin/value.h index 6a211dc1..453e645a 100644 --- a/include/picrin/value.h +++ b/include/picrin/value.h @@ -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(); } diff --git a/state.c b/state.c index b88f40a1..e61aef44 100644 --- a/state.c +++ b/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); diff --git a/vm.c b/vm.c index 609c702f..92af1ce7 100644 --- a/vm.c +++ b/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;