conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

remove pic->xp

This commit is contained in:
Yuichi Nishiwaki 2016-02-23 22:42:03 +09:00
parent 34331dad6f
commit b3e9794385
8 changed files with 113 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
contrib/10.callcc/callcc.c
View File

@ -20,10 +20,6 @@ struct fullcont {
size_t ci_offset;
ptrdiff_t ci_len;
struct proc **xp_ptr;
size_t xp_offset;
ptrdiff_t xp_len;
struct code *ip;
struct object **arena;
@ -41,7 +37,6 @@ cont_dtor(pic_state *pic, void *data)
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);
}
@ -53,7 +48,6 @@ cont_mark(pic_state *pic, void *data, void (*mark)(pic_state *, pic_value))
struct checkpoint *cp;
pic_value *stack;
struct callinfo *ci;
struct proc **xp;
size_t i;
/* checkpoint */
@ -78,11 +72,6 @@ cont_mark(pic_state *pic, void *data, void (*mark)(pic_state *, pic_value))
}
}
/* exception handlers */
for (xp = cont->xp_ptr; xp != cont->xp_ptr + cont->xp_offset; ++xp) {
mark(pic, pic_obj_value(*xp));
}
/* arena */
for (i = 0; i < cont->arena_idx; ++i) {
mark(pic, pic_obj_value(cont->arena[i]));
@ -139,11 +128,6 @@ save_cont(pic_state *pic, struct fullcont **c)
cont->ci_ptr = pic_malloc(pic, sizeof(struct callinfo) * cont->ci_len);
memcpy(cont->ci_ptr, pic->cibase, sizeof(struct callinfo) * cont->ci_len);
cont->xp_offset = pic->xp - pic->xpbase;
cont->xp_len = pic->xpend - pic->xpbase;
cont->xp_ptr = pic_malloc(pic, sizeof(struct proc *) * cont->xp_len);
memcpy(cont->xp_ptr, pic->xpbase, sizeof(struct proc *) * cont->xp_len);
cont->ip = pic->ip;
cont->arena_idx = pic->arena_idx;
@ -190,11 +174,6 @@ restore_cont(pic_state *pic, struct fullcont *cont)
pic->ci = pic->cibase + cont->ci_offset;
pic->ciend = pic->cibase + cont->ci_len;
assert(pic->xpend - pic->xpbase >= cont->xp_len);
memcpy(pic->xpbase, cont->xp_ptr, sizeof(struct proc *) * cont->xp_len);
pic->xp = pic->xpbase + cont->xp_offset;
pic->xpend = pic->xpbase + cont->xp_len;
pic->ip = cont->ip;
assert(pic->arena_size >= cont->arena_size);

5
extlib/benz/cont.c
View File

@ -14,7 +14,6 @@ struct pic_cont {
struct checkpoint *cp;
ptrdiff_t sp_offset;
ptrdiff_t ci_offset;
ptrdiff_t xp_offset;
size_t arena_idx;
struct code *ip;
@ -35,7 +34,6 @@ pic_save_point(pic_state *pic, struct pic_cont *cont, PIC_JMPBUF *jmp)
cont->cp = pic->cp;
cont->sp_offset = pic->sp - pic->stbase;
cont->ci_offset = pic->ci - pic->cibase;
cont->xp_offset = pic->xp - pic->xpbase;
cont->arena_idx = pic->arena_idx;
cont->ip = pic->ip;
cont->prev = pic->cc;
@ -55,7 +53,6 @@ pic_load_point(pic_state *pic, struct pic_cont *cont)
pic->cp = cont->cp;
pic->sp = pic->stbase + cont->sp_offset;
pic->ci = pic->cibase + cont->ci_offset;
pic->xp = pic->xpbase + cont->xp_offset;
pic->arena_idx = cont->arena_idx;
pic->ip = cont->ip;
pic->cc = cont->prev;
@ -89,8 +86,6 @@ pic_dynamic_wind(pic_state *pic, pic_value in, pic_value thunk, pic_value out)
struct checkpoint *here;
pic_value val;
assert(pic_proc_p(pic, thunk));
pic_call(pic, in, 0); /* enter */
here = pic->cp;

167
extlib/benz/error.c
View File

@ -37,46 +37,6 @@ pic_warnf(pic_state *pic, const char *fmt, ...)
xfprintf(pic, file, "warn: %s\n", pic_str(pic, err));
}
void
pic_error(pic_state *pic, const char *msg, int n, ...)
{
va_list ap;
pic_value irrs;
va_start(ap, n);
irrs = pic_vlist(pic, n, ap);
va_end(ap);
pic_raise(pic, pic_make_error(pic, "", msg, irrs));
}
void
pic_push_handler(pic_state *pic, pic_value handler)
{
size_t xp_len;
ptrdiff_t xp_offset;
if (pic->xp >= pic->xpend) {
xp_len = (size_t)(pic->xpend - pic->xpbase) * 2;
xp_offset = pic->xp - pic->xpbase;
pic->xpbase = pic_realloc(pic, pic->xpbase, sizeof(struct proc *) * xp_len);
pic->xp = pic->xpbase + xp_offset;
pic->xpend = pic->xpbase + xp_len;
}
*pic->xp++ = pic_proc_ptr(pic, handler);
}
pic_value
pic_pop_handler(pic_state *pic)
{
if (pic->xp == pic->xpbase) {
pic_panic(pic, "no exception handler registered");
}
return pic_obj_value(*--pic->xp);
}
static pic_value
native_exception_handler(pic_state *pic)
{
@ -91,14 +51,70 @@ native_exception_handler(pic_state *pic)
PIC_UNREACHABLE();
}
void
pic_push_native_handler(pic_state *pic, struct pic_cont *cont)
static pic_value
dynamic_set(pic_state *pic)
{
pic_value handler;
pic_value var, val;
pic_get_args(pic, "");
var = pic_closure_ref(pic, 0);
val = pic_closure_ref(pic, 1);
pic_proc_ptr(pic, var)->locals[0] = val;
return pic_undef_value(pic);
}
pic_value
pic_start_try(pic_state *pic, PIC_JMPBUF *jmp)
{
struct pic_cont *cont;
pic_value handler;
pic_value var, old_val, new_val;
pic_value in, out;
struct checkpoint *here;
/* call/cc */
cont = pic_alloca_cont(pic);
pic_save_point(pic, cont, jmp);
handler = pic_lambda(pic, native_exception_handler, 1, pic_make_cont(pic, cont));
pic_push_handler(pic, handler);
/* with-exception-handler */
var = pic_ref(pic, "picrin.base", "current-exception-handlers");
old_val = pic_call(pic, var, 0);
new_val = pic_cons(pic, handler, old_val);
in = pic_lambda(pic, dynamic_set, 2, var, new_val);
out = pic_lambda(pic, dynamic_set, 2, var, old_val);
/* dynamic-wind */
pic_call(pic, in, 0); /* enter */
here = pic->cp;
pic->cp = (struct checkpoint *)pic_obj_alloc(pic, sizeof(struct checkpoint), PIC_TYPE_CP);
pic->cp->prev = here;
pic->cp->depth = here->depth + 1;
pic->cp->in = pic_proc_ptr(pic, in);
pic->cp->out = pic_proc_ptr(pic, out);
return pic_cons(pic, pic_obj_value(here), out);
}
void
pic_end_try(pic_state *pic, pic_value cookie)
{
struct checkpoint *here = (struct checkpoint *)pic_obj_ptr(pic_car(pic, cookie));
pic_value out = pic_cdr(pic, cookie);
pic->cp = here;
pic_call(pic, out, 0); /* exit */
pic_exit_point(pic);
}
pic_value
@ -124,48 +140,72 @@ pic_make_error(pic_state *pic, const char *type, const char *msg, pic_value irrs
return pic_obj_value(e);
}
pic_value
pic_raise_continuable(pic_state *pic, pic_value err)
pic_value pic_raise_continuable(pic_state *, pic_value err);
void
pic_error(pic_state *pic, const char *msg, int n, ...)
{
pic_value handler, v;
va_list ap;
pic_value irrs;
handler = pic_pop_handler(pic);
va_start(ap, n);
irrs = pic_vlist(pic, n, ap);
va_end(ap);
pic_protect(pic, handler);
pic_raise(pic, pic_make_error(pic, "", msg, irrs));
}
v = pic_call(pic, handler, 1, err);
static pic_value
raise(pic_state *pic)
{
pic_get_args(pic, "");
pic_push_handler(pic, handler);
pic_call(pic, pic_closure_ref(pic, 0), 1, pic_closure_ref(pic, 1));
return v;
pic_error(pic, "handler returned", 2, pic_closure_ref(pic, 0), pic_closure_ref(pic, 1));
}
void
pic_raise(pic_state *pic, pic_value err)
{
pic_value val;
pic_value stack, exc = pic_ref(pic, "picrin.base", "current-exception-handlers");
val = pic_raise_continuable(pic, err);
stack = pic_call(pic, exc, 0);
pic_pop_handler(pic);
pic_dynamic_bind(pic, exc, pic_cdr(pic, stack), pic_lambda(pic, raise, 2, pic_car(pic, stack), err));
pic_error(pic, "error handler returned", 2, val, err);
PIC_UNREACHABLE();
}
static pic_value
raise_continuable(pic_state *pic)
{
pic_get_args(pic, "");
return pic_call(pic, pic_closure_ref(pic, 0), 1, pic_closure_ref(pic, 1));
}
pic_value
pic_raise_continuable(pic_state *pic, pic_value err)
{
pic_value stack, exc = pic_ref(pic, "picrin.base", "current-exception-handlers");
stack = pic_call(pic, exc, 0);
return pic_dynamic_bind(pic, exc, pic_cdr(pic, stack), pic_lambda(pic, raise_continuable, 2, pic_car(pic, stack), err));
}
static pic_value
pic_error_with_exception_handler(pic_state *pic)
{
pic_value handler, thunk, val;
pic_value handler, thunk;
pic_value stack, exc = pic_ref(pic, "picrin.base", "current-exception-handlers");
pic_get_args(pic, "ll", &handler, &thunk);
pic_push_handler(pic, handler);
stack = pic_call(pic, exc, 0);
val = pic_call(pic, thunk, 0);
pic_pop_handler(pic);
return val;
return pic_dynamic_bind(pic, exc, pic_cons(pic, handler, stack), thunk);
}
static pic_value
@ -249,6 +289,7 @@ pic_error_error_object_type(pic_state *pic)
void
pic_init_error(pic_state *pic)
{
pic_defvar(pic, "current-exception-handlers", pic_nil_value(pic), pic_false_value(pic));
pic_defun(pic, "with-exception-handler", pic_error_with_exception_handler);
pic_defun(pic, "raise", pic_error_raise);
pic_defun(pic, "raise-continuable", pic_error_raise_continuable);

6
extlib/benz/gc.c
View File

@ -413,7 +413,6 @@ gc_mark_phase(pic_state *pic)
{
pic_value *stack;
struct callinfo *ci;
struct proc **xhandler;
struct list_head *list;
int it;
size_t j;
@ -437,11 +436,6 @@ gc_mark_phase(pic_state *pic)
}
}
/* exception handlers */
for (xhandler = pic->xpbase; xhandler != pic->xp; ++xhandler) {
gc_mark_object(pic, (struct object *)*xhandler);
}
/* arena */
for (j = 0; j < pic->arena_idx; ++j) {
gc_mark_object(pic, (struct object *)pic->arena[j]);

17
extlib/benz/include/picrin/extra.h
View File

@ -78,26 +78,17 @@ xFILE *xfopen_null(pic_state *, const char *mode);
pic_in_library(pic, lib); \
} while (0)
/* for pic_try & pic_catch macros */
struct pic_cont *pic_alloca_cont(pic_state *);
pic_value pic_make_cont(pic_state *, struct pic_cont *);
void pic_push_native_handler(pic_state *, struct pic_cont *);
pic_value pic_pop_handler(pic_state *);
void pic_save_point(pic_state *, struct pic_cont *, PIC_JMPBUF *);
void pic_exit_point(pic_state *);
#define pic_try pic_try_(PIC_GENSYM(cont), PIC_GENSYM(jmp))
#define pic_try_(cont, jmp) \
do { \
extern pic_value pic_start_try(pic_state *, PIC_JMPBUF *); \
extern void pic_end_try(pic_state *, pic_value); \
PIC_JMPBUF jmp; \
struct pic_cont *cont = pic_alloca_cont(pic); \
if (PIC_SETJMP(pic, jmp) == 0) { \
pic_save_point(pic, cont, &jmp); \
pic_push_native_handler(pic, cont);
pic_value pic_try_cookie_ = pic_start_try(pic, &jmp);
#define pic_catch pic_catch_(PIC_GENSYM(label))
#define pic_catch_(label) \
pic_pop_handler(pic); \
pic_exit_point(pic); \
pic_end_try(pic, pic_try_cookie_); \
} else { \
goto label; \
} \

5
extlib/benz/include/picrin/private/object.h
View File

@ -188,9 +188,14 @@ void pic_rope_decref(pic_state *, struct rope *);
#define pic_func_p(pic, proc) (pic_type(pic, proc) == PIC_TYPE_FUNC)
#define pic_irep_p(pic, proc) (pic_type(pic, proc) == PIC_TYPE_IREP)
struct pic_cont *pic_alloca_cont(pic_state *);
pic_value pic_make_cont(pic_state *, struct pic_cont *);
void pic_save_point(pic_state *, struct pic_cont *, PIC_JMPBUF *);
void pic_exit_point(pic_state *);
void pic_wind(pic_state *, struct checkpoint *, struct checkpoint *);
pic_value pic_dynamic_wind(pic_state *, pic_value in, pic_value thunk, pic_value out);
pic_value pic_dynamic_bind(pic_state *, pic_value var, pic_value val, pic_value thunk);
#if defined(__cplusplus)
}

3
extlib/benz/include/picrin/private/state.h
View File

@ -49,9 +49,6 @@ struct pic_state {
struct callinfo *ci;
struct callinfo *cibase, *ciend;
struct proc **xp;
struct proc **xpbase, **xpend;
struct code *ip;
struct lib *lib;

12
extlib/benz/state.c
View File

@ -229,14 +229,6 @@ pic_open(pic_allocf allocf, void *userdata)
goto EXIT_CI;
}
/* exception handler */
pic->xpbase = pic->xp = allocf(userdata, NULL, PIC_RESCUE_SIZE * sizeof(struct proc *));
pic->xpend = pic->xpbase + PIC_RESCUE_SIZE;
if (! pic->xp) {
goto EXIT_XP;
}
/* GC arena */
pic->arena = allocf(userdata, NULL, PIC_ARENA_SIZE * sizeof(struct object *));
pic->arena_size = PIC_ARENA_SIZE;
@ -317,8 +309,6 @@ pic_open(pic_allocf allocf, void *userdata)
return pic;
EXIT_ARENA:
allocf(userdata, pic->xp, 0);
EXIT_XP:
allocf(userdata, pic->ci, 0);
EXIT_CI:
allocf(userdata, pic->sp, 0);
@ -336,7 +326,6 @@ pic_close(pic_state *pic)
/* clear out root objects */
pic->sp = pic->stbase;
pic->ci = pic->cibase;
pic->xp = pic->xpbase;
pic->arena_idx = 0;
pic->err = pic_invalid_value(pic);
pic->globals = pic_invalid_value(pic);
@ -358,7 +347,6 @@ pic_close(pic_state *pic)
/* free runtime context */
allocf(pic->userdata, pic->stbase, 0);
allocf(pic->userdata, pic->cibase, 0);
allocf(pic->userdata, pic->xpbase, 0);
/* free global stacks */
kh_destroy(oblist, &pic->oblist);