[racket-dev] [plt] Push #29418: master branch updated

From: Jay McCarthy (jay.mccarthy at gmail.com)
Date: Tue Nov 18 13:45:47 EST 2014

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

Posted on the dev mailing list.