suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

reduce the cost of nested full continuations

Browse Source 
while allowing full continuations to be used to escape
  across a continuation barrier
This commit is contained in:
Matthew Flatt 2010-07-16 20:39:01 -06:00
parent 8aa4fae613
commit 31fc380e39
3 changed files with 60 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/racket/src/eval.c
View File

@ -8768,7 +8768,8 @@ static int exec_dyn_wind_posts(Scheme_Dynamic_Wind *common, Scheme_Cont *c, int
return common_depth;
}
Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Object **rands, Scheme_Object **old_runstack)
Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
Scheme_Object **old_runstack, int can_ec)
{
Scheme_Thread *p = scheme_current_thread;
Scheme_Cont *c;
@ -8781,7 +8782,8 @@ Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Sc
c = (Scheme_Cont *)obj;
if (c->escape_cont
if (can_ec
&& c->escape_cont
&& scheme_escape_continuation_ok(c->escape_cont))
scheme_escape_to_continuation(c->escape_cont, num_rands, rands, (Scheme_Object *)c);
@ -9475,7 +9477,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
#endif
} else if (type == scheme_cont_type) {
UPDATE_THREAD_RSPTR();
v = scheme_jump_to_continuation(obj, num_rands, rands, old_runstack);
v = scheme_jump_to_continuation(obj, num_rands, rands, old_runstack, 1);
} else if (type == scheme_escaping_cont_type) {
UPDATE_THREAD_RSPTR();
scheme_escape_to_continuation(obj, num_rands, rands, NULL);

61
src/racket/src/fun.c
View File

@ -190,6 +190,8 @@ scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key
Scheme_Object *prompt_tag, Scheme_Meta_Continuation **_meta,
MZ_MARK_POS_TYPE *_vpos);
static Scheme_Object *jump_to_alt_continuation();
typedef void (*DW_PrePost_Proc)(void *);
#define CONS(a,b) scheme_make_pair(a,b)
@ -4517,6 +4519,7 @@ do_call_ec (int argc, Scheme_Object *argv[], Scheme_Object *_for_cc)
cont->saveerr = p1->error_buf;
p1->error_buf = &newbuf;
cont->myerr = &newbuf;
scheme_save_env_stack_w_thread(cont->envss, p1);
@ -4533,7 +4536,19 @@ do_call_ec (int argc, Scheme_Object *argv[], Scheme_Object *_for_cc)
Scheme_Thread *p2 = scheme_current_thread;
if (p2->cjs.jumping_to_continuation
&& SAME_OBJ(p2->cjs.jumping_to_continuation, (Scheme_Object *)cont)) {
int n = p2->cjs.num_vals;
Scheme_Object *alt_cont;
int n;
alt_cont = p2->cjs.alt_full_continuation;
if (alt_cont && !((Scheme_Cont *)alt_cont)->orig_escape_cont) {
/* The escape continuation does not exactly match the target
continuation; the fll continuation was just re-using an
existing escape continuation. Now that there's no barrier
in the way, jump to the full continuation. */
return jump_to_alt_continuation();
}
n = p2->cjs.num_vals;
v = p2->cjs.val;
reset_cjs(&p2->cjs);
scheme_restore_env_stack_w_thread(cont->envss, p2);
@ -4545,6 +4560,7 @@ do_call_ec (int argc, Scheme_Object *argv[], Scheme_Object *_for_cc)
}
} else if (for_cc) {
((Scheme_Cont *)for_cc)->escape_cont = (Scheme_Object *)cont;
((Scheme_Cont *)for_cc)->orig_escape_cont = 1;
a[0] = (Scheme_Object *)for_cc;
MZ_CONT_MARK_POS -= 2;
v = _scheme_apply_multi(argv[0], 1, a);
@ -5973,6 +5989,7 @@ internal_call_cc (int argc, Scheme_Object *argv[])
MZ_MARK_POS_TYPE prompt_pos, barrier_pos;
Scheme_Thread *p = scheme_current_thread;
Scheme_Prompt *prompt, *barrier_prompt, *effective_barrier_prompt;
Scheme_Object *ec;
GC_CAN_IGNORE void *stack_start;
int composable;
@ -6018,6 +6035,18 @@ internal_call_cc (int argc, Scheme_Object *argv[])
sub_cont = NULL;
else
sub_cont = (Scheme_Cont *)scheme_extract_one_cc_mark(NULL, cont_key);
if (sub_cont
&& (sub_cont->save_overflow == p->overflow)
&& (sub_cont->prompt_tag == prompt_tag)
&& (sub_cont->barrier_prompt == effective_barrier_prompt)
&& (((Scheme_Escaping_Cont *)sub_cont->escape_cont)->myerr == p->error_buf)) {
/* Whether sub_cont turns out to be the same continuaiton, we can use
its escape continuation, because jumping to the escape continuation
triggers the same C-level clean-up actions, same `dynamic-wind's, and
crosses the same continuation barriers. */
ec = sub_cont->escape_cont;
} else
ec = NULL;
if (sub_cont && ((sub_cont->save_overflow != p->overflow)
|| (sub_cont->prompt_tag != prompt_tag)
|| (sub_cont->barrier_prompt != effective_barrier_prompt)
@ -6135,6 +6164,8 @@ internal_call_cc (int argc, Scheme_Object *argv[])
when calling `cont' composably (i.e., when supplying a resume). */
cont->prompt_stack_start = stack_start;
cont->escape_cont = ec;
/* Zero out any local variable that shouldn't be saved by the
continuation. The meta-continuation for the prompt is an
especially important one to zero out (otherwise we build up
@ -6187,7 +6218,7 @@ internal_call_cc (int argc, Scheme_Object *argv[])
scheme_check_break_now();
return result;
} else if (composable) {
} else if (composable || cont->escape_cont) {
Scheme_Object *argv2[1];
argv2[0] = (Scheme_Object *)cont;
@ -8381,14 +8412,7 @@ Scheme_Object *scheme_dynamic_wind(void (*pre)(void *),
if (p->cjs.alt_full_continuation) {
/* We were trying to execute a full-continuation jump through
an escape-continuation jump. Go back to full-jump mode. */
Scheme_Object *a[1], **args, *fc;
a[0] = p->cjs.val;
fc = p->cjs.alt_full_continuation;
args = ((p->cjs.num_vals == 1) ? a : (Scheme_Object **)p->cjs.val);
p->cjs.jumping_to_continuation = NULL;
p->cjs.alt_full_continuation = NULL;
p->cjs.val = NULL;
return scheme_jump_to_continuation(fc, p->cjs.num_vals, args, NULL);
return jump_to_alt_continuation();
}
scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION,
"jump to escape continuation in progress,"
@ -8521,6 +8545,23 @@ void scheme_apply_dw_in_meta(Scheme_Dynamic_Wind *dw, int post_part, int meta_de
p->meta_continuation = old_mc;
}
static Scheme_Object *jump_to_alt_continuation()
{
Scheme_Thread *p;
Scheme_Object *a[1], **args, *fc;
p = scheme_current_thread;
a[0] = p->cjs.val;
fc = p->cjs.alt_full_continuation;
args = ((p->cjs.num_vals == 1) ? a : (Scheme_Object **)p->cjs.val);
p->cjs.jumping_to_continuation = NULL;
p->cjs.alt_full_continuation = NULL;
p->cjs.val = NULL;
return scheme_jump_to_continuation(fc, p->cjs.num_vals, args, NULL, 0);
}
/*========================================================================*/
/* time */
/*========================================================================*/

6
src/racket/src/schpriv.h
View File

@ -1346,6 +1346,7 @@ typedef struct Scheme_Cont {
mz_jmp_buf *savebuf; /* save old error buffer here */
Scheme_Object *escape_cont;
int orig_escape_cont;
/* Arguments passed to a continuation invocation to the continuation restorer: */
Scheme_Object *value; /* argument(s) to continuation */
@ -1366,7 +1367,7 @@ typedef struct Scheme_Escaping_Cont {
#ifdef MZ_USE_JIT
Scheme_Object *native_trace;
#endif
mz_jmp_buf *saveerr;
mz_jmp_buf *saveerr, *myerr;
} Scheme_Escaping_Cont;
#define SCHEME_CONT_F(obj) (((Scheme_Escaping_Cont *)(obj))->f)
@ -1477,7 +1478,8 @@ void scheme_about_to_move_C_stack(void);
Scheme_Object *scheme_apply_multi_with_dynamic_state(Scheme_Object *rator, int num_rands, Scheme_Object **rands, Scheme_Dynamic_State *dyn_state);
Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Object **rands, Scheme_Object **old_runstack);
Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
Scheme_Object **old_runstack, int can_ec);
/*========================================================================*/
/* semaphores and locks */