From 1f764a3dbafbc15e3a23e734c371d7cf61f79101 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 22 Oct 2014 09:43:43 -0600 Subject: [PATCH] fix internal meta-continuation comparison for continuation sharing 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). --- .../racket-test/tests/racket/prompt.rktl | 26 ++++ racket/src/racket/src/fun.c | 111 +++++++++--------- racket/src/racket/src/mzmark_type.inc | 2 + racket/src/racket/src/mzmarksrc.c | 1 + racket/src/racket/src/schpriv.h | 1 + racket/src/racket/src/setjmpup.c | 20 +++- 6 files changed, 100 insertions(+), 61 deletions(-) diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/prompt.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/prompt.rktl index 29228c1a2e..b069f0035a 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/prompt.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/prompt.rktl @@ -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) diff --git a/racket/src/racket/src/fun.c b/racket/src/racket/src/fun.c index ca5cdebe05..330f0016f4 100644 --- a/racket/src/racket/src/fun.c +++ b/racket/src/racket/src/fun.c @@ -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; diff --git a/racket/src/racket/src/mzmark_type.inc b/racket/src/racket/src/mzmark_type.inc index 748cfc5410..1c2613f350 100644 --- a/racket/src/racket/src/mzmark_type.inc +++ b/racket/src/racket/src/mzmark_type.inc @@ -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); diff --git a/racket/src/racket/src/mzmarksrc.c b/racket/src/racket/src/mzmarksrc.c index 5fcf1e051a..f3303c340e 100644 --- a/racket/src/racket/src/mzmarksrc.c +++ b/racket/src/racket/src/mzmarksrc.c @@ -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); diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 9b9cd8cbc4..951ffdfc93 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -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; diff --git a/racket/src/racket/src/setjmpup.c b/racket/src/racket/src/setjmpup.c index e6e04221a9..7f59fe0089 100644 --- a/racket/src/racket/src/setjmpup.c +++ b/racket/src/racket/src/setjmpup.c @@ -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