spill out continuation type to extra data type family
This commit is contained in:
parent
17602a5c8d
commit
6b1be61596
106
cont.c
106
cont.c
|
@ -10,6 +10,7 @@
|
||||||
#include "picrin/proc.h"
|
#include "picrin/proc.h"
|
||||||
#include "picrin/cont.h"
|
#include "picrin/cont.h"
|
||||||
#include "picrin/pair.h"
|
#include "picrin/pair.h"
|
||||||
|
#include "picrin/data.h"
|
||||||
#include "picrin/error.h"
|
#include "picrin/error.h"
|
||||||
|
|
||||||
pic_value
|
pic_value
|
||||||
|
@ -93,6 +94,93 @@ pic_receive(pic_state *pic, size_t n, pic_value *argv)
|
||||||
return retc;
|
return retc;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
struct pic_cont {
|
||||||
|
jmp_buf jmp;
|
||||||
|
|
||||||
|
struct pic_winder *wind;
|
||||||
|
|
||||||
|
char *stk_pos, *stk_ptr;
|
||||||
|
ptrdiff_t stk_len;
|
||||||
|
|
||||||
|
pic_value *st_ptr;
|
||||||
|
size_t sp_offset, st_len;
|
||||||
|
|
||||||
|
pic_callinfo *ci_ptr;
|
||||||
|
size_t ci_offset, ci_len;
|
||||||
|
|
||||||
|
struct pic_proc **xp_ptr;
|
||||||
|
size_t xp_offset, xp_len;
|
||||||
|
|
||||||
|
pic_code *ip;
|
||||||
|
|
||||||
|
struct pic_object **arena;
|
||||||
|
size_t arena_size;
|
||||||
|
int arena_idx;
|
||||||
|
|
||||||
|
pic_value results;
|
||||||
|
};
|
||||||
|
|
||||||
|
static void
|
||||||
|
cont_dtor(pic_state *pic, void *data)
|
||||||
|
{
|
||||||
|
struct pic_cont *cont = 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);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void
|
||||||
|
cont_mark(pic_state *pic, void *data, void (*mark)(pic_state *, pic_value))
|
||||||
|
{
|
||||||
|
struct pic_cont *cont = data;
|
||||||
|
struct pic_winder *wind;
|
||||||
|
pic_value *stack;
|
||||||
|
pic_callinfo *ci;
|
||||||
|
struct pic_proc **xp;
|
||||||
|
size_t i;
|
||||||
|
|
||||||
|
/* winder */
|
||||||
|
for (wind = cont->wind; wind != NULL; wind = wind->prev) {
|
||||||
|
if (wind->in) {
|
||||||
|
mark(pic, pic_obj_value(wind->in));
|
||||||
|
}
|
||||||
|
if (wind->out) {
|
||||||
|
mark(pic, pic_obj_value(wind->out));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* 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) {
|
||||||
|
if (ci->env) {
|
||||||
|
mark(pic, pic_obj_value(ci->env));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* 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 < (size_t)cont->arena_idx; ++i) {
|
||||||
|
mark(pic, pic_obj_value(cont->arena[i]));
|
||||||
|
}
|
||||||
|
|
||||||
|
/* result values */
|
||||||
|
mark(pic, cont->results);
|
||||||
|
}
|
||||||
|
|
||||||
|
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_cont **);
|
||||||
static void restore_cont(pic_state *, struct pic_cont *);
|
static void restore_cont(pic_state *, struct pic_cont *);
|
||||||
|
|
||||||
|
@ -119,7 +207,7 @@ save_cont(pic_state *pic, struct pic_cont **c)
|
||||||
|
|
||||||
pic_vm_tear_off(pic); /* tear off */
|
pic_vm_tear_off(pic); /* tear off */
|
||||||
|
|
||||||
cont = *c = (struct pic_cont *)pic_obj_alloc(pic, sizeof(struct pic_cont), PIC_TT_CONT);
|
cont = *c = pic_alloc(pic, sizeof(struct pic_cont));
|
||||||
|
|
||||||
cont->wind = pic->wind;
|
cont->wind = pic->wind;
|
||||||
|
|
||||||
|
@ -148,7 +236,7 @@ save_cont(pic_state *pic, struct pic_cont **c)
|
||||||
|
|
||||||
cont->arena_idx = pic->arena_idx;
|
cont->arena_idx = pic->arena_idx;
|
||||||
cont->arena_size = pic->arena_size;
|
cont->arena_size = pic->arena_size;
|
||||||
cont->arena = (struct pic_object **)pic_alloc(pic, sizeof(struct pic_object *) * pic->arena_size);
|
cont->arena = pic_alloc(pic, sizeof(struct pic_object *) * pic->arena_size);
|
||||||
memcpy(cont->arena, pic->arena, sizeof(struct pic_object *) * pic->arena_size);
|
memcpy(cont->arena, pic->arena, sizeof(struct pic_object *) * pic->arena_size);
|
||||||
|
|
||||||
cont->results = pic_undef_value();
|
cont->results = pic_undef_value();
|
||||||
|
@ -195,7 +283,7 @@ restore_cont(pic_state *pic, struct pic_cont *cont)
|
||||||
|
|
||||||
pic->ip = cont->ip;
|
pic->ip = cont->ip;
|
||||||
|
|
||||||
pic->arena = (struct pic_object **)pic_realloc(pic, pic->arena, sizeof(struct pic_object *) * cont->arena_size);
|
pic->arena = pic_realloc(pic, pic->arena, sizeof(struct pic_object *) * cont->arena_size);
|
||||||
memcpy(pic->arena, cont->arena, sizeof(struct pic_object *) * cont->arena_size);
|
memcpy(pic->arena, cont->arena, sizeof(struct pic_object *) * cont->arena_size);
|
||||||
pic->arena_size = cont->arena_size;
|
pic->arena_size = cont->arena_size;
|
||||||
pic->arena_idx = cont->arena_idx;
|
pic->arena_idx = cont->arena_idx;
|
||||||
|
@ -260,7 +348,7 @@ cont_call(pic_state *pic)
|
||||||
proc = pic_get_proc(pic);
|
proc = pic_get_proc(pic);
|
||||||
pic_get_args(pic, "*", &argc, &argv);
|
pic_get_args(pic, "*", &argc, &argv);
|
||||||
|
|
||||||
cont = (struct pic_cont *)pic_ptr(pic_attr_ref(pic, proc, "@@cont"));
|
cont = pic_data_ptr(pic_attr_ref(pic, proc, "@@cont"))->data;
|
||||||
cont->results = pic_list_by_array(pic, argc, argv);
|
cont->results = pic_list_by_array(pic, argc, argv);
|
||||||
|
|
||||||
/* execute guard handlers */
|
/* execute guard handlers */
|
||||||
|
@ -280,11 +368,14 @@ pic_callcc(pic_state *pic, struct pic_proc *proc)
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
struct pic_proc *c;
|
struct pic_proc *c;
|
||||||
|
struct pic_data *dat;
|
||||||
|
|
||||||
c = pic_make_proc(pic, cont_call, "<continuation-procedure>");
|
c = pic_make_proc(pic, cont_call, "<continuation-procedure>");
|
||||||
|
|
||||||
|
dat = pic_data_alloc(pic, &cont_type, cont);
|
||||||
|
|
||||||
/* save the continuation object in proc */
|
/* save the continuation object in proc */
|
||||||
pic_attr_set(pic, c, "@@cont", pic_obj_value(cont));
|
pic_attr_set(pic, c, "@@cont", pic_obj_value(dat));
|
||||||
|
|
||||||
return pic_apply1(pic, proc, pic_obj_value(c));
|
return pic_apply1(pic, proc, pic_obj_value(c));
|
||||||
}
|
}
|
||||||
|
@ -301,11 +392,14 @@ pic_callcc_trampoline(pic_state *pic, struct pic_proc *proc)
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
struct pic_proc *c;
|
struct pic_proc *c;
|
||||||
|
struct pic_data *dat;
|
||||||
|
|
||||||
c = pic_make_proc(pic, cont_call, "<continuation-procedure>");
|
c = pic_make_proc(pic, cont_call, "<continuation-procedure>");
|
||||||
|
|
||||||
|
dat = pic_data_alloc(pic, &cont_type, cont);
|
||||||
|
|
||||||
/* save the continuation object in proc */
|
/* save the continuation object in proc */
|
||||||
pic_attr_set(pic, c, "@@cont", pic_obj_value(cont));
|
pic_attr_set(pic, c, "@@cont", pic_obj_value(dat));
|
||||||
|
|
||||||
return pic_apply_trampoline(pic, proc, pic_list1(pic, pic_obj_value(c)));
|
return pic_apply_trampoline(pic, proc, pic_list1(pic, pic_obj_value(c)));
|
||||||
}
|
}
|
||||||
|
|
45
gc.c
45
gc.c
|
@ -412,42 +412,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
|
||||||
case PIC_TT_BLOB: {
|
case PIC_TT_BLOB: {
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case PIC_TT_CONT: {
|
|
||||||
struct pic_cont *cont = (struct pic_cont *)obj;
|
|
||||||
pic_value *stack;
|
|
||||||
pic_callinfo *ci;
|
|
||||||
struct pic_proc **xhandler;
|
|
||||||
size_t i;
|
|
||||||
|
|
||||||
/* winder */
|
|
||||||
gc_mark_winder(pic, cont->wind);
|
|
||||||
|
|
||||||
/* stack */
|
|
||||||
for (stack = cont->st_ptr; stack != cont->st_ptr + cont->sp_offset; ++stack) {
|
|
||||||
gc_mark(pic, *stack);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* callinfo */
|
|
||||||
for (ci = cont->ci_ptr + cont->ci_offset; ci != cont->ci_ptr; --ci) {
|
|
||||||
if (ci->env) {
|
|
||||||
gc_mark_object(pic, (struct pic_object *)ci->env);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* exception handlers */
|
|
||||||
for (xhandler = cont->xp_ptr; xhandler != cont->xp_ptr + cont->xp_offset; ++xhandler) {
|
|
||||||
gc_mark_object(pic, (struct pic_object *)*xhandler);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* arena */
|
|
||||||
for (i = 0; i < (size_t)cont->arena_idx; ++i) {
|
|
||||||
gc_mark_object(pic, cont->arena[i]);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* result values */
|
|
||||||
gc_mark(pic, cont->results);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
case PIC_TT_MACRO: {
|
case PIC_TT_MACRO: {
|
||||||
struct pic_macro *mac = (struct pic_macro *)obj;
|
struct pic_macro *mac = (struct pic_macro *)obj;
|
||||||
|
|
||||||
|
@ -663,15 +627,6 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
|
||||||
case PIC_TT_ERROR: {
|
case PIC_TT_ERROR: {
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case PIC_TT_CONT: {
|
|
||||||
struct pic_cont *cont = (struct pic_cont *)obj;
|
|
||||||
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);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
case PIC_TT_SENV: {
|
case PIC_TT_SENV: {
|
||||||
struct pic_senv *senv = (struct pic_senv *)obj;
|
struct pic_senv *senv = (struct pic_senv *)obj;
|
||||||
xh_destroy(&senv->map);
|
xh_destroy(&senv->map);
|
||||||
|
|
|
@ -9,33 +9,6 @@
|
||||||
extern "C" {
|
extern "C" {
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
struct pic_cont {
|
|
||||||
PIC_OBJECT_HEADER
|
|
||||||
jmp_buf jmp;
|
|
||||||
|
|
||||||
struct pic_winder *wind;
|
|
||||||
|
|
||||||
char *stk_pos, *stk_ptr;
|
|
||||||
ptrdiff_t stk_len;
|
|
||||||
|
|
||||||
pic_value *st_ptr;
|
|
||||||
size_t sp_offset, st_len;
|
|
||||||
|
|
||||||
pic_callinfo *ci_ptr;
|
|
||||||
size_t ci_offset, ci_len;
|
|
||||||
|
|
||||||
struct pic_proc **xp_ptr;
|
|
||||||
size_t xp_offset, xp_len;
|
|
||||||
|
|
||||||
pic_code *ip;
|
|
||||||
|
|
||||||
struct pic_object **arena;
|
|
||||||
size_t arena_size;
|
|
||||||
int arena_idx;
|
|
||||||
|
|
||||||
pic_value results;
|
|
||||||
};
|
|
||||||
|
|
||||||
pic_value pic_values0(pic_state *);
|
pic_value pic_values0(pic_state *);
|
||||||
pic_value pic_values1(pic_state *, pic_value);
|
pic_value pic_values1(pic_state *, pic_value);
|
||||||
pic_value pic_values2(pic_state *, pic_value, pic_value);
|
pic_value pic_values2(pic_state *, pic_value, pic_value);
|
||||||
|
|
|
@ -117,7 +117,6 @@ enum pic_tt {
|
||||||
PIC_TT_PORT,
|
PIC_TT_PORT,
|
||||||
PIC_TT_ERROR,
|
PIC_TT_ERROR,
|
||||||
PIC_TT_ENV,
|
PIC_TT_ENV,
|
||||||
PIC_TT_CONT,
|
|
||||||
PIC_TT_SENV,
|
PIC_TT_SENV,
|
||||||
PIC_TT_MACRO,
|
PIC_TT_MACRO,
|
||||||
PIC_TT_LIB,
|
PIC_TT_LIB,
|
||||||
|
@ -255,8 +254,6 @@ pic_type_repr(enum pic_tt tt)
|
||||||
return "error";
|
return "error";
|
||||||
case PIC_TT_ENV:
|
case PIC_TT_ENV:
|
||||||
return "env";
|
return "env";
|
||||||
case PIC_TT_CONT:
|
|
||||||
return "cont";
|
|
||||||
case PIC_TT_PROC:
|
case PIC_TT_PROC:
|
||||||
return "proc";
|
return "proc";
|
||||||
case PIC_TT_SENV:
|
case PIC_TT_SENV:
|
||||||
|
|
Loading…
Reference in New Issue