picrin/contrib/10.callcc/callcc.c

257 lines
5.8 KiB
C
Raw Normal View History

2014-09-20 07:30:36 -04:00
#include "picrin.h"
2016-02-20 11:13:16 -05:00
#include "picrin/private/object.h"
#include "picrin/private/state.h"
2014-09-20 07:30:36 -04:00
2016-02-21 06:32:00 -05:00
struct fullcont {
2014-09-20 07:30:36 -04:00
jmp_buf jmp;
2016-02-23 08:48:06 -05:00
struct cont *prev_jmp;
2016-02-21 06:32:00 -05:00
struct checkpoint *cp;
2014-09-20 07:30:36 -04:00
char *stk_pos, *stk_ptr;
ptrdiff_t stk_len;
pic_value *st_ptr;
2015-07-26 03:39:34 -04:00
size_t sp_offset;
ptrdiff_t st_len;
2014-09-20 07:30:36 -04:00
2016-02-21 06:32:00 -05:00
struct callinfo *ci_ptr;
2015-07-26 03:39:34 -04:00
size_t ci_offset;
ptrdiff_t ci_len;
2014-09-20 07:30:36 -04:00
2016-02-29 13:14:18 -05:00
const struct code *ip;
2014-09-20 07:30:36 -04:00
2016-02-21 06:32:00 -05:00
struct object **arena;
2015-07-26 03:44:13 -04:00
size_t arena_size, arena_idx;
2014-09-20 07:30:36 -04:00
int retc;
pic_value *retv;
2014-09-20 07:30:36 -04:00
};
2016-02-24 02:32:24 -05:00
char *picrin_native_stack_start;
2014-09-20 07:30:36 -04:00
static void
cont_dtor(pic_state *pic, void *data)
{
2016-02-21 06:32:00 -05:00
struct fullcont *cont = data;
2014-09-20 07:30:36 -04:00
pic_free(pic, cont->stk_ptr);
pic_free(pic, cont->st_ptr);
pic_free(pic, cont->ci_ptr);
pic_free(pic, cont->arena);
pic_free(pic, cont);
}
static void
cont_mark(pic_state *pic, void *data, void (*mark)(pic_state *, pic_value))
{
2016-02-21 06:32:00 -05:00
struct fullcont *cont = data;
struct checkpoint *cp;
2014-09-20 07:30:36 -04:00
pic_value *stack;
2016-02-21 06:32:00 -05:00
struct callinfo *ci;
2014-09-20 07:30:36 -04:00
size_t i;
2015-06-08 08:04:04 -04:00
/* checkpoint */
for (cp = cont->cp; cp != NULL; cp = cp->prev) {
if (cp->in) {
mark(pic, pic_obj_value(cp->in));
2014-09-20 07:30:36 -04:00
}
2015-06-08 08:04:04 -04:00
if (cp->out) {
mark(pic, pic_obj_value(cp->out));
2014-09-20 07:30:36 -04:00
}
}
/* stack */
for (stack = cont->st_ptr; stack != cont->st_ptr + cont->sp_offset; ++stack) {
mark(pic, *stack);
}
/* callinfo */
for (ci = cont->ci_ptr + cont->ci_offset; ci != cont->ci_ptr; --ci) {
2015-05-30 09:34:51 -04:00
if (ci->cxt) {
mark(pic, pic_obj_value(ci->cxt));
2014-09-20 07:30:36 -04:00
}
}
/* arena */
2015-07-26 03:44:13 -04:00
for (i = 0; i < cont->arena_idx; ++i) {
2014-09-20 07:30:36 -04:00
mark(pic, pic_obj_value(cont->arena[i]));
}
}
static const pic_data_type cont_type = { "continuation", cont_dtor, cont_mark };
2016-03-13 21:54:25 -04:00
static void save_cont(pic_state *, struct fullcont *);
2016-02-21 06:32:00 -05:00
static void restore_cont(pic_state *, struct fullcont *);
2014-09-20 07:30:36 -04:00
2016-03-13 21:54:25 -04:00
#if __GNUC__
# define NOINLINE __attribute__ ((noinline))
#else
# define NOINLINE
#endif
static ptrdiff_t NOINLINE
2016-02-24 02:32:24 -05:00
native_stack_length(char **pos)
2014-09-20 07:30:36 -04:00
{
char t;
2016-02-24 02:32:24 -05:00
*pos = (picrin_native_stack_start > &t)
2014-09-20 07:30:36 -04:00
? &t
2016-02-24 02:32:24 -05:00
: picrin_native_stack_start;
2014-09-20 07:30:36 -04:00
2016-02-24 02:32:24 -05:00
return (picrin_native_stack_start > &t)
? picrin_native_stack_start - &t
: &t - picrin_native_stack_start;
2014-09-20 07:30:36 -04:00
}
2016-03-13 21:54:25 -04:00
static void NOINLINE
save_cont(pic_state *pic, struct fullcont *cont)
2014-09-20 07:30:36 -04:00
{
void pic_vm_tear_off(pic_state *);
char *pos;
pic_vm_tear_off(pic); /* tear off */
2015-06-22 14:02:12 -04:00
cont->prev_jmp = pic->cc;
2015-06-08 08:04:04 -04:00
cont->cp = pic->cp;
2014-09-20 07:30:36 -04:00
2016-02-24 02:32:24 -05:00
cont->stk_len = native_stack_length(&pos);
2014-09-20 07:30:36 -04:00
cont->stk_pos = pos;
assert(cont->stk_len > 0);
2015-05-28 03:42:16 -04:00
cont->stk_ptr = pic_malloc(pic, cont->stk_len);
2014-09-20 07:30:36 -04:00
memcpy(cont->stk_ptr, cont->stk_pos, cont->stk_len);
cont->sp_offset = pic->sp - pic->stbase;
cont->st_len = pic->stend - pic->stbase;
2015-05-28 03:42:16 -04:00
cont->st_ptr = pic_malloc(pic, sizeof(pic_value) * cont->st_len);
2014-09-20 07:30:36 -04:00
memcpy(cont->st_ptr, pic->stbase, sizeof(pic_value) * cont->st_len);
cont->ci_offset = pic->ci - pic->cibase;
cont->ci_len = pic->ciend - pic->cibase;
2016-02-21 06:32:00 -05:00
cont->ci_ptr = pic_malloc(pic, sizeof(struct callinfo) * cont->ci_len);
memcpy(cont->ci_ptr, pic->cibase, sizeof(struct callinfo) * cont->ci_len);
2014-09-20 07:30:36 -04:00
cont->ip = pic->ip;
cont->arena_idx = pic->arena_idx;
cont->arena_size = pic->arena_size;
2016-02-21 06:32:00 -05:00
cont->arena = pic_malloc(pic, sizeof(struct object *) * pic->arena_size);
memcpy(cont->arena, pic->arena, sizeof(struct object *) * pic->arena_size);
2014-09-20 07:30:36 -04:00
cont->retc = 0;
cont->retv = NULL;
2014-09-20 07:30:36 -04:00
}
2016-03-13 21:54:25 -04:00
static void NOINLINE
2016-02-21 06:32:00 -05:00
native_stack_extend(pic_state *pic, struct fullcont *cont)
2014-09-20 07:30:36 -04:00
{
2016-03-13 21:54:25 -04:00
pic_value v[1024];
memset(v, 0, sizeof v);
2014-09-20 07:30:36 -04:00
restore_cont(pic, cont);
}
2015-01-25 22:22:38 -05:00
PIC_NORETURN static void
2016-02-21 06:32:00 -05:00
restore_cont(pic_state *pic, struct fullcont *cont)
2014-09-20 07:30:36 -04:00
{
char v;
2016-02-21 06:32:00 -05:00
struct fullcont *tmp = cont;
2014-09-20 07:30:36 -04:00
2016-02-24 02:32:24 -05:00
if (&v < picrin_native_stack_start) {
2014-09-20 07:30:36 -04:00
if (&v > cont->stk_pos) native_stack_extend(pic, cont);
}
else {
if (&v < cont->stk_pos + cont->stk_len) native_stack_extend(pic, cont);
2014-09-20 07:30:36 -04:00
}
2015-06-22 14:02:12 -04:00
pic->cc = cont->prev_jmp;
2015-06-08 08:04:04 -04:00
pic->cp = cont->cp;
2014-09-20 07:30:36 -04:00
2015-07-26 03:39:34 -04:00
assert(pic->stend - pic->stbase >= cont->st_len);
2014-09-20 07:30:36 -04:00
memcpy(pic->stbase, cont->st_ptr, sizeof(pic_value) * cont->st_len);
pic->sp = pic->stbase + cont->sp_offset;
pic->stend = pic->stbase + cont->st_len;
2015-07-26 03:39:34 -04:00
assert(pic->ciend - pic->cibase >= cont->ci_len);
2016-02-21 06:32:00 -05:00
memcpy(pic->cibase, cont->ci_ptr, sizeof(struct callinfo) * cont->ci_len);
2014-09-20 07:30:36 -04:00
pic->ci = pic->cibase + cont->ci_offset;
pic->ciend = pic->cibase + cont->ci_len;
pic->ip = cont->ip;
2015-07-26 03:39:34 -04:00
assert(pic->arena_size >= cont->arena_size);
2016-02-21 06:32:00 -05:00
memcpy(pic->arena, cont->arena, sizeof(struct object *) * cont->arena_size);
2014-09-20 07:30:36 -04:00
pic->arena_size = cont->arena_size;
pic->arena_idx = cont->arena_idx;
memcpy(cont->stk_pos, cont->stk_ptr, cont->stk_len);
longjmp(tmp->jmp, 1);
}
2015-01-25 22:22:38 -05:00
PIC_NORETURN static pic_value
2014-09-20 07:30:36 -04:00
cont_call(pic_state *pic)
{
int argc, i;
pic_value *argv, *retv;
2016-02-21 06:32:00 -05:00
struct fullcont *cont;
2014-09-20 07:30:36 -04:00
pic_get_args(pic, "*", &argc, &argv);
2014-09-20 07:30:36 -04:00
retv = pic_alloca(pic, sizeof(pic_value) * argc);
for (i = 0; i < argc; ++i) {
retv[i] = argv[i];
}
2016-02-18 10:50:13 -05:00
cont = pic_data(pic, pic_closure_ref(pic, 0));
cont->retc = argc;
cont->retv = retv;
2014-09-20 07:30:36 -04:00
/* execute guard handlers */
2015-06-08 08:04:04 -04:00
pic_wind(pic, pic->cp, cont->cp);
2014-09-20 07:30:36 -04:00
restore_cont(pic, cont);
}
2016-02-19 03:38:49 -05:00
static pic_value
2016-02-19 10:03:16 -05:00
pic_callcc(pic_state *pic, pic_value proc)
2014-09-20 07:30:36 -04:00
{
2016-03-13 21:54:25 -04:00
struct fullcont *cont = pic_malloc(pic, sizeof(struct fullcont));
2014-09-20 07:30:36 -04:00
2016-03-13 21:54:25 -04:00
if (setjmp(cont->jmp) != 0) {
return pic_valuesk(pic, cont->retc, cont->retv);
2016-03-13 21:54:25 -04:00
} else {
pic_value c[1];
save_cont(pic, cont);
2014-09-20 07:30:36 -04:00
/* save the continuation object in proc */
2016-03-13 21:54:25 -04:00
c[0] = pic_lambda(pic, cont_call, 1, pic_data_value(pic, cont, &cont_type));
2014-09-20 07:30:36 -04:00
2016-03-13 21:54:25 -04:00
return pic_applyk(pic, proc, 1, c);
2014-09-20 07:30:36 -04:00
}
}
static pic_value
2015-07-04 05:01:30 -04:00
pic_callcc_callcc(pic_state *pic)
2014-09-20 07:30:36 -04:00
{
2016-02-19 10:03:16 -05:00
pic_value proc;
2014-09-20 07:30:36 -04:00
2015-07-04 05:01:30 -04:00
pic_get_args(pic, "l", &proc);
2016-02-19 03:38:49 -05:00
return pic_callcc(pic, proc);
2014-09-20 07:30:36 -04:00
}
2016-02-19 10:03:16 -05:00
#define pic_redefun(pic, lib, name, func) \
pic_set(pic, lib, name, pic_lambda(pic, func, 0))
2014-09-20 07:30:36 -04:00
void
pic_init_callcc(pic_state *pic)
{
pic_redefun(pic, "picrin.base", "call-with-current-continuation", pic_callcc_callcc);
pic_redefun(pic, "picrin.base", "call/cc", pic_callcc_callcc);
2014-09-20 07:30:36 -04:00
}