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

Merge branch 'fix-escape'

This commit is contained in:
Yuichi Nishiwaki 2015-06-02 06:52:52 +09:00
parent 6e9024b237 1fb918743a
commit 65dc4020f4
9 changed files with 103 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -49,7 +49,7 @@ src/init_contrib.c:
lib/libbenz.a: $(BENZ_OBJS) lib/libbenz.a: $(BENZ_OBJS)
$(AR) $(ARFLAGS) $@ $(BENZ_OBJS) $(AR) $(ARFLAGS) $@ $(BENZ_OBJS)
$(PICRIN_OBJS) $(CONTRIB_OBJS): extlib/benz/include/picrin.h extlib/benz/include/picrin/*.h $(BENZ_OBJS) $(PICRIN_OBJS) $(CONTRIB_OBJS): extlib/benz/include/picrin.h extlib/benz/include/picrin/*.h
doc: docs/*.rst docs/contrib.rst doc: docs/*.rst docs/contrib.rst
$(MAKE) -C docs html $(MAKE) -C docs html

40
contrib/03.callcc/callcc.c
View File

@ -1,8 +1,10 @@
#include "picrin.h" #include "picrin.h"
struct pic_cont { struct pic_fullcont {
jmp_buf jmp; jmp_buf jmp;
pic_jmpbuf *prev_jmp;
struct pic_winder *wind; struct pic_winder *wind;
char *stk_pos, *stk_ptr; char *stk_pos, *stk_ptr;
@ -29,7 +31,7 @@ struct pic_cont {
static void static void
cont_dtor(pic_state *pic, void *data) cont_dtor(pic_state *pic, void *data)
{ {
struct pic_cont *cont = data; struct pic_fullcont *cont = data;
pic_free(pic, cont->stk_ptr); pic_free(pic, cont->stk_ptr);
pic_free(pic, cont->st_ptr); pic_free(pic, cont->st_ptr);
@ -42,7 +44,7 @@ cont_dtor(pic_state *pic, void *data)
static void static void
cont_mark(pic_state *pic, void *data, void (*mark)(pic_state *, pic_value)) cont_mark(pic_state *pic, void *data, void (*mark)(pic_state *, pic_value))
{ {
struct pic_cont *cont = data; struct pic_fullcont *cont = data;
struct pic_winder *wind; struct pic_winder *wind;
pic_value *stack; pic_value *stack;
pic_callinfo *ci; pic_callinfo *ci;
@ -87,8 +89,8 @@ cont_mark(pic_state *pic, void *data, void (*mark)(pic_state *, pic_value))
static const pic_data_type cont_type = { "continuation", cont_dtor, cont_mark }; static const pic_data_type cont_type = { "continuation", cont_dtor, cont_mark };
static void save_cont(pic_state *, struct pic_cont **); static void save_cont(pic_state *, struct pic_fullcont **);
static void restore_cont(pic_state *, struct pic_cont *); static void restore_cont(pic_state *, struct pic_fullcont *);
static ptrdiff_t static ptrdiff_t
native_stack_length(pic_state *pic, char **pos) native_stack_length(pic_state *pic, char **pos)
@ -105,15 +107,17 @@ native_stack_length(pic_state *pic, char **pos)
} }
static void static void
save_cont(pic_state *pic, struct pic_cont **c) save_cont(pic_state *pic, struct pic_fullcont **c)
{ {
void pic_vm_tear_off(pic_state *); void pic_vm_tear_off(pic_state *);
struct pic_cont *cont; struct pic_fullcont *cont;
char *pos; char *pos;
pic_vm_tear_off(pic); /* tear off */ pic_vm_tear_off(pic); /* tear off */
cont = *c = pic_malloc(pic, sizeof(struct pic_cont)); cont = *c = pic_malloc(pic, sizeof(struct pic_fullcont));
cont->prev_jmp = pic->jmp;
cont->wind = pic->wind; cont->wind = pic->wind;
@ -149,7 +153,7 @@ save_cont(pic_state *pic, struct pic_cont **c)
} }
static void static void
native_stack_extend(pic_state *pic, struct pic_cont *cont) native_stack_extend(pic_state *pic, struct pic_fullcont *cont)
{ {
volatile pic_value v[1024]; volatile pic_value v[1024];
@ -158,10 +162,10 @@ native_stack_extend(pic_state *pic, struct pic_cont *cont)
} }
PIC_NORETURN static void PIC_NORETURN static void
restore_cont(pic_state *pic, struct pic_cont *cont) restore_cont(pic_state *pic, struct pic_fullcont *cont)
{ {
char v; char v;
struct pic_cont *tmp = cont; struct pic_fullcont *tmp = cont;
if (&v < pic->native_stack_start) { if (&v < pic->native_stack_start) {
if (&v > cont->stk_pos) native_stack_extend(pic, cont); if (&v > cont->stk_pos) native_stack_extend(pic, cont);
@ -170,6 +174,8 @@ restore_cont(pic_state *pic, struct pic_cont *cont)
if (&v > cont->stk_pos + cont->stk_len) native_stack_extend(pic, cont); if (&v > cont->stk_pos + cont->stk_len) native_stack_extend(pic, cont);
} }
pic->jmp = cont->prev_jmp;
pic->wind = cont->wind; pic->wind = cont->wind;
pic->stbase = pic_realloc(pic, pic->stbase, sizeof(pic_value) * cont->st_len); pic->stbase = pic_realloc(pic, pic->stbase, sizeof(pic_value) * cont->st_len);
@ -205,7 +211,7 @@ cont_call(pic_state *pic)
struct pic_proc *proc; struct pic_proc *proc;
size_t argc; size_t argc;
pic_value *argv; pic_value *argv;
struct pic_cont *cont; struct pic_fullcont *cont;
proc = pic_get_proc(pic); proc = pic_get_proc(pic);
pic_get_args(pic, "*", &argc, &argv); pic_get_args(pic, "*", &argc, &argv);
@ -220,9 +226,9 @@ cont_call(pic_state *pic)
} }
pic_value pic_value
pic_callcc(pic_state *pic, struct pic_proc *proc) pic_callcc_full(pic_state *pic, struct pic_proc *proc)
{ {
struct pic_cont *cont; struct pic_fullcont *cont;
save_cont(pic, &cont); save_cont(pic, &cont);
if (setjmp(cont->jmp)) { if (setjmp(cont->jmp)) {
@ -244,9 +250,9 @@ pic_callcc(pic_state *pic, struct pic_proc *proc)
} }
static pic_value static pic_value
pic_callcc_trampoline(pic_state *pic, struct pic_proc *proc) pic_callcc_full_trampoline(pic_state *pic, struct pic_proc *proc)
{ {
struct pic_cont *cont; struct pic_fullcont *cont;
save_cont(pic, &cont); save_cont(pic, &cont);
if (setjmp(cont->jmp)) { if (setjmp(cont->jmp)) {
@ -274,7 +280,7 @@ pic_callcc_callcc(pic_state *pic)
pic_get_args(pic, "l", &cb); pic_get_args(pic, "l", &cb);
return pic_callcc_trampoline(pic, cb); return pic_callcc_full_trampoline(pic, cb);
} }
#define pic_redefun(pic, lib, name, func) \ #define pic_redefun(pic, lib, name, func) \

84
extlib/benz/cont.c
View File

@ -49,43 +49,49 @@ pic_dynamic_wind(pic_state *pic, struct pic_proc *in, struct pic_proc *thunk, st
} }
void void
pic_save_point(pic_state *pic, struct pic_escape *escape) pic_save_point(pic_state *pic, struct pic_cont *cont)
{ {
escape->valid = true; cont->jmp.prev = pic->jmp;
pic->jmp = &cont->jmp;
/* save runtime context */ /* save runtime context */
escape->wind = pic->wind; cont->wind = pic->wind;
escape->sp_offset = pic->sp - pic->stbase; cont->sp_offset = pic->sp - pic->stbase;
escape->ci_offset = pic->ci - pic->cibase; cont->ci_offset = pic->ci - pic->cibase;
escape->xp_offset = pic->xp - pic->xpbase; cont->xp_offset = pic->xp - pic->xpbase;
escape->arena_idx = pic->arena_idx; cont->arena_idx = pic->arena_idx;
escape->ip = pic->ip; cont->ip = pic->ip;
escape->results = pic_undef_value(); cont->results = pic_undef_value();
} }
void void
pic_load_point(pic_state *pic, struct pic_escape *escape) pic_load_point(pic_state *pic, struct pic_cont *cont)
{ {
if (! escape->valid) { pic_jmpbuf *jmp;
for (jmp = pic->jmp; jmp != NULL; jmp = jmp->prev) {
if (jmp == &cont->jmp) {
break;
}
}
if (jmp == NULL) {
pic_errorf(pic, "calling dead escape continuation"); pic_errorf(pic, "calling dead escape continuation");
} }
pic_wind(pic, pic->wind, escape->wind); pic_wind(pic, pic->wind, cont->wind);
/* load runtime context */ /* load runtime context */
pic->wind = escape->wind; pic->wind = cont->wind;
pic->sp = pic->stbase + escape->sp_offset; pic->sp = pic->stbase + cont->sp_offset;
pic->ci = pic->cibase + escape->ci_offset; pic->ci = pic->cibase + cont->ci_offset;
pic->xp = pic->xpbase + escape->xp_offset; pic->xp = pic->xpbase + cont->xp_offset;
pic->arena_idx = escape->arena_idx; pic->arena_idx = cont->arena_idx;
pic->ip = escape->ip; pic->ip = cont->ip;
escape->valid = false;
} }
static pic_value static pic_value
escape_call(pic_state *pic) cont_call(pic_state *pic)
{ {
size_t argc; size_t argc;
pic_value *argv; pic_value *argv;
@ -94,48 +100,50 @@ escape_call(pic_state *pic)
pic_get_args(pic, "*", &argc, &argv); pic_get_args(pic, "*", &argc, &argv);
e = pic_data_ptr(pic_attr_ref(pic, pic_obj_value(pic_get_proc(pic)), "@@escape")); e = pic_data_ptr(pic_attr_ref(pic, pic_obj_value(pic_get_proc(pic)), "@@escape"));
((struct pic_escape *)e->data)->results = pic_list_by_array(pic, argc, argv); ((struct pic_cont *)e->data)->results = pic_list_by_array(pic, argc, argv);
pic_load_point(pic, e->data); pic_load_point(pic, e->data);
PIC_LONGJMP(pic, (void *)((struct pic_escape *)e->data)->jmp, 1); PIC_LONGJMP(pic, ((struct pic_cont *)e->data)->jmp.buf, 1);
PIC_UNREACHABLE(); PIC_UNREACHABLE();
} }
struct pic_proc * struct pic_proc *
pic_make_econt(pic_state *pic, struct pic_escape *escape) pic_make_cont(pic_state *pic, struct pic_cont *cont)
{ {
static const pic_data_type escape_type = { "escape", pic_free, NULL }; static const pic_data_type cont_type = { "cont", pic_free, NULL };
struct pic_proc *cont; struct pic_proc *c;
struct pic_data *e; struct pic_data *e;
cont = pic_make_proc(pic, escape_call, "<escape-procedure>"); c = pic_make_proc(pic, cont_call, "<cont-procedure>");
e = pic_data_alloc(pic, &escape_type, escape); e = pic_data_alloc(pic, &cont_type, cont);
/* save the escape continuation in proc */ /* save the escape continuation in proc */
pic_attr_set(pic, pic_obj_value(cont), "@@escape", pic_obj_value(e)); pic_attr_set(pic, pic_obj_value(c), "@@escape", pic_obj_value(e));
return cont; return c;
} }
pic_value pic_value
pic_escape(pic_state *pic, struct pic_proc *proc) pic_callcc(pic_state *pic, struct pic_proc *proc)
{ {
struct pic_escape *escape = pic_malloc(pic, sizeof(struct pic_escape)); struct pic_cont *cont = pic_malloc(pic, sizeof(struct pic_cont));
pic_save_point(pic, escape); pic_save_point(pic, cont);
if (PIC_SETJMP(pic, (void *)escape->jmp)) { if (PIC_SETJMP(pic, cont->jmp.buf)) {
return pic_values_by_list(pic, escape->results); pic->jmp = pic->jmp->prev;
return pic_values_by_list(pic, cont->results);
} }
else { else {
pic_value val; pic_value val;
val = pic_apply1(pic, proc, pic_obj_value(pic_make_econt(pic, escape))); val = pic_apply1(pic, proc, pic_obj_value(pic_make_cont(pic, cont)));
escape->valid = false; pic->jmp = pic->jmp->prev;
return val; return val;
} }
@ -229,7 +237,7 @@ pic_cont_callcc(pic_state *pic)
pic_get_args(pic, "l", &cb); pic_get_args(pic, "l", &cb);
return pic_escape(pic, cb); return pic_callcc(pic, cb);
} }
static pic_value static pic_value

22
extlib/benz/error.c
View File

@ -81,14 +81,12 @@ native_exception_handler(pic_state *pic)
} }
void void
pic_push_try(pic_state *pic, struct pic_escape *escape) pic_push_try(pic_state *pic, struct pic_proc *cont)
{ {
struct pic_proc *cont, *handler; struct pic_proc *handler;
size_t xp_len; size_t xp_len;
ptrdiff_t xp_offset; ptrdiff_t xp_offset;
cont = pic_make_econt(pic, escape);
handler = pic_make_proc(pic, native_exception_handler, "(native-exception-handler)"); handler = pic_make_proc(pic, native_exception_handler, "(native-exception-handler)");
pic_attr_set(pic, pic_obj_value(handler), "@@escape", pic_obj_value(cont)); pic_attr_set(pic, pic_obj_value(handler), "@@escape", pic_obj_value(cont));
@ -107,19 +105,7 @@ pic_push_try(pic_state *pic, struct pic_escape *escape)
void void
pic_pop_try(pic_state *pic) pic_pop_try(pic_state *pic)
{ {
pic_value cont, escape; --pic->xp;
assert(pic->xp > pic->xpbase);
cont = pic_attr_ref(pic, pic_obj_value(*--pic->xp), "@@escape");
assert(pic_proc_p(cont));
escape = pic_attr_ref(pic, cont, "@@escape");
assert(pic_data_p(escape));
((struct pic_escape *)pic_data_ptr(escape)->data)->valid = false;
} }
struct pic_error * struct pic_error *
@ -167,7 +153,7 @@ pic_raise(pic_state *pic, pic_value err)
val = pic_raise_continuable(pic, err); val = pic_raise_continuable(pic, err);
pic_pop_try(pic); --pic->xp;
pic_errorf(pic, "error handler returned with ~s on error ~s", val, err); pic_errorf(pic, "error handler returned with ~s on error ~s", val, err);
} }

6
extlib/benz/include/picrin.h
View File

@ -48,6 +48,11 @@ extern "C" {
typedef struct pic_code pic_code; typedef struct pic_code pic_code;
typedef struct pic_jmpbuf {
PIC_JMPBUF buf;
struct pic_jmpbuf *prev;
} pic_jmpbuf;
struct pic_winder { struct pic_winder {
struct pic_proc *in; struct pic_proc *in;
struct pic_proc *out; struct pic_proc *out;
@ -73,6 +78,7 @@ typedef struct {
pic_allocf allocf; pic_allocf allocf;
pic_jmpbuf *jmp;
struct pic_winder *wind; struct pic_winder *wind;
pic_value *sp; pic_value *sp;

6
extlib/benz/include/picrin/config.h
View File

@ -21,7 +21,7 @@
/* #define PIC_NONE_IS_FALSE 1 */ /* #define PIC_NONE_IS_FALSE 1 */
/** custom setjmp/longjmp */ /** custom setjmp/longjmp */
/* #define PIC_JMPBUF_SIZE sizeof(jmp_buf) */ /* #define PIC_JMPBUF jmp_buf */
/* #define PIC_SETJMP(pic, buf) setjmp(buf) */ /* #define PIC_SETJMP(pic, buf) setjmp(buf) */
/* #define PIC_LONGJMP(pic, buf, val) longjmp((buf), (val)) */ /* #define PIC_LONGJMP(pic, buf, val) longjmp((buf), (val)) */
@ -100,9 +100,9 @@
# define PIC_NONE_IS_FALSE 1 # define PIC_NONE_IS_FALSE 1
#endif #endif
#ifndef PIC_JMPBUF_SIZE #ifndef PIC_JMPBUF
# include <setjmp.h> # include <setjmp.h>
# define PIC_JMPBUF_SIZE sizeof(jmp_buf) # define PIC_JMPBUF jmp_buf
#endif #endif
#ifndef PIC_SETJMP #ifndef PIC_SETJMP

14
extlib/benz/include/picrin/cont.h
View File

@ -9,10 +9,8 @@
extern "C" { extern "C" {
#endif #endif
struct pic_escape { struct pic_cont {
char jmp[PIC_JMPBUF_SIZE]; pic_jmpbuf jmp;
bool valid;
struct pic_winder *wind; struct pic_winder *wind;
@ -26,10 +24,10 @@ struct pic_escape {
pic_value results; pic_value results;
}; };
void pic_save_point(pic_state *, struct pic_escape *); void pic_save_point(pic_state *, struct pic_cont *);
void pic_load_point(pic_state *, struct pic_escape *); void pic_load_point(pic_state *, struct pic_cont *);
struct pic_proc *pic_make_econt(pic_state *, struct pic_escape *); struct pic_proc *pic_make_cont(pic_state *, struct pic_cont *);
void pic_wind(pic_state *, struct pic_winder *, struct pic_winder *); 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 *); pic_value pic_dynamic_wind(pic_state *, struct pic_proc *, struct pic_proc *, struct pic_proc *);
@ -44,7 +42,7 @@ pic_value pic_values_by_array(pic_state *, size_t, pic_value *);
pic_value pic_values_by_list(pic_state *, pic_value); pic_value pic_values_by_list(pic_state *, pic_value);
size_t pic_receive(pic_state *, size_t, pic_value *); size_t pic_receive(pic_state *, size_t, pic_value *);
pic_value pic_escape(pic_state *, struct pic_proc *); pic_value pic_callcc(pic_state *, struct pic_proc *);
#if defined(__cplusplus) #if defined(__cplusplus)
} }

20
extlib/benz/include/picrin/error.h
View File

@ -28,24 +28,26 @@ struct pic_error *pic_make_error(pic_state *, pic_sym *, const char *, pic_list)
pic_try_(PIC_GENSYM(escape)) pic_try_(PIC_GENSYM(escape))
#define pic_catch \ #define pic_catch \
pic_catch_(PIC_GENSYM(label)) pic_catch_(PIC_GENSYM(label))
#define pic_try_(escape) \ #define pic_try_(cont) \
do { \ do { \
struct pic_escape *escape = pic_malloc(pic, sizeof(struct pic_escape)); \ struct pic_cont *cont = pic_malloc(pic, sizeof(struct pic_cont)); \
pic_save_point(pic, escape); \ pic_save_point(pic, cont); \
if (PIC_SETJMP(pic, (void *)escape->jmp) == 0) { \ if (PIC_SETJMP(pic, cont->jmp.buf) == 0) { \
pic_push_try(pic, escape); \ do { \
do pic_push_try(pic, pic_make_cont(pic, cont));
#define pic_catch_(label) \ #define pic_catch_(label) \
while (0); \ pic_pop_try(pic); \
pic_pop_try(pic); \ } while (0); \
pic->jmp = pic->jmp->prev; \
} else { \ } else { \
pic->jmp = pic->jmp->prev; \
goto label; \ goto label; \
} \ } \
} while (0); \ } while (0); \
if (0) \ if (0) \
label: label:
void pic_push_try(pic_state *, struct pic_escape *); void pic_push_try(pic_state *, struct pic_proc *);
void pic_pop_try(pic_state *); void pic_pop_try(pic_state *);
pic_value pic_raise_continuable(pic_state *, pic_value); pic_value pic_raise_continuable(pic_state *, pic_value);

3
extlib/benz/state.c
View File

@ -156,6 +156,9 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
/* turn off GC */ /* turn off GC */
pic->gc_enable = false; pic->gc_enable = false;
/* jmp */
pic->jmp = NULL;
/* root block */ /* root block */
pic->wind = NULL; pic->wind = NULL;