From 4673b36dcf28d6314db3c3b33fa9415113d880c0 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 6 Mar 2010 03:44:07 +0000 Subject: [PATCH] adjust inlining heuristics again svn: r18479 --- .../scheme/contract/private/ds-helpers.ss | 2 +- .../tests/mzscheme/benchmarks/common/auto.ss | 5 +- src/mzscheme/src/env.c | 2 + src/mzscheme/src/eval.c | 23 ++- src/mzscheme/src/fun.c | 9 +- src/mzscheme/src/module.c | 26 +++- src/mzscheme/src/schpriv.h | 4 +- src/mzscheme/src/syntax.c | 133 ++++++++++++------ 8 files changed, 144 insertions(+), 60 deletions(-) diff --git a/collects/scheme/contract/private/ds-helpers.ss b/collects/scheme/contract/private/ds-helpers.ss index 988e31d97b..2c45e7af9e 100644 --- a/collects/scheme/contract/private/ds-helpers.ss +++ b/collects/scheme/contract/private/ds-helpers.ss @@ -54,7 +54,7 @@ which are then called when the contract's fields are explored ;; call to procedure-closure-contents-eq? work ;; properly (λ (e) - (let loop ([n 20]) + (let loop ([n 30]) (if (zero? n) e #`(if (zero? (random 1)) diff --git a/collects/tests/mzscheme/benchmarks/common/auto.ss b/collects/tests/mzscheme/benchmarks/common/auto.ss index a528bd52a0..783d5104b4 100755 --- a/collects/tests/mzscheme/benchmarks/common/auto.ss +++ b/collects/tests/mzscheme/benchmarks/common/auto.ss @@ -37,6 +37,8 @@ exec mzscheme -qu "$0" ${1+"$@"} (define (clean-up-o1 bm) (delete-file (format "~a.o1" bm))) + (define (mk-mzscheme bm) (void)) + #; (define (mk-mzscheme bm) (unless (directory-exists? "compiled") (make-directory "compiled")) @@ -47,7 +49,8 @@ exec mzscheme -qu "$0" ${1+"$@"} (build-path "compiled" (path-add-suffix name #".zo")))))) (define (clean-up-zo bm) - (delete-directory/files "compiled")) + (when (directory-exists? "compiled") + (delete-directory/files "compiled"))) (define (clean-up-nothing bm) (void)) diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index 23b6fdb13b..7a42cea8d0 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -3732,6 +3732,8 @@ void scheme_optimize_info_done(Optimize_Info *info) info->next->size += info->size; info->next->psize += info->psize; info->next->vclock = info->vclock; + if (info->has_nonleaf) + info->next->has_nonleaf = 1; } /*========================================================================*/ diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index bf677e72a1..97f0b943a7 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -2570,6 +2570,8 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a /* Check for inlining: */ if (SCHEME_LOCAL_POS(le) >= nested_count) le = scheme_optimize_info_lookup(info, SCHEME_LOCAL_POS(le) - nested_count, &offset, &single_use, 0, 0, &psize); + else + info->has_nonleaf = 1; } if (le) { @@ -2603,9 +2605,13 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a || ((SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST) && (argc + 1 >= data->num_params)) || (!app && !app2 && !app3)) { - int threshold; + int threshold, is_leaf; - sz = scheme_closure_body_size(data, 1, info); + sz = scheme_closure_body_size(data, 1, info, &is_leaf); + if (is_leaf) { + /* encourage inlining of leaves: */ + sz >>= 2; + } threshold = info->inline_fuel * (2 + argc); if ((sz >= 0) && (single_use || (sz <= threshold))) { @@ -2616,16 +2622,19 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a sub_info = info; le = scheme_optimize_clone(0, data->code, sub_info, offset, data->num_params); if (le) { - LOG_INLINE(fprintf(stderr, "Inline %d %d %s\n", sz, single_use, data->name ? scheme_write_to_string(data->name, NULL) : "???")); + LOG_INLINE(fprintf(stderr, "Inline %d[%d]<=%d@%d %d %s\n", sz, is_leaf, threshold, info->inline_fuel, + single_use, data->name ? scheme_write_to_string(data->name, NULL) : "???")); return apply_inlined(le, data, info, argc, app, app2, app3, context, nested_count, orig_le, prev, prev_offset); } else { LOG_INLINE(fprintf(stderr, "No inline %s\n", data->name ? scheme_write_to_string(data->name, NULL) : "???")); + info->has_nonleaf = 1; } } else { - LOG_INLINE(fprintf(stderr, "No fuel %s %d*%d/%d %d\n", data->name ? scheme_write_to_string(data->name, NULL) : "???", - sz, threshold, + LOG_INLINE(fprintf(stderr, "No fuel %s %d[%d]>%d@%d %d\n", data->name ? scheme_write_to_string(data->name, NULL) : "???", + sz, is_leaf, threshold, info->inline_fuel, info->use_psize)); + info->has_nonleaf = 1; } } else { /* Issue warning below */ @@ -2654,6 +2663,9 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a info->psize += psize; } + if (!le) + info->has_nonleaf = 1; + if (bad_app) { int len; const char *pname, *context; @@ -4025,6 +4037,7 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in val = scheme_optimize_info_lookup(info, pos, NULL, NULL, (context & OPT_CONTEXT_NO_SINGLE) ? 0 : 1, context, NULL); + if (val) { if (SAME_TYPE(SCHEME_TYPE(val), scheme_once_used_type)) { Scheme_Once_Used *o = (Scheme_Once_Used *)val; diff --git a/src/mzscheme/src/fun.c b/src/mzscheme/src/fun.c index f9f6646870..f8c2b5ae4e 100644 --- a/src/mzscheme/src/fun.c +++ b/src/mzscheme/src/fun.c @@ -976,7 +976,7 @@ typedef struct { mzshort base_closure_size; /* doesn't include top-level (if any) */ mzshort *base_closure_map; char *flonum_map; /* NULL when has_flomap set => no flonums */ - char has_tl, has_flomap; + char has_tl, has_flomap, has_nonleaf; int body_size, body_psize; } Closure_Info; @@ -1048,6 +1048,7 @@ scheme_optimize_closure_compilation(Scheme_Object *_data, Optimize_Info *info, i cl->has_tl = 0; cl->body_size = info->size; cl->body_psize = info->psize; + cl->has_nonleaf = info->has_nonleaf; info->size++; @@ -1240,7 +1241,8 @@ Scheme_Object *scheme_sfs_closure(Scheme_Object *expr, SFS_Info *info, int self_ return expr; } -int scheme_closure_body_size(Scheme_Closure_Data *data, int check_assign, Optimize_Info *info) +int scheme_closure_body_size(Scheme_Closure_Data *data, int check_assign, + Optimize_Info *info, int *is_leaf) { int i; Closure_Info *cl; @@ -1255,6 +1257,9 @@ int scheme_closure_body_size(Scheme_Closure_Data *data, int check_assign, Optimi } } + if (is_leaf) + *is_leaf = !cl->has_nonleaf; + return cl->body_size + ((info && info->use_psize) ? cl->body_psize : 0); } diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index f2c6d0fc7d..624e6a94df 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -5319,7 +5319,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) int start_simltaneous = 0, i_m, cnt; Scheme_Object *cl_first = NULL, *cl_last = NULL; Scheme_Hash_Table *consts = NULL, *ready_table = NULL, *re_consts = NULL; - int cont, next_pos_ready = -1, inline_fuel; + int cont, next_pos_ready = -1, inline_fuel, is_proc_def; old_context = info->context; info->context = (Scheme_Object *)m; @@ -5371,15 +5371,29 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) for (i_m = 0; i_m < cnt; i_m++) { /* Optimize this expression: */ - if (OPT_DISCOURAGE_EARLY_INLINE) { + e = SCHEME_VEC_ELS(m->body)[i_m]; + + is_proc_def = 0; + if (OPT_DISCOURAGE_EARLY_INLINE && info->enforce_const) { + if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_syntax_type) + && (SCHEME_PINT_VAL(e) == DEFINE_VALUES_EXPD)) { + Scheme_Object *e2; + e2 = (Scheme_Object *)SCHEME_IPTR_VAL(e); + e2 = SCHEME_CDR(e2); + if (SAME_TYPE(SCHEME_TYPE(e2), scheme_compiled_unclosed_procedure_type)) + is_proc_def = 1; + } + } + + if (is_proc_def && OPT_DISCOURAGE_EARLY_INLINE) { info->use_psize = 1; inline_fuel = info->inline_fuel; if (inline_fuel > 2) info->inline_fuel = 2; } else inline_fuel = 0; - e = scheme_optimize_expr(SCHEME_VEC_ELS(m->body)[i_m], info, 0); - if (OPT_DISCOURAGE_EARLY_INLINE) { + e = scheme_optimize_expr(e, info, 0); + if (is_proc_def && OPT_DISCOURAGE_EARLY_INLINE) { info->use_psize = 0; info->inline_fuel = inline_fuel; } @@ -5523,7 +5537,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) sub_e = (Scheme_Object *)SCHEME_IPTR_VAL(e); sub_e = SCHEME_CDR(sub_e); if (SAME_TYPE(SCHEME_TYPE(sub_e), scheme_compiled_unclosed_procedure_type)) - old_sz = scheme_closure_body_size((Scheme_Closure_Data *)sub_e, 0, NULL); + old_sz = scheme_closure_body_size((Scheme_Closure_Data *)sub_e, 0, NULL, NULL); else old_sz = 0; } else @@ -5557,7 +5571,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) if (e) { if (OPT_LIMIT_FUNCTION_RESIZE) { if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_unclosed_procedure_type)) - new_sz = scheme_closure_body_size((Scheme_Closure_Data *)e, 0, NULL); + new_sz = scheme_closure_body_size((Scheme_Closure_Data *)e, 0, NULL, NULL); else new_sz = 0; } else diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index a19e22eab0..0ae7812bee 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -2028,7 +2028,7 @@ typedef struct Optimize_Info /* Propagated up and down the chain: */ int size, vclock, psize; short inline_fuel; - char letrec_not_twice, enforce_const, use_psize; + char letrec_not_twice, enforce_const, use_psize, has_nonleaf; Scheme_Hash_Table *top_level_consts; /* Set by expression optimization: */ @@ -2379,7 +2379,7 @@ Scheme_Object *scheme_optimize_shift(Scheme_Object *obj, int delta, int after_de Scheme_Object *scheme_clone_closure_compilation(int dup_ok, Scheme_Object *obj, Optimize_Info *info, int delta, int closure_depth); Scheme_Object *scheme_shift_closure_compilation(Scheme_Object *obj, int delta, int after_depth); -int scheme_closure_body_size(Scheme_Closure_Data *closure_data, int check_assign, Optimize_Info *info); +int scheme_closure_body_size(Scheme_Closure_Data *closure_data, int check_assign, Optimize_Info *info, int *is_leaf); int scheme_closure_argument_flags(Scheme_Closure_Data *closure_data, int i); int scheme_closure_has_top_level(Scheme_Closure_Data *data); diff --git a/src/mzscheme/src/syntax.c b/src/mzscheme/src/syntax.c index 12943964b7..cff9039e47 100644 --- a/src/mzscheme/src/syntax.c +++ b/src/mzscheme/src/syntax.c @@ -2832,7 +2832,7 @@ int scheme_compiled_propagate_ok(Scheme_Object *value, Optimize_Info *info) if (SAME_TYPE(SCHEME_TYPE(value), scheme_compiled_unclosed_procedure_type)) { int sz; - sz = scheme_closure_body_size((Scheme_Closure_Data *)value, 1, info); + sz = scheme_closure_body_size((Scheme_Closure_Data *)value, 1, info, NULL); if ((sz >= 0) && (sz <= MAX_PROC_INLINE_SIZE)) return 1; } @@ -3004,7 +3004,7 @@ static int set_code_flags(Scheme_Compiled_Let_Value *retry_start, static int expr_size(Scheme_Object *o, Optimize_Info *info) { if (SAME_TYPE(SCHEME_TYPE(o), scheme_compiled_unclosed_procedure_type)) - return scheme_closure_body_size((Scheme_Closure_Data *)o, 0, NULL) + 1; + return scheme_closure_body_size((Scheme_Closure_Data *)o, 0, NULL, NULL) + 1; else return 1; } @@ -3035,7 +3035,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i Scheme_Compiled_Let_Value *clv, *pre_body, *retry_start, *prev_body; Scheme_Object *body, *value, *ready_pairs = NULL, *rp_last = NULL, *ready_pairs_start; Scheme_Once_Used *first_once_used = NULL, *last_once_used = NULL; - int i, j, pos, is_rec, not_simply_let_star = 0; + int i, j, pos, is_rec, not_simply_let_star = 0, undiscourage; int size_before_opt, did_set_value; int remove_last_one = 0, inline_fuel; @@ -3187,18 +3187,24 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i body_info->transitive_use_pos = pos + 1; } - if (OPT_DISCOURAGE_EARLY_INLINE) { - inline_fuel = info->inline_fuel; + if (is_rec && OPT_DISCOURAGE_EARLY_INLINE && !rhs_info->letrec_not_twice + && SAME_TYPE(scheme_compiled_unclosed_procedure_type, SCHEME_TYPE(pre_body->value))) { + inline_fuel = rhs_info->inline_fuel; if (inline_fuel > 2) - info->inline_fuel = 2; - } else + rhs_info->inline_fuel = 2; + rhs_info->letrec_not_twice++; + undiscourage = 1; + } else { inline_fuel = 0; + undiscourage = 0; + } value = scheme_optimize_expr(pre_body->value, rhs_info, 0); pre_body->value = value; - if (OPT_DISCOURAGE_EARLY_INLINE) { - info->inline_fuel = inline_fuel; + if (undiscourage) { + rhs_info->inline_fuel = inline_fuel; + --rhs_info->letrec_not_twice; } body_info->transitive_use_pos = 0; @@ -3264,34 +3270,65 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i if ((pre_body->count == 1) && !(pre_body->flags[0] & SCHEME_WAS_SET_BANGED)) { + int indirect = 0, indirect_binding = 0; + + while (indirect < 10) { + if (SAME_TYPE(SCHEME_TYPE(value), scheme_sequence_type)) { + Scheme_Sequence *seq = (Scheme_Sequence *)value; + value = seq->array[seq->count - 1]; + indirect++; + } else if (SAME_TYPE(SCHEME_TYPE(value), scheme_compiled_let_void_type)) { + Scheme_Let_Header *head2 = (Scheme_Let_Header *)value; + int i; + + if (head2->num_clauses < 10) { + value = head2->body; + for (i = head2->num_clauses; i--; ) { + value = ((Scheme_Compiled_Let_Value *)value)->body; + } + } + indirect++; + if (head2->count) + indirect_binding = 1; + } else + break; + } - if (SAME_TYPE(SCHEME_TYPE(value), scheme_local_type)) { - /* Don't optimize reference to a local binding - that's not available yet, or that's mutable. */ - int vpos; - vpos = SCHEME_LOCAL_POS(value); - if ((vpos < head->count) && (vpos >= pos)) - value = NULL; - else { - /* Convert value back to a pre-optimized local coordinates. - 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); + if (indirect_binding) { + /* only allow constants */ + if (SCHEME_TYPE(value) < _scheme_compiled_values_types_) + value = NULL; + } + + if (value && SAME_TYPE(SCHEME_TYPE(value), scheme_local_type)) { + /* Don't optimize reference to a local binding + that's not available yet, or that's mutable. */ + int vpos; + vpos = SCHEME_LOCAL_POS(value); + if ((vpos < head->count) && (vpos >= pos)) + value = NULL; + else { + /* Convert value back to a pre-optimized local coordinates. + 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; - } + } } if (value && (scheme_compiled_propagate_ok(value, body_info))) { int cnt; + if (is_rec) cnt = 2; else cnt = ((pre_body->flags[0] & SCHEME_USE_COUNT_MASK) >> SCHEME_USE_COUNT_SHIFT); + scheme_optimize_propagate(body_info, pos, value, cnt == 1); did_set_value = 1; } else if (value && !is_rec) { @@ -3299,14 +3336,16 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i if (scheme_expr_produces_flonum(value)) scheme_optimize_produces_flonum(body_info, pos); - - cnt = ((pre_body->flags[0] & SCHEME_USE_COUNT_MASK) >> SCHEME_USE_COUNT_SHIFT); - if (cnt == 1) { - /* used only once; we may be able to shift the expression to the use - site, instead of binding to a temporary */ - last_once_used = scheme_make_once_used(value, pos, body_info->vclock, last_once_used); - if (!first_once_used) first_once_used = last_once_used; - scheme_optimize_propagate(body_info, pos, (Scheme_Object *)last_once_used, 1); + + if (!indirect) { + cnt = ((pre_body->flags[0] & SCHEME_USE_COUNT_MASK) >> SCHEME_USE_COUNT_SHIFT); + if (cnt == 1) { + /* used only once; we may be able to shift the expression to the use + site, instead of binding to a temporary */ + last_once_used = scheme_make_once_used(value, pos, body_info->vclock, last_once_used); + if (!first_once_used) first_once_used = last_once_used; + scheme_optimize_propagate(body_info, pos, (Scheme_Object *)last_once_used, 1); + } } } } @@ -3365,34 +3404,38 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i self_value = SCHEME_CDR(cl_first); /* Drop old size, and remove old inline fuel: */ - sz = scheme_closure_body_size((Scheme_Closure_Data *)value, 0, NULL); + sz = scheme_closure_body_size((Scheme_Closure_Data *)value, 0, NULL, NULL); body_info->size -= (sz + 1); /* Setting letrec_not_twice prevents inlinining of letrec bindings in this RHS. There's a small chance that we miss some optimizations, but we avoid the possibility of N^2 behavior. */ - body_info->letrec_not_twice = 1; + if (!OPT_DISCOURAGE_EARLY_INLINE) + body_info->letrec_not_twice++; use_psize = body_info->use_psize; body_info->use_psize = info->use_psize; - + value = scheme_optimize_expr(self_value, body_info, 0); - body_info->letrec_not_twice = 0; + if (!OPT_DISCOURAGE_EARLY_INLINE) + --body_info->letrec_not_twice; body_info->use_psize = use_psize; clv->value = value; if (!(clv->flags[0] & SCHEME_WAS_SET_BANGED)) { - /* Register re-optimized as the value for the binding, but - maybe only if it didn't grow too much: */ - int new_sz; - if (OPT_LIMIT_FUNCTION_RESIZE) { - new_sz = scheme_closure_body_size((Scheme_Closure_Data *)value, 0, NULL); - } else - new_sz = 0; - if (new_sz < 4 * sz) - scheme_optimize_propagate(body_info, clv->position, value, 0); + if (scheme_compiled_propagate_ok(value, body_info)) { + /* Register re-optimized as the value for the binding, but + maybe only if it didn't grow too much: */ + int new_sz; + if (OPT_LIMIT_FUNCTION_RESIZE) { + new_sz = scheme_closure_body_size((Scheme_Closure_Data *)value, 0, NULL, NULL); + } else + new_sz = 0; + if (new_sz < 4 * sz) + scheme_optimize_propagate(body_info, clv->position, value, 0); + } } body_info->transitive_use_pos = 0; @@ -3737,13 +3780,17 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info) num_rec_procs = 0; } else { /* Sequence of single-value, non-assigned lets? */ + int some_used = 0; clv = (Scheme_Compiled_Let_Value *)head->body; for (i = head->num_clauses; i--; clv = (Scheme_Compiled_Let_Value *)clv->body) { if (clv->count != 1) break; if (clv->flags[0] & SCHEME_WAS_SET_BANGED) break; + if (clv->flags[0] & SCHEME_WAS_USED) + some_used = 1; } + if (i < 0) { /* Yes - build chain of Scheme_Let_Ones and we're done: */ int skip_count = 0, frame_size, lifts_frame_size = 0;