use call/cc in exception handler implementation

This commit is contained in:
Yuichi Nishiwaki 2014-09-18 14:12:18 +09:00
parent 6a8a7d93e7
commit 46c1d0f2a7
4 changed files with 51 additions and 46 deletions

88
error.c
View File

@ -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"
@ -66,42 +68,60 @@ pic_errmsg(pic_state *pic)
return pic_str_cstr(str);
}
void
pic_push_try(pic_state *pic, struct pic_proc *handler)
static pic_value
native_exception_handler(pic_state *pic)
{
pic_value err;
struct pic_proc *cont;
pic_get_args(pic, "o", &err);
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;
struct pic_jmpbuf *try_jmp;
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->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);
}
try_jmp = pic->try_jmps + pic->try_jmp_idx++;
try_jmp->handler = handler;
try_jmp->ci_offset = pic->ci - pic->cibase;
try_jmp->sp_offset = pic->sp - pic->stbase;
try_jmp->ip = pic->ip;
return pic_true_value();
}
try_jmp->prev_jmp = pic->jmp;
pic->jmp = &try_jmp->here;
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->try_jmp_idx;
}
struct pic_error *
@ -124,28 +144,13 @@ pic_make_error(pic_state *pic, pic_sym type, const char *msg, pic_value irrs)
pic_value
pic_raise_continuable(pic_state *pic, pic_value err)
{
struct pic_proc *handler;
pic_value v;
if (pic->try_jmp_idx == 0) {
pic_errorf(pic, "no exception handler registered");
pic_panic(pic, "no exception handler registered");
}
if (pic->try_jmps[pic->try_jmp_idx - 1].handler == NULL) {
void pic_vm_tear_off(pic_state *);
pic_vm_tear_off(pic); /* tear off */
pic->err = err;
if (! pic->jmp) {
puts(pic_errmsg(pic));
pic_panic(pic, "no handler found on stack");
}
longjmp(*pic->jmp, 1);
}
struct pic_proc *handler;
handler = pic->try_jmps[pic->try_jmp_idx - 1].handler;
pic_gc_protect(pic, pic_obj_value(handler));
@ -154,7 +159,7 @@ pic_raise_continuable(pic_state *pic, pic_value err)
v = pic_apply1(pic, pic->try_jmps[pic->try_jmp_idx].handler, err);
pic->try_jmp_idx++;
pic->try_jmps[pic->try_jmp_idx++].handler = handler;
return v;
}
@ -195,11 +200,16 @@ pic_error_with_exception_handler(pic_state *pic)
pic_get_args(pic, "ll", &handler, &thunk);
pic_push_try(pic, handler);
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);
}
pic->try_jmps[pic->try_jmp_idx++].handler = handler;
val = pic_apply0(pic, thunk);
pic_pop_try(pic);
pic->try_jmp_idx--;
return val;
}

View File

@ -111,7 +111,6 @@ 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;

View File

@ -21,17 +21,14 @@ struct pic_jmpbuf {
/* 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) \
if (pic_push_try(pic)) \
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 *);
bool pic_push_try(pic_state *);
void pic_pop_try(pic_state *);
pic_value pic_raise_continuable(pic_state *, pic_value);

View File

@ -71,7 +71,6 @@ pic_open(int argc, char *argv[], char **envp)
xh_init_int(&pic->reader->labels, sizeof(pic_value));
/* error handling */
pic->jmp = NULL;
pic->err = pic_undef_value();
pic->try_jmps = calloc(PIC_RESCUE_SIZE, sizeof(struct pic_jmpbuf));
pic->try_jmp_idx = 0;