This change broke racklog: http://drdr.racket-lang.org/29418/pkgs/racklog/tests/bible.rkt (and others)
Jay On Wed, Oct 22, 2014 at 4:32 PM, <mfl...@racket-lang.org> wrote: > mflatt has updated `master' from 9c30da7682 to 1f764a3dba. > http://git.racket-lang.org/plt/9c30da7682..1f764a3dba > > =====[ One Commit ]===================================================== > Directory summary: > 11.1% pkgs/racket-pkgs/racket-test/tests/racket/ > 88.8% racket/src/racket/src/ > > ~~~~~~~~~~ > > 1f764a3 Matthew Flatt <mfl...@racket-lang.org> 2014-10-22 09:43 > : > | 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). > : > M racket/src/racket/src/fun.c | 111 > +++++++++---------- > M racket/src/racket/src/mzmarksrc.c | 1 + > M racket/src/racket/src/mzmark_type.inc | 2 + > M racket/src/racket/src/schpriv.h | 1 + > M racket/src/racket/src/setjmpup.c | 20 +++- > M .../racket-test/tests/racket/prompt.rktl | 26 +++++ > > =====[ Overall Diff ]=================================================== > > pkgs/racket-pkgs/racket-test/tests/racket/prompt.rktl > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > --- OLD/pkgs/racket-pkgs/racket-test/tests/racket/prompt.rktl > +++ NEW/pkgs/racket-pkgs/racket-test/tests/racket/prompt.rktl > @@ -421,5 +421,31 @@ > (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) > > racket/src/racket/src/fun.c > ~~~~~~~~~~~~~~~~~~~~~~~~~~~ > --- OLD/racket/src/racket/src/fun.c > +++ NEW/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; > > racket/src/racket/src/mzmark_type.inc > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > --- OLD/racket/src/racket/src/mzmark_type.inc > +++ NEW/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); > > racket/src/racket/src/mzmarksrc.c > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > --- OLD/racket/src/racket/src/mzmarksrc.c > +++ NEW/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); > > racket/src/racket/src/schpriv.h > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > --- OLD/racket/src/racket/src/schpriv.h > +++ NEW/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; > > racket/src/racket/src/setjmpup.c > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > --- OLD/racket/src/racket/src/setjmpup.c > +++ NEW/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 > -- Jay McCarthy http://jeapostrophe.github.io "Wherefore, be not weary in well-doing, for ye are laying the foundation of a great work. And out of small things proceedeth that which is great." - D&C 64:33 _________________________ Racket Developers list: http://lists.racket-lang.org/dev
