From c19848f990650ecd13231650719f9590b1954bec Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 15 Sep 2016 11:07:08 -0600 Subject: [PATCH] fix optimizer bug Fix a regression relative to v6.4 caused by a refactoring of the compiler between v6.4 and v6.5. The refactoring lost information about letrecs that are converted internally to let* when a mutable variable is involved, and it ends up allocating a closure before the box of a mutable variable that is referenced by the closure. Something like `with-continuation-mark` is needed around the closure's `lambda` to prevent other optimizations from hiding the bug. Closes #1462 --- .../tests/racket/optimize.rktl | 21 +++++++++++ racket/src/racket/src/optimize.c | 36 +++++++++++++++++++ racket/src/racket/src/resolve.c | 3 +- racket/src/racket/src/schpriv.h | 4 +++ 4 files changed, 63 insertions(+), 1 deletion(-) diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl index 2f0f45a524..22169fe51a 100644 --- a/pkgs/racket-test-core/tests/racket/optimize.rktl +++ b/pkgs/racket-test-core/tests/racket/optimize.rktl @@ -6240,6 +6240,27 @@ 777) exn:fail:contract?) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The `let` and `with-continuation-mark` wrappers for `b` +;; delay the optimizer's detection of the right-hand side as +;; a closure enough that the resolve pass gets a `letrec` +;; that is being reinterpreted as a `let*`. But make sure +;; that the location of `a` is allocated before the closure +;; for `b`. + +(test (void) + 'call + (let ([f (letrec ([a 0] + [b (let ([t 0]) + (with-continuation-mark + 'x + 'y + (lambda () (set! a 1))))]) + (list b b))]) + (set! f f) + ((car f)))) + + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (report-errs) diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index cb9c3ee514..aed58db676 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -133,6 +133,7 @@ static Scheme_Object *do_expr_implies_predicate(Scheme_Object *expr, Optimize_In Scheme_Hash_Tree *ignore_vars); static int produces_local_type(Scheme_Object *rator, int argc); static int optimize_any_uses(Optimize_Info *info, Scheme_IR_Let_Value *at_irlv, int n); +static void optimize_uses_of_mutable_imply_early_alloc(Scheme_IR_Let_Value *at_irlv, int n); static void propagate_used_variables(Optimize_Info *info); static int env_uses_toplevel(Optimize_Info *frame); static Scheme_IR_Local *clone_variable(Scheme_IR_Local *var); @@ -7628,6 +7629,7 @@ static Scheme_Object *optimize_lets(Scheme_Object *form, Optimize_Info *info, in /* We can simplify letrec to let* */ SCHEME_LET_FLAGS(head) -= SCHEME_LET_RECURSIVE; is_rec = 0; + optimize_uses_of_mutable_imply_early_alloc((Scheme_IR_Let_Value *)head->body, head->num_clauses); } /* Optimized away all clauses? */ @@ -9371,6 +9373,40 @@ static int optimize_any_uses(Optimize_Info *info, Scheme_IR_Let_Value *at_irlv, return 0; } +static void optimize_uses_of_mutable_imply_early_alloc(Scheme_IR_Let_Value *at_irlv, int n) +{ + int i, j; + Scheme_IR_Let_Value *irlv = at_irlv; + + /* We we're reinterpreting a `letrec` as `let*`, and when it realy + must be `let*` instead of `let`, and when a mutable variable is + involved, then we need to tell the `resolve` pass that the + mutable varaiable's value must be boxed immediately, instead of + delaying to the body of the `let*`. */ + + while (n--) { + for (i = irlv->count; i--; ) { + if (irlv->vars[i]->mutated) { + int used = 0; + if (irlv->vars[i]->optimize_used) + used = 1; + else { + for (j = at_irlv->count; j--; ) { + if (at_irlv->vars[j]->optimize.transitive_uses) { + if (scheme_hash_get(at_irlv->vars[j]->optimize.transitive_uses, + (Scheme_Object *)irlv->vars[i])) + used = 1; + } + } + } + if (used) + irlv->vars[i]->must_allocate_immediately = 1; + } + } + irlv = (Scheme_IR_Let_Value *)irlv->body; + } +} + static void register_use(Scheme_IR_Local *var, Optimize_Info *info) { MZ_ASSERT(SCHEME_VAR(var)->mode == SCHEME_VAR_MODE_OPTIMIZE); diff --git a/racket/src/racket/src/resolve.c b/racket/src/racket/src/resolve.c index 947a3b79b5..935e5d7da4 100644 --- a/racket/src/racket/src/resolve.c +++ b/racket/src/racket/src/resolve.c @@ -1501,7 +1501,8 @@ Scheme_Object *scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info) if (!recbox && irlv->vars[j]->mutated) { GC_CAN_IGNORE Scheme_Object *pos; pos = scheme_make_integer(lv->position + j); - if (SCHEME_LET_FLAGS(head) & SCHEME_LET_RECURSIVE) { + if ((SCHEME_LET_FLAGS(head) & SCHEME_LET_RECURSIVE) + || irlv->vars[j]->must_allocate_immediately) { /* For let* or a let*-like letrec, we need to insert the boxes after each evaluation. */ Scheme_Object *boxenv; diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 7fe1094ea5..235696fc0f 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -1538,6 +1538,10 @@ typedef struct Scheme_IR_Local unsigned int optimize_outside_binding : 1; /* Records an anlaysis during the resolve pass: */ unsigned int resolve_omittable : 1; + /* Records whether the variable is mutated and used before + the body of its binding, so that itmust be allocated at latest + after it's RHS expression is evaluated: */ + unsigned int must_allocate_immediately : 1; /* The type desired by use positions for unboxing purposes; set by the optimizer: */ unsigned int arg_type : SCHEME_MAX_LOCAL_TYPE_BITS;