diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index bba7a2634a..71f314cc91 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -2543,9 +2543,12 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a *_flags = SCHEME_CLOSURE_DATA_FLAGS(data); if ((data->num_params == argc) || (!app && !app2 && !app3)) { - sz = scheme_closure_body_size(data, 1, info); + int threshold; - if ((sz >= 0) && (single_use || (sz <= (info->inline_fuel * (argc + 2))))) { + sz = scheme_closure_body_size(data, 1, info); + threshold = info->inline_fuel * (2 + argc); + + if ((sz >= 0) && (single_use || (sz <= threshold))) { le = scheme_optimize_clone(0, data->code, info, offset, argc); if (le) { LOG_INLINE(fprintf(stderr, "Inline %d %d %s\n", sz, single_use, data->name ? scheme_write_to_string(data->name, NULL) : "???")); @@ -2555,7 +2558,7 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a } } else { LOG_INLINE(fprintf(stderr, "No fuel %s %d*%d/%d %d\n", data->name ? scheme_write_to_string(data->name, NULL) : "???", - sz, info->inline_fuel * (argc + 2), + sz, threshold, info->inline_fuel, info->use_psize)); } } else { @@ -3819,9 +3822,12 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int b->tbranch = tb; b->fbranch = fb; - /* Seems to work better to not to increase the size - specifically for `if': */ - /* info->size += 1; */ + if (OPT_BRANCH_ADDS_NO_SIZE) { + /* Seems to work better to not to increase the size + specifically for `if' */ + } else { + info->size += 1; + } return o; } diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index def9089fcd..292cce7c68 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -5213,56 +5213,63 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) cnt = SCHEME_VEC_SIZE(m->body); - if (info->enforce_const) { - /* For each identifier bound to a procedure, register an initial - size estimate, which is used to discourage early loop unrolling - at the expense of later inlining. */ - for (i_m = 0; i_m < cnt; i_m++) { - e = SCHEME_VEC_ELS(m->body)[i_m]; - if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_syntax_type) - && (SCHEME_PINT_VAL(e) == DEFINE_VALUES_EXPD)) { - int n; + if (OPT_ESTIMATE_FUTURE_SIZES) { + if (info->enforce_const) { + /* For each identifier bound to a procedure, register an initial + size estimate, which is used to discourage early loop unrolling + at the expense of later inlining. */ + for (i_m = 0; i_m < cnt; i_m++) { + e = SCHEME_VEC_ELS(m->body)[i_m]; + if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_syntax_type) + && (SCHEME_PINT_VAL(e) == DEFINE_VALUES_EXPD)) { + int n; - e = (Scheme_Object *)SCHEME_IPTR_VAL(e); - vars = SCHEME_CAR(e); - e = SCHEME_CDR(e); + e = (Scheme_Object *)SCHEME_IPTR_VAL(e); + vars = SCHEME_CAR(e); + e = SCHEME_CDR(e); - n = scheme_list_length(vars); - if (n == 1) { - if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_unclosed_procedure_type)) { - Scheme_Toplevel *tl; + n = scheme_list_length(vars); + if (n == 1) { + if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_unclosed_procedure_type)) { + Scheme_Toplevel *tl; - tl = (Scheme_Toplevel *)SCHEME_CAR(vars); + tl = (Scheme_Toplevel *)SCHEME_CAR(vars); - if (!(SCHEME_TOPLEVEL_FLAGS(tl) & SCHEME_TOPLEVEL_MUTATED)) { - int pos; - if (!consts) - consts = scheme_make_hash_table(SCHEME_hash_ptr); - pos = tl->position; - scheme_hash_set(consts, - scheme_make_integer(pos), - scheme_estimate_closure_size(e)); + if (!(SCHEME_TOPLEVEL_FLAGS(tl) & SCHEME_TOPLEVEL_MUTATED)) { + int pos; + if (!consts) + consts = scheme_make_hash_table(SCHEME_hash_ptr); + pos = tl->position; + scheme_hash_set(consts, + scheme_make_integer(pos), + scheme_estimate_closure_size(e)); + } } } } } - } - if (consts) { - info->top_level_consts = consts; - consts = NULL; + if (consts) { + info->top_level_consts = consts; + consts = NULL; + } } } for (i_m = 0; i_m < cnt; i_m++) { /* Optimize this expression: */ - info->use_psize = 1; - inline_fuel = info->inline_fuel; - if (inline_fuel > 2) - info->inline_fuel = 2; + if (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); - info->use_psize = 0; - info->inline_fuel = inline_fuel; + if (OPT_DISCOURAGE_EARLY_INLINE) { + info->use_psize = 0; + info->inline_fuel = inline_fuel; + } SCHEME_VEC_ELS(m->body)[i_m] = e; if (info->enforce_const) { @@ -5396,14 +5403,17 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) e = SCHEME_VEC_ELS(m->body)[start_simltaneous]; - if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_syntax_type) - && (SCHEME_PINT_VAL(e) == DEFINE_VALUES_EXPD)) { - Scheme_Object *sub_e; - 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); - else + if (OPT_LIMIT_FUNCTION_RESIZE) { + if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_syntax_type) + && (SCHEME_PINT_VAL(e) == DEFINE_VALUES_EXPD)) { + Scheme_Object *sub_e; + 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); + else + old_sz = 0; + } else old_sz = 0; } else old_sz = 0; @@ -5412,8 +5422,8 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) SCHEME_VEC_ELS(m->body)[start_simltaneous] = e; if (re_consts) { - /* Install optimized closures into constant table --- unless they - grow too much: */ + /* Install optimized closures into constant table --- + unless, maybe, they grow too much: */ Scheme_Object *rpos; rpos = scheme_hash_get(re_consts, scheme_make_integer(start_simltaneous)); if (rpos) { @@ -5423,12 +5433,15 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) && scheme_is_statically_proc(e, info)) e = scheme_make_noninline_proc(e); - if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_unclosed_procedure_type)) - new_sz = scheme_closure_body_size((Scheme_Closure_Data *)e, 0, NULL); - else + 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); + else + new_sz = 0; + } else new_sz = 0; - if (!new_sz || !old_sz || (new_sz < 2 * old_sz)) + if (!new_sz || !old_sz || (new_sz < 4 * old_sz)) scheme_hash_set(info->top_level_consts, rpos, e); } } diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 30e6e51925..661b4f4709 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -2343,6 +2343,12 @@ Scheme_Object *scheme_optimize_info_lookup(Optimize_Info *info, int pos, int *cl int once_used_ok, int context, int *potential_size); void scheme_optimize_info_used_top(Optimize_Info *info); +/* Controls for inlining algorithm: */ +#define OPT_ESTIMATE_FUTURE_SIZES 1 +#define OPT_DISCOURAGE_EARLY_INLINE 1 +#define OPT_LIMIT_FUNCTION_RESIZE 0 +#define OPT_BRANCH_ADDS_NO_SIZE 1 + Scheme_Object *scheme_estimate_closure_size(Scheme_Object *e); Scheme_Object *scheme_no_potential_size(Scheme_Object *value); diff --git a/src/mzscheme/src/syntax.c b/src/mzscheme/src/syntax.c index 3d0d623b6b..e401745dd1 100644 --- a/src/mzscheme/src/syntax.c +++ b/src/mzscheme/src/syntax.c @@ -3131,26 +3131,28 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i body = pre_body->body; } - if (is_rec && !body_info->letrec_not_twice) { - /* For each identifier bound to a procedure, register an initial - size estimate, which is used to discourage early loop unrolling - at the expense of later inlining. */ - body = head->body; - pre_body = NULL; - pos = 0; - for (i = head->num_clauses; i--; ) { - pre_body = (Scheme_Compiled_Let_Value *)body; + if (OPT_ESTIMATE_FUTURE_SIZES) { + if (is_rec && !body_info->letrec_not_twice) { + /* For each identifier bound to a procedure, register an initial + size estimate, which is used to discourage early loop unrolling + at the expense of later inlining. */ + body = head->body; + pre_body = NULL; + pos = 0; + for (i = head->num_clauses; i--; ) { + pre_body = (Scheme_Compiled_Let_Value *)body; - if ((pre_body->count == 1) - && SAME_TYPE(scheme_compiled_unclosed_procedure_type, SCHEME_TYPE(pre_body->value)) - && !(pre_body->flags[0] & SCHEME_WAS_SET_BANGED)) { - scheme_optimize_propagate(body_info, pos, scheme_estimate_closure_size(pre_body->value), 0); + if ((pre_body->count == 1) + && SAME_TYPE(scheme_compiled_unclosed_procedure_type, SCHEME_TYPE(pre_body->value)) + && !(pre_body->flags[0] & SCHEME_WAS_SET_BANGED)) { + scheme_optimize_propagate(body_info, pos, scheme_estimate_closure_size(pre_body->value), 0); + } + + pos += pre_body->count; + body = pre_body->body; } - - pos += pre_body->count; - body = pre_body->body; + rhs_info->use_psize = 1; } - rhs_info->use_psize = 1; } prev_body = NULL; @@ -3180,15 +3182,20 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i body_info->transitive_use_pos = pos + 1; } - inline_fuel = info->inline_fuel; - if (inline_fuel > 2) - info->inline_fuel = 2; + if (OPT_DISCOURAGE_EARLY_INLINE) { + inline_fuel = info->inline_fuel; + if (inline_fuel > 2) + info->inline_fuel = 2; + } else + inline_fuel = 0; value = scheme_optimize_expr(pre_body->value, rhs_info, 0); pre_body->value = value; - info->inline_fuel = inline_fuel; - + if (OPT_DISCOURAGE_EARLY_INLINE) { + info->inline_fuel = inline_fuel; + } + body_info->transitive_use_pos = 0; if (is_rec && !not_simply_let_star) { @@ -3373,10 +3380,13 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i if (!(clv->flags[0] & SCHEME_WAS_SET_BANGED)) { /* Register re-optimized as the value for the binding, but - only if it didn't grow too much: */ + maybe only if it didn't grow too much: */ int new_sz; - new_sz = scheme_closure_body_size((Scheme_Closure_Data *)value, 0, NULL); - if (new_sz < 2 * 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); }