From cbb49859961f7827f6728872f57c2cc3be2686aa Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 11 Nov 2008 17:14:35 +0000 Subject: [PATCH] fix over-eager bytecode optimization of folding a reference to a letrec-bound identifier that is not yet ready svn: r12385 --- src/mzscheme/src/env.c | 24 +++++++++++++++++++++--- src/mzscheme/src/schpriv.h | 1 + src/mzscheme/src/syntax.c | 21 ++++++++++++++++++++- 3 files changed, 42 insertions(+), 4 deletions(-) diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index 4b1ec38163..0e52f7223f 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -3033,6 +3033,8 @@ void scheme_optimize_info_used_top(Optimize_Info *info) void scheme_optimize_propagate(Optimize_Info *info, int pos, Scheme_Object *value, int single_use) { + /* A raw-pair `value' is an indicator for whether a letrec-bound + variable is ready. */ Scheme_Object *p; p = scheme_make_vector(4, NULL); @@ -3120,7 +3122,7 @@ int scheme_optimize_any_uses(Optimize_Info *info, int start_pos, int end_pos) return 0; } -static Scheme_Object *do_optimize_info_lookup(Optimize_Info *info, int pos, int j, int *closure_offset, int *single_use) +static Scheme_Object *do_optimize_info_lookup(Optimize_Info *info, int pos, int j, int *closure_offset, int *single_use, int *not_ready) { Scheme_Object *p, *n; int delta = 0; @@ -3140,6 +3142,13 @@ static Scheme_Object *do_optimize_info_lookup(Optimize_Info *info, int pos, int n = SCHEME_VEC_ELS(p)[1]; if (SCHEME_INT_VAL(n) == pos) { n = SCHEME_VEC_ELS(p)[2]; + if (SCHEME_RPAIRP(n)) { + /* This was a letrec-bound identifier that may or may not be ready, + but which wasn't replaced with more information. */ + if (not_ready) + *not_ready = SCHEME_TRUEP(SCHEME_CAR(n)); + break; + } if (single_use) *single_use = SCHEME_TRUEP(SCHEME_VEC_ELS(p)[3]); if (SAME_TYPE(SCHEME_TYPE(n), scheme_compiled_unclosed_procedure_type)) { @@ -3168,7 +3177,7 @@ static Scheme_Object *do_optimize_info_lookup(Optimize_Info *info, int pos, int if (!*single_use) single_use = NULL; } - n = do_optimize_info_lookup(info, pos, j, NULL, single_use); + n = do_optimize_info_lookup(info, pos, j, NULL, single_use, NULL); if (!n) { /* Return shifted reference to other local: */ @@ -3189,7 +3198,16 @@ static Scheme_Object *do_optimize_info_lookup(Optimize_Info *info, int pos, int Scheme_Object *scheme_optimize_info_lookup(Optimize_Info *info, int pos, int *closure_offset, int *single_use) { - return do_optimize_info_lookup(info, pos, 0, closure_offset, single_use); + return do_optimize_info_lookup(info, pos, 0, closure_offset, single_use, NULL); +} + +int scheme_optimize_info_is_ready(Optimize_Info *info, int pos) +{ + int closure_offset, single_use, ready = 1; + + do_optimize_info_lookup(info, pos, 0, &closure_offset, &single_use, &ready); + + return ready; } Optimize_Info *scheme_optimize_info_add_frame(Optimize_Info *info, int orig, int current, int flags) diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 1dfe3cad91..34445980bb 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -2165,6 +2165,7 @@ void scheme_resolve_info_add_mapping(Resolve_Info *info, int oldp, int newp, int void scheme_resolve_info_adjust_mapping(Resolve_Info *info, int oldp, int newp, int flags, Scheme_Object *lifted); int scheme_resolve_info_flags(Resolve_Info *info, int pos, Scheme_Object **lifted); int scheme_resolve_info_lookup(Resolve_Info *resolve, int pos, int *flags, Scheme_Object **lifted, int convert_shift); +int scheme_optimize_info_is_ready(Optimize_Info *info, int pos); void scheme_resolve_info_set_toplevel_pos(Resolve_Info *info, int pos); void scheme_enable_expression_resolve_lifts(Resolve_Info *ri); diff --git a/src/mzscheme/src/syntax.c b/src/mzscheme/src/syntax.c index 077bb44df7..046f03cb99 100644 --- a/src/mzscheme/src/syntax.c +++ b/src/mzscheme/src/syntax.c @@ -2959,7 +2959,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline) Optimize_Info *body_info, *rhs_info; Scheme_Let_Header *head = (Scheme_Let_Header *)form; Scheme_Compiled_Let_Value *clv, *pre_body, *retry_start, *prev_body; - Scheme_Object *body, *value; + Scheme_Object *body, *value, *ready_pairs = NULL; int i, j, pos, is_rec, not_simply_let_star = 0; int size_before_opt, did_set_value; int remove_last_one = 0; @@ -3009,6 +3009,10 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline) for (j = pre_body->count; j--; ) { if (pre_body->flags[j] & SCHEME_WAS_SET_BANGED) { scheme_optimize_mutated(body_info, pos + j); + } else if (is_rec) { + /* Indicate that it's not yet ready, so it cannot be inlined: */ + ready_pairs = scheme_make_raw_pair(scheme_false, ready_pairs); + scheme_optimize_propagate(body_info, pos+j, ready_pairs, 0); } } pos += pre_body->count; @@ -3120,6 +3124,12 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline) This must be done with respect to body_info, not rhs_info, because we attach the value to body_info: */ value = scheme_optimize_reverse(body_info, vpos, 1); + + /* Double-check that the value is ready, because we might be + nested in the RHS of a `letrec': */ + if (value) + if (!scheme_optimize_info_is_ready(body_info, SCHEME_LOCAL_POS(value))) + value = NULL; } } @@ -3241,6 +3251,15 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline) body_info->size = rhs_info->size; } + /* All letrec-bound variables are now ready. We could improve the + optimizer by making variables available earlier, since letrec is + really letrec*, but watch out for the re-optimization loop + above. */ + while (ready_pairs) { + SCHEME_CAR(ready_pairs) = scheme_true; + ready_pairs = SCHEME_CDR(ready_pairs); + } + body = scheme_optimize_expr(body, body_info); if (head->num_clauses) pre_body->body = body;