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

restart of continuation should restore dynamic environment

This commit is contained in:
Yuichi Nishiwaki 2017-04-15 18:22:26 +09:00
parent 1adcd26d85
commit d4cb9e58d9
3 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
lib/cont.c
View File

@ -12,7 +12,7 @@ static pic_value
cont_call(pic_state *pic) cont_call(pic_state *pic)
{ {
int argc; int argc;
pic_value *argv; pic_value *argv, k, dyn_env;
struct context *cxt, *c; struct context *cxt, *c;
int i; int i;
@ -30,26 +30,31 @@ cont_call(pic_state *pic)
pic_error(pic, "calling dead escape continuation", 0); pic_error(pic, "calling dead escape continuation", 0);
} }
k = pic_closure_ref(pic, 1);
dyn_env = pic_closure_ref(pic, 2);
#define MKCALLK(argc) \ #define MKCALLK(argc) \
(cxt->tmpcode[0] = OP_CALL, cxt->tmpcode[1] = (argc), cxt->tmpcode) (cxt->tmpcode[0] = OP_CALL, cxt->tmpcode[1] = (argc), cxt->tmpcode)
cxt->pc = MKCALLK(argc); cxt->pc = MKCALLK(argc);
cxt->sp = pic_make_frame_unsafe(pic, argc + 2); cxt->sp = pic_make_frame_unsafe(pic, argc + 2);
cxt->sp->regs[0] = pic_closure_ref(pic, 1); /* cont. */ cxt->sp->regs[0] = k;
for (i = 0; i < argc; ++i) { for (i = 0; i < argc; ++i) {
cxt->sp->regs[i + 1] = argv[i]; cxt->sp->regs[i + 1] = argv[i];
} }
pic->cxt = cxt; pic->cxt = cxt;
pic->dyn_env = dyn_env;
longjmp(cxt->jmp, 1); longjmp(cxt->jmp, 1);
PIC_UNREACHABLE(); PIC_UNREACHABLE();
} }
pic_value pic_value
pic_make_cont(pic_state *pic, struct context *cxt, pic_value k) pic_make_cont(pic_state *pic, struct context *cxt, pic_value k, pic_value dyn_env)
{ {
static const pic_data_type cxt_type = { "cxt", NULL }; static const pic_data_type cxt_type = { "cxt", NULL };
return pic_lambda(pic, cont_call, 2, pic_data_value(pic, cxt, &cxt_type), k); return pic_lambda(pic, cont_call, 3, pic_data_value(pic, cxt, &cxt_type), k, dyn_env);
} }
static pic_value static pic_value
@ -59,7 +64,7 @@ pic_cont_callcc(pic_state *pic)
pic_get_args(pic, "l", &f); pic_get_args(pic, "l", &f);
args[0] = pic_make_cont(pic, pic->cxt, pic->cxt->fp->regs[1]); args[0] = pic_make_cont(pic, pic->cxt, pic->cxt->fp->regs[1], pic->dyn_env);
return pic_applyk(pic, f, 1, args); return pic_applyk(pic, f, 1, args);
} }

2
lib/error.c
View File

@ -69,7 +69,7 @@ pic_enter_try(pic_state *pic)
pic_value var, env; pic_value var, env;
/* call/cc */ /* call/cc */
cont = pic_make_cont(pic, pic->cxt, pic_invalid_value(pic)); cont = pic_make_cont(pic, pic->cxt, pic_invalid_value(pic), pic->dyn_env);
handler = pic_lambda(pic, native_exception_handler, 1, cont); handler = pic_lambda(pic, native_exception_handler, 1, cont);
/* with-exception-handler */ /* with-exception-handler */
var = pic_exc(pic); var = pic_exc(pic);

2
lib/object.h
View File

@ -272,7 +272,7 @@ pic_value pic_make_record(pic_state *, pic_value type, pic_value datum);
pic_value pic_record_type(pic_state *pic, pic_value record); pic_value pic_record_type(pic_state *pic, pic_value record);
pic_value pic_record_datum(pic_state *pic, pic_value record); pic_value pic_record_datum(pic_state *pic, pic_value record);
struct context; struct context;
pic_value pic_make_cont(pic_state *pic, struct context *cxt, pic_value k); pic_value pic_make_cont(pic_state *pic, struct context *cxt, pic_value k, pic_value dyn_env);
struct rope *pic_rope_incref(struct rope *); struct rope *pic_rope_incref(struct rope *);
void pic_rope_decref(pic_state *, struct rope *); void pic_rope_decref(pic_state *, struct rope *);