[racket-dev] [plt] Push #29418: master branch updated
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, <mflatt at 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 <mflatt at 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
![[logo]](/logo.png){kind=logo}