diff --git a/cont.c b/cont.c index 8ee36b33..56e6263e 100644 --- a/cont.c +++ b/cont.c @@ -57,25 +57,8 @@ pic_dynamic_wind(pic_state *pic, struct pic_proc *in, struct pic_proc *thunk, st return val; } -struct pic_escape { - jmp_buf jmp; - - bool valid; - - struct pic_winder *wind; - - ptrdiff_t sp_offset; - ptrdiff_t ci_offset; - ptrdiff_t xp_offset; - int arena_idx; - - pic_code *ip; - - pic_value results; -}; - -static int -save_point(pic_state *pic, struct pic_escape *escape) +void +pic_save_point(pic_state *pic, struct pic_escape *escape) { escape->valid = true; @@ -88,12 +71,10 @@ save_point(pic_state *pic, struct pic_escape *escape) escape->ip = pic->ip; escape->results = pic_undef_value(); - - return setjmp(escape->jmp); } -noreturn static void -load_point(pic_state *pic, struct pic_escape *escape) +void +pic_load_point(pic_state *pic, struct pic_escape *escape) { if (! escape->valid) { pic_errorf(pic, "calling dead escape continuation"); @@ -109,7 +90,7 @@ load_point(pic_state *pic, struct pic_escape *escape) pic->arena_idx = escape->arena_idx; pic->ip = escape->ip; - longjmp(escape->jmp, 1); + escape->valid = false; } noreturn static pic_value @@ -123,33 +104,42 @@ escape_call(pic_state *pic) e = pic_data_ptr(pic_attr_ref(pic, pic_get_proc(pic), "@@escape")); - load_point(pic, e->data); + pic_load_point(pic, e->data); + + longjmp(((struct pic_escape *)e->data)->jmp, 1); +} + +struct pic_proc * +pic_make_econt(pic_state *pic, struct pic_escape *escape) +{ + static const pic_data_type escape_type = { "escape", pic_free, NULL }; + struct pic_proc *cont; + struct pic_data *e; + + cont = pic_make_proc(pic, escape_call, ""); + + e = pic_data_alloc(pic, &escape_type, escape); + + /* save the escape continuation in proc */ + pic_attr_set(pic, cont, "@@escape", pic_obj_value(e)); + + return cont; } pic_value pic_escape(pic_state *pic, struct pic_proc *proc) { - static const pic_data_type escape_type = { "escape", pic_free, NULL }; - struct pic_escape *escape; + struct pic_escape *escape = pic_alloc(pic, sizeof(struct pic_escape)); - escape = pic_alloc(pic, sizeof(struct pic_escape)); + pic_save_point(pic, escape); - if (save_point(pic, escape)) { + if (setjmp(escape->jmp)) { return pic_values_by_list(pic, escape->results); } else { - struct pic_proc *c; pic_value val; - struct pic_data *e; - c = pic_make_proc(pic, escape_call, ""); - - e = pic_data_alloc(pic, &escape_type, escape); - - /* save the escape continuation in proc */ - pic_attr_set(pic, c, "@@escape", pic_obj_value(e)); - - val = pic_apply1(pic, proc, pic_obj_value(c)); + val = pic_apply1(pic, proc, pic_obj_value(pic_make_econt(pic, escape))); escape->valid = false; diff --git a/error.c b/error.c index 978ff962..90d74572 100644 --- a/error.c +++ b/error.c @@ -10,6 +10,7 @@ #include "picrin/pair.h" #include "picrin/proc.h" #include "picrin/cont.h" +#include "picrin/data.h" #include "picrin/string.h" #include "picrin/error.h" @@ -68,7 +69,7 @@ pic_errmsg(pic_state *pic) return pic_str_cstr(str); } -static pic_value +noreturn static pic_value native_exception_handler(pic_state *pic) { pic_value err; @@ -85,13 +86,13 @@ native_exception_handler(pic_state *pic) UNREACHABLE(); } -static pic_value -native_push_try(pic_state *pic) +void +pic_push_try(pic_state *pic, struct pic_escape *escape) { struct pic_proc *cont, *handler; size_t xp_len, xp_offset; - pic_get_args(pic, "l", &cont); + cont = pic_make_econt(pic, escape); handler = pic_make_proc(pic, native_exception_handler, "(native-exception-handler)"); @@ -106,24 +107,24 @@ native_push_try(pic_state *pic) } *pic->xp++ = handler; - - return pic_true_value(); -} - -bool -pic_push_try(pic_state *pic) -{ - pic_value val; - - val = pic_escape(pic, pic_make_proc(pic, native_push_try, "(native-push-try)")); - - return pic_test(val); } void pic_pop_try(pic_state *pic) { - --pic->xp; + pic_value cont, escape; + + assert(pic->xp > pic->xpbase); + + cont = pic_attr_ref(pic, *--pic->xp, "@@escape"); + + assert(pic_proc_p(cont)); + + escape = pic_attr_ref(pic, pic_proc_ptr(cont), "@@escape"); + + assert(pic_data_p(escape)); + + ((struct pic_escape *)pic_data_ptr(escape)->data)->valid = false; } struct pic_error * diff --git a/include/picrin/cont.h b/include/picrin/cont.h index c0868f79..3e948f73 100644 --- a/include/picrin/cont.h +++ b/include/picrin/cont.h @@ -9,6 +9,28 @@ extern "C" { #endif +struct pic_escape { + jmp_buf jmp; + + bool valid; + + struct pic_winder *wind; + + ptrdiff_t sp_offset; + ptrdiff_t ci_offset; + ptrdiff_t xp_offset; + int arena_idx; + + pic_code *ip; + + pic_value results; +}; + +void pic_save_point(pic_state *, struct pic_escape *); +void pic_load_point(pic_state *, struct pic_escape *); + +struct pic_proc *pic_make_econt(pic_state *, struct pic_escape *); + void pic_wind(pic_state *, struct pic_winder *, struct pic_winder *); pic_value pic_dynamic_wind(pic_state *, struct pic_proc *, struct pic_proc *, struct pic_proc *); diff --git a/include/picrin/error.h b/include/picrin/error.h index 5be65502..784b95f8 100644 --- a/include/picrin/error.h +++ b/include/picrin/error.h @@ -9,6 +9,8 @@ extern "C" { #endif +#include "picrin/cont.h" + struct pic_error { PIC_OBJECT_HEADER pic_sym type; @@ -25,14 +27,19 @@ 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)) \ + pic_try_(GENSYM(escape)) +#define pic_try_(escape) \ + struct pic_escape *escape = pic_alloc(pic, sizeof(struct pic_escape)); \ + pic_save_point(pic, escape); \ + if (setjmp(escape->jmp) == 0) { \ + pic_push_try(pic, escape); \ do -#define pic_catch \ - while (pic_pop_try(pic), 0); \ - else \ - if (pic_pop_try(pic), 1) +#define pic_catch \ + while (0); \ + pic_pop_try(pic); \ + } else -bool pic_push_try(pic_state *); +void pic_push_try(pic_state *, struct pic_escape *); void pic_pop_try(pic_state *); pic_value pic_raise_continuable(pic_state *, pic_value);