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

fix internal meta-continuation comparison for continuation sharing

Browse Source 
The check that the current meta-continuation matches the captured one
would always fail (I think), since the current meta-continuation is
pruned on capture. Keep a weak link to the original meta-continuation
to enable detection of capturing a continuation that matches or
extends one that was previously captured.

Enabling sharing exposed a problem with the code that saves
continuation marks for partial sharing, since that implementation
became out of sync with the main implementation (so merge the
implementations).
This commit is contained in:
Matthew Flatt 2014-10-22 09:43:43 -06:00
parent 9c30da7682
commit 1f764a3dba
6 changed files with 100 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
pkgs/racket-pkgs/racket-test/tests/racket/prompt.rktl
View File

@ -420,6 +420,32 @@
(lambda () (set! v (add1 v)))))))
(test 1 values v))
;;----------------------------------------
;; Check continuation sharing
(let ()
(define (f x prev)
(call/cc
(lambda (k)
(test (and (even? x)
(x . < . 10))
eq?
k
prev)
(cond
[(zero? x) 'done]
[(even? x) (or (f (sub1 x) k) #t)]
[else (f (sub1 x) k)]))))
(void (f 10 #f))
(void
(let ([v (call-with-composable-continuation
(lambda (k)
k))])
(if (procedure? v)
(v 'ok)
(f 10 #f)))))
;;----------------------------------------
(report-errs)

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

@ -5138,9 +5138,9 @@ call_cc (int argc, Scheme_Object *argv[])
static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int composable,
Scheme_Object *prompt_tag, Scheme_Object *pt,
Scheme_Cont *sub_cont, Scheme_Prompt *prompt,
Scheme_Meta_Continuation *prompt_cont,
Scheme_Prompt *effective_barrier_prompt
)
Scheme_Meta_Continuation *prompt_cont,
Scheme_Prompt *effective_barrier_prompt,
int cm_only)
{
Scheme_Cont *cont;
Scheme_Cont_Jmp *buf_ptr;
@ -5148,7 +5148,7 @@ static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int comp
cont = MALLOC_ONE_TAGGED(Scheme_Cont);
cont->so.type = scheme_cont_type;
if (!for_prompt && !composable) {
if (!for_prompt && !composable && !cm_only) {
/* Set cont_key mark before capturing marks: */
scheme_set_cont_mark(cont_key, (Scheme_Object *)cont);
}
@ -5160,21 +5160,23 @@ static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int comp
SET_REQUIRED_TAG(buf_ptr->type = scheme_rt_cont_jmp);
cont->buf_ptr = buf_ptr;
scheme_init_jmpup_buf(&cont->buf_ptr->buf);
cont->prompt_tag = prompt_tag;
if (for_prompt)
cont->dw = NULL;
else if (prompt) {
Scheme_Dynamic_Wind *dw;
if (p->dw) {
dw = clone_dyn_wind(p->dw, pt, -1, -1, NULL, 0, composable);
cont->dw = dw;
cont->next_meta = p->next_meta;
} else
if (!cm_only) {
scheme_init_jmpup_buf(&cont->buf_ptr->buf);
cont->prompt_tag = prompt_tag;
if (for_prompt)
cont->dw = NULL;
} else {
cont->dw = p->dw;
cont->next_meta = p->next_meta;
else if (prompt) {
Scheme_Dynamic_Wind *dw;
if (p->dw) {
dw = clone_dyn_wind(p->dw, pt, -1, -1, NULL, 0, composable);
cont->dw = dw;
cont->next_meta = p->next_meta;
} else
cont->dw = NULL;
} else {
cont->dw = p->dw;
cont->next_meta = p->next_meta;
}
}
if (!for_prompt)
ASSERT_SUSPEND_BREAK_ZERO();
@ -5187,7 +5189,7 @@ static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int comp
cont->meta_tail_pos = (prompt ? prompt->boundary_mark_pos + 2 : 0);
cont->init_config = p->init_config;
cont->init_break_cell = p->init_break_cell;
if (for_prompt) {
if (for_prompt || cm_only) {
cont->meta_continuation = NULL;
} else if (prompt) {
Scheme_Meta_Continuation *mc;
@ -5207,6 +5209,15 @@ static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int comp
} else
cont->meta_continuation = p->meta_continuation;
if (!cm_only) {
/* A weak link is good enough for detecting continuation sharing, because
if the meta continuation goes away, then we're certainly not capturing
the same continuation as before. */
Scheme_Object *meta_continuation_src;
meta_continuation_src = scheme_make_weak_box((Scheme_Object *)p->meta_continuation);
cont->meta_continuation_src = meta_continuation_src;
}
if (effective_barrier_prompt) {
cont->barrier_prompt = effective_barrier_prompt;
scheme_prompt_capture_count++;
@ -5215,7 +5226,7 @@ static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int comp
if (p->meta_prompt && prompt_cont) /* prompt_cont => meta-prompt is shallower than prompt */
prompt = p->meta_prompt;
{
if (!cm_only) {
Scheme_Overflow *overflow;
/* Mark overflows as captured: */
for (overflow = p->overflow; overflow; overflow = overflow->prev) {
@ -5226,10 +5237,10 @@ static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int comp
overflow = clone_overflows(p->overflow, prompt->boundary_overflow_id, NULL);
cont->save_overflow = overflow;
}
scheme_cont_capture_count++;
}
scheme_cont_capture_count++;
if (!effective_barrier_prompt || !effective_barrier_prompt->is_barrier) {
if ((!effective_barrier_prompt || !effective_barrier_prompt->is_barrier) && !cm_only) {
/* This continuation can be used by other threads,
so we need to track ownership of the runstack */
if (!p->runstack_owner) {
@ -5256,7 +5267,7 @@ static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int comp
}
#endif
{
if (!cm_only) {
Scheme_Saved_Stack *saved;
saved = copy_out_runstack(p, MZ_RUNSTACK, MZ_RUNSTACK_START, sub_cont,
(for_prompt ? p->meta_prompt : prompt));
@ -5307,15 +5318,17 @@ static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int comp
: 1);
}
cont->runstack_owner = p->runstack_owner;
cont->cont_mark_stack_owner = p->cont_mark_stack_owner;
if (!cm_only) {
cont->runstack_owner = p->runstack_owner;
cont->cont_mark_stack_owner = p->cont_mark_stack_owner;
cont->stack_start = p->stack_start;
cont->stack_start = p->stack_start;
cont->savebuf = p->error_buf;
cont->savebuf = p->error_buf;
if (prompt)
cont->prompt_buf = prompt->prompt_buf;
if (prompt)
cont->prompt_buf = prompt->prompt_buf;
}
return cont;
}
@ -5745,7 +5758,8 @@ internal_call_cc (int argc, Scheme_Object *argv[])
if (sub_cont && ((sub_cont->save_overflow != p->overflow)
|| (sub_cont->prompt_tag != prompt_tag)
|| (sub_cont->barrier_prompt != effective_barrier_prompt)
|| (sub_cont->meta_continuation != p->meta_continuation))) {
|| ((Scheme_Meta_Continuation *)SCHEME_WEAK_BOX_VAL(sub_cont->meta_continuation_src)
!= p->meta_continuation))) {
sub_cont = NULL;
}
if (sub_cont && (sub_cont->ss.cont_mark_pos == MZ_CONT_MARK_POS)) {
@ -5777,35 +5791,18 @@ internal_call_cc (int argc, Scheme_Object *argv[])
/* Just use this one. */
cont = sub_cont;
} else {
/* Only continuation marks can be different. Mostly just re-use sub_cont. */
intptr_t offset;
Scheme_Cont_Mark *msaved;
Scheme_Cont_Jmp *buf_ptr;
cont = MALLOC_ONE_TAGGED(Scheme_Cont);
cont->so.type = scheme_cont_type;
buf_ptr = MALLOC_ONE_RT(Scheme_Cont_Jmp);
SET_REQUIRED_TAG(buf_ptr->type = scheme_rt_cont_jmp);
cont->buf_ptr = buf_ptr;
cont->buf_ptr->buf.cont = sub_cont;
cont->escape_cont = sub_cont->escape_cont;
sub_cont = sub_cont->buf_ptr->buf.cont;
/* This mark stack won't be restored, but it may be
/* Only continuation marks can be different. Mostly just re-use sub_cont.
The mark stack won't be restored, but it may be
used by `continuation-marks'. */
cont->ss.cont_mark_stack = MZ_CONT_MARK_STACK;
msaved = copy_out_mark_stack(p, cont->ss.cont_mark_stack, sub_cont, &offset, NULL, 0);
cont->cont_mark_stack_copied = msaved;
cont->cont_mark_offset = offset;
cont->cont_mark_total = cont->ss.cont_mark_stack;
offset = find_shareable_marks();
cont->cont_mark_nonshare = cont->ss.cont_mark_stack - offset;
cont = grab_continuation(p, 0, 0, prompt_tag, pt, sub_cont,
prompt, prompt_cont, effective_barrier_prompt, 1);
#ifdef MZ_USE_JIT
cont->native_trace = ret;
#endif
cont->buf_ptr->buf.cont = sub_cont;
cont->escape_cont = sub_cont->escape_cont;
}
argv2[0] = (Scheme_Object *)cont;
@ -5813,7 +5810,7 @@ internal_call_cc (int argc, Scheme_Object *argv[])
}
cont = grab_continuation(p, 0, composable, prompt_tag, pt, sub_cont,
prompt, prompt_cont, effective_barrier_prompt);
prompt, prompt_cont, effective_barrier_prompt, 0);
scheme_zero_unneeded_rands(p);
@ -6365,7 +6362,7 @@ static Scheme_Object *compose_continuation(Scheme_Cont *cont, int exec_chain,
/* Grab a continuation so that we capture the current Scheme stack,
etc.: */
saved = grab_continuation(p, 1, 0, NULL, NULL, NULL, NULL, NULL, NULL);
saved = grab_continuation(p, 1, 0, NULL, NULL, NULL, NULL, NULL, NULL, 0);
if (p->meta_prompt)
saved->prompt_stack_start = p->meta_prompt->stack_boundary;

2
racket/src/racket/src/mzmark_type.inc
View File

@ -938,6 +938,7 @@ static int cont_proc_MARK(void *p, struct NewGC *gc) {
gcMARK2(c->dw, gc);
gcMARK2(c->prompt_tag, gc);
gcMARK2(c->meta_continuation, gc);
gcMARK2(c->meta_continuation_src, gc);
gcMARK2(c->common_dw, gc);
gcMARK2(c->save_overflow, gc);
gcMARK2(c->runstack_copied, gc);
@ -980,6 +981,7 @@ static int cont_proc_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(c->dw, gc);
gcFIXUP2(c->prompt_tag, gc);
gcFIXUP2(c->meta_continuation, gc);
gcFIXUP2(c->meta_continuation_src, gc);
gcFIXUP2(c->common_dw, gc);
gcFIXUP2(c->save_overflow, gc);
gcFIXUP2(c->runstack_copied, gc);

1
racket/src/racket/src/mzmarksrc.c
View File

@ -363,6 +363,7 @@ cont_proc {
gcMARK2(c->dw, gc);
gcMARK2(c->prompt_tag, gc);
gcMARK2(c->meta_continuation, gc);
gcMARK2(c->meta_continuation_src, gc);
gcMARK2(c->common_dw, gc);
gcMARK2(c->save_overflow, gc);
gcMARK2(c->runstack_copied, gc);

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

@ -1651,6 +1651,7 @@ typedef struct Scheme_Cont {
Scheme_Object so;
char composable, has_prompt_dw, need_meta_prompt, skip_dws;
struct Scheme_Meta_Continuation *meta_continuation;
Scheme_Object *meta_continuation_src; /* a weak reference to the mc cloned, for use in detecting sharing */
Scheme_Cont_Jmp *buf_ptr; /* indirection allows sharing */
Scheme_Dynamic_Wind *dw;
int next_meta;

20
racket/src/racket/src/setjmpup.c
View File

@ -410,10 +410,22 @@ static intptr_t find_same(char *p, char *low, intptr_t max_size)
cnt++;
}
#else
while (max_size--) {
if (p[max_size] != low[max_size])
break;
cnt++;
if (!((intptr_t)p & (sizeof(intptr_t)-1))
&& !((intptr_t)low & (sizeof(intptr_t)-1))) {
/* common case of aligned addresses: compare `intptr_t`s at a time */
max_size /= sizeof(intptr_t);
while (max_size--) {
if (((intptr_t *)p)[max_size] != ((intptr_t *)low)[max_size])
break;
cnt += sizeof(intptr_t);
}
} else {
/* general case: compare bytes */
while (max_size--) {
if (p[max_size] != low[max_size])
break;
cnt++;
}
}
#endif