diff --git a/include/picrin.h b/include/picrin.h index b69141ac..34953544 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -104,6 +104,7 @@ typedef struct { jmp_buf *jmp; struct pic_error *err; + struct pic_jmpbuf *try_jmps; struct pic_heap *heap; struct pic_object *arena[PIC_ARENA_SIZE]; @@ -134,15 +135,6 @@ void pic_define(pic_state *, const char *, pic_value); /* automatic export */ pic_value pic_ref(pic_state *, const char *); void pic_set(pic_state *, const char *, pic_value); -#define pic_try \ - pic_try_helper__(GENSYM(i), GENSYM(here), GENSYM(prev_jmp)) -#define pic_try_helper__(i, here, prev_jmp) \ - for (int i = 0; ! i; ) \ - for (jmp_buf here, *prev_jmp = pic->jmp; ! i; ) \ - for (pic->jmp = &here; ! i++; pic->jmp = prev_jmp) \ - if (setjmp(here) == 0) -#define pic_catch else - struct pic_proc *pic_get_proc(pic_state *); int pic_get_args(pic_state *, const char *, ...); void pic_defun(pic_state *, const char *, pic_func_t); diff --git a/include/picrin/error.h b/include/picrin/error.h index 475fd661..a4caf63a 100644 --- a/include/picrin/error.h +++ b/include/picrin/error.h @@ -9,6 +9,24 @@ extern "C" { #endif +struct pic_jmpbuf { + jmp_buf here; + jmp_buf *prev_jmp; + struct pic_jmpbuf *prev; +}; + +#define pic_try \ + pic_push_try(pic); \ + 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 *); +void pic_pop_try(pic_state *); + struct pic_error { PIC_OBJECT_HEADER enum pic_error_kind { diff --git a/src/error.c b/src/error.c index 42dedae1..d3798f21 100644 --- a/src/error.c +++ b/src/error.c @@ -11,6 +11,34 @@ #include "picrin/string.h" #include "picrin/error.h" +void +pic_push_try(pic_state *pic) +{ + struct pic_jmpbuf *try_jmp; + + try_jmp = pic_alloc(pic, sizeof(struct pic_jmpbuf)); + + try_jmp->prev_jmp = pic->jmp; + pic->jmp = &try_jmp->here; + + try_jmp->prev = pic->try_jmps; + pic->try_jmps = try_jmp; +} + +void +pic_pop_try(pic_state *pic) +{ + struct pic_jmpbuf *prev; + + assert(pic->jmp == &pic->try_jmps->here); + + pic->jmp = pic->try_jmps->prev_jmp; + + prev = pic->try_jmps->prev; + pic_free(pic, pic->try_jmps); + pic->try_jmps = prev; +} + const char * pic_errmsg(pic_state *pic) { diff --git a/src/init.c b/src/init.c index 0b6a11ff..537dbdf6 100644 --- a/src/init.c +++ b/src/init.c @@ -8,6 +8,7 @@ #include "picrin/pair.h" #include "picrin/lib.h" #include "picrin/macro.h" +#include "picrin/error.h" void pic_init_bool(pic_state *); void pic_init_pair(pic_state *); diff --git a/src/macro.c b/src/macro.c index 5157265c..4af43ae6 100644 --- a/src/macro.c +++ b/src/macro.c @@ -8,6 +8,7 @@ #include "picrin/proc.h" #include "picrin/macro.h" #include "picrin/lib.h" +#include "picrin/error.h" static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *); static pic_value macroexpand_list(pic_state *, pic_value, struct pic_senv *); @@ -213,47 +214,38 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv) if (tag == pic->sDEFINE_LIBRARY) { struct pic_lib *prev = pic->lib; - jmp_buf jmp, *prevjmp = pic->jmp; - bool name_restored = false; - /* restores pic->lib even if an error occurs */ - if (setjmp(jmp) == 0) { - pic->jmp = &jmp; - if (pic_length(pic, expr) < 2) { - pic_error(pic, "syntax error"); - } - pic_make_library(pic, pic_cadr(pic, expr)); + if (pic_length(pic, expr) < 2) { + pic_error(pic, "syntax error"); + } + pic_make_library(pic, pic_cadr(pic, expr)); - /* proceed expressions in new library */ + pic_try { pic_in_library(pic, pic_cadr(pic, expr)); - { - int ai = pic_gc_arena_preserve(pic); - struct pic_proc *proc; - pic_for_each (v, pic_cddr(pic, expr)) { - proc = pic_compile(pic, v); - if (proc == NULL) { - abort(); - } - pic_apply_argv(pic, proc, 0); - if (pic_undef_p(v)) { - abort(); - } - pic_gc_arena_restore(pic, ai); + pic_for_each (v, pic_cddr(pic, expr)) { + struct pic_proc *proc; + int ai = pic_gc_arena_preserve(pic); + + proc = pic_compile(pic, v); + if (proc == NULL) { + abort(); } + pic_apply_argv(pic, proc, 0); + if (pic_undef_p(v)) { + abort(); + } + pic_gc_arena_restore(pic, ai); } + pic_in_library(pic, prev->name); - name_restored = true; } - else { - if (! name_restored) { - pic_in_library(pic, prev->name); - } - } - pic->jmp = prevjmp; - if (pic->err) { + pic_catch { + /* restores pic->lib even if an error occurs */ + pic_in_library(pic, prev->name); longjmp(*pic->jmp, 1); } + return pic_none_value(); } diff --git a/src/state.c b/src/state.c index e171ac53..c0a511eb 100644 --- a/src/state.c +++ b/src/state.c @@ -72,6 +72,7 @@ pic_open(int argc, char *argv[], char **envp) /* error handling */ pic->jmp = NULL; pic->err = NULL; + pic->try_jmps = NULL; /* GC arena */ pic->arena_idx = 0; diff --git a/tools/main.c b/tools/main.c index 9be04045..ea00782b 100644 --- a/tools/main.c +++ b/tools/main.c @@ -9,6 +9,7 @@ #include "picrin.h" #include "picrin/pair.h" +#include "picrin/error.h" #if PIC_ENABLE_READLINE # include