From 61ea6150044ea16bb3724ac7ca0d2e73d5eeeb34 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 27 Mar 2008 16:07:42 +0000 Subject: [PATCH] optimizer inlining improvements, especially to ensure that single-use bindings are inlined svn: r9094 --- collects/scheme/private/for.ss | 4 +-- .../tests/mzscheme/benchmarks/common/wrap.ss | 2 +- collects/tests/mzscheme/optimize.ss | 19 ++++++++++++++ src/mzscheme/src/env.c | 19 +++++++++----- src/mzscheme/src/eval.c | 22 +++++++--------- src/mzscheme/src/module.c | 20 ++++++++++++-- src/mzscheme/src/schpriv.h | 4 +-- src/mzscheme/src/syntax.c | 26 ++++++++++++++++--- 8 files changed, 88 insertions(+), 28 deletions(-) diff --git a/collects/scheme/private/for.ss b/collects/scheme/private/for.ss index 4a8d8a501c..ce2ced7567 100644 --- a/collects/scheme/private/for.ss +++ b/collects/scheme/private/for.ss @@ -624,7 +624,7 @@ [(_ [orig-stx nested? #f binds] ([fold-var fold-init] ...) () . body) #`(for/foldX/derived [orig-stx nested? #t binds] ([fold-var fold-init] ...) () . body)] ;; Emit case: - [(_ [orig-stx nested? #t binds] ([fold-var fold-init] ...) rest . body) + [(_ [orig-stx nested? #t binds] ([fold-var fold-init] ...) rest expr1 . body) (with-syntax ([(([outer-binding ...] outer-check [loop-binding ...] @@ -641,7 +641,7 @@ (let-values (inner-binding ... ...) (if (and pre-guard ...) (let-values ([(fold-var ...) - (for/foldX/derived [orig-stx nested? #f ()] ([fold-var fold-var] ...) rest . body)]) + (for/foldX/derived [orig-stx nested? #f ()] ([fold-var fold-var] ...) rest expr1 . body)]) (if (and post-guard ...) (comp-loop fold-var ... loop-arg ... ...) (values* fold-var ...))) diff --git a/collects/tests/mzscheme/benchmarks/common/wrap.ss b/collects/tests/mzscheme/benchmarks/common/wrap.ss index c55b417049..71f0530c99 100644 --- a/collects/tests/mzscheme/benchmarks/common/wrap.ss +++ b/collects/tests/mzscheme/benchmarks/common/wrap.ss @@ -1,7 +1,7 @@ (module wrap mzscheme (provide (rename module-begin #%module-begin)) - (require mzlib/include) + (require (lib "include.ss")) (define-syntax (module-begin stx) (let ([name (syntax-property stx 'enclosing-module-name)]) #`(#%plain-module-begin diff --git a/collects/tests/mzscheme/optimize.ss b/collects/tests/mzscheme/optimize.ss index 6aef4c91a9..94a7b5e61a 100644 --- a/collects/tests/mzscheme/optimize.ss +++ b/collects/tests/mzscheme/optimize.ss @@ -627,6 +627,25 @@ '(module m mzscheme (printf "pre\n"))) +(test-comp '(module m mzscheme + (define (q x) + ;; Single-use bindings should be inlined always: + (let* ([a (lambda (x) (+ x 10))] + [b (lambda (x) (+ 1 (a x)))] + [c (lambda (x) (+ 1 (b x)))] + [d (lambda (x) (+ 1 (c x)))] + [e (lambda (x) (+ 1 (d x)))] + [f (lambda (x) (+ 1 (e x)))] + [g (lambda (x) (+ 1 (f x)))] + [h (lambda (x) (+ 1 (g x)))] + [i (lambda (x) (+ 1 (h x)))] + [j (lambda (x) (+ 1 (i x)))] + [k (lambda (x) (+ 1 (j x)))]) + (k x)))) + '(module m mzscheme + (define (q x) + (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ 1 (+ x 10)))))))))))))) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Check bytecode verification of lifted functions diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index d0a0c3aa78..0c602c3023 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -2969,14 +2969,15 @@ void scheme_optimize_info_used_top(Optimize_Info *info) } } -void scheme_optimize_propagate(Optimize_Info *info, int pos, Scheme_Object *value) +void scheme_optimize_propagate(Optimize_Info *info, int pos, Scheme_Object *value, int single_use) { Scheme_Object *p; - p = scheme_make_vector(3, NULL); + p = scheme_make_vector(4, NULL); SCHEME_VEC_ELS(p)[0] = info->consts; SCHEME_VEC_ELS(p)[1] = scheme_make_integer(pos); SCHEME_VEC_ELS(p)[2] = value; + SCHEME_VEC_ELS(p)[3] = (single_use ? scheme_true : scheme_false); info->consts = p; } @@ -3057,7 +3058,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) +static Scheme_Object *do_optimize_info_lookup(Optimize_Info *info, int pos, int j, int *closure_offset, int *single_use) { Scheme_Object *p, *n; int delta = 0; @@ -3077,6 +3078,8 @@ 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 (single_use) + *single_use = SCHEME_TRUEP(SCHEME_VEC_ELS(p)[3]); if (SAME_TYPE(SCHEME_TYPE(n), scheme_compiled_unclosed_procedure_type)) { if (!closure_offset) break; @@ -3099,7 +3102,11 @@ static Scheme_Object *do_optimize_info_lookup(Optimize_Info *info, int pos, int a value, because chaining would normally happen on the propagate-call side. Chaining there also means that we avoid stack overflow here. */ - n = do_optimize_info_lookup(info, pos, j, NULL); + if (single_use) { + if (!*single_use) + single_use = NULL; + } + n = do_optimize_info_lookup(info, pos, j, NULL, single_use); if (!n) { /* Return shifted reference to other local: */ @@ -3118,9 +3125,9 @@ static Scheme_Object *do_optimize_info_lookup(Optimize_Info *info, int pos, int return NULL; } -Scheme_Object *scheme_optimize_info_lookup(Optimize_Info *info, int pos, int *closure_offset) +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); + return do_optimize_info_lookup(info, pos, 0, closure_offset, single_use); } Optimize_Info *scheme_optimize_info_add_frame(Optimize_Info *info, int orig, int current, int flags) diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 28b5d24bdf..8b1e350e79 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -2258,16 +2258,17 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a int *_flags) /* If not app, app2, or app3, just return a known procedure, if any */ { - int offset = 0; + int offset = 0, single_use = 0; if (SAME_TYPE(SCHEME_TYPE(le), scheme_local_type)) { /* Check for inlining: */ - le = scheme_optimize_info_lookup(info, SCHEME_LOCAL_POS(le), &offset); + le = scheme_optimize_info_lookup(info, SCHEME_LOCAL_POS(le), &offset, &single_use); if (!le) return NULL; } while (SAME_TYPE(SCHEME_TYPE(le), scheme_compiled_toplevel_type)) { + single_use = 0; if (info->top_level_consts) { int pos; pos = SCHEME_TOPLEVEL_POS(le); @@ -2290,11 +2291,12 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a if (data->num_params == argc) { sz = scheme_closure_body_size(data, 1); - if ((sz >= 0) && (sz <= (info->inline_fuel * (argc + 2)))) { + + if ((sz >= 0) && (single_use || (sz <= (info->inline_fuel * (argc + 2))))) { le = scheme_optimize_clone(0, data->code, info, offset, argc); if (le) { LOG_INLINE(fprintf(stderr, "Inline %s\n", data->name ? scheme_write_to_string(data->name, NULL) : "???")); - return apply_inlined(le, data, info, argc, app, app2, app3); + return apply_inlined(le, data, info, argc, app, app2, app3); } else { LOG_INLINE(fprintf(stderr, "No inline %s\n", data->name ? scheme_write_to_string(data->name, NULL) : "???")); } @@ -2446,7 +2448,7 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf int offset; Scheme_Object *expr; expr = scheme_optimize_reverse(info, SCHEME_LOCAL_POS(app->rand), 0); - if (scheme_optimize_info_lookup(info, SCHEME_LOCAL_POS(expr), &offset)) { + if (scheme_optimize_info_lookup(info, SCHEME_LOCAL_POS(expr), &offset, NULL)) { info->preserves_marks = 1; info->single_result = 1; return scheme_true; @@ -2866,7 +2868,7 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info) pos = SCHEME_LOCAL_POS(expr); - val = scheme_optimize_info_lookup(info, pos, NULL); + val = scheme_optimize_info_lookup(info, pos, NULL, NULL); if (val) { if (SAME_TYPE(SCHEME_TYPE(val), scheme_compiled_toplevel_type)) return scheme_optimize_expr(val, info); @@ -4964,9 +4966,7 @@ Scheme_Object *scheme_check_immediate_macro(Scheme_Object *first, val = scheme_lookup_binding(name, env, SCHEME_NULL_FOR_UNBOUND + SCHEME_APP_POS + SCHEME_ENV_CONSTANTS_OK - + ((rec[drec].comp && rec[drec].dont_mark_local_use) - ? SCHEME_DONT_MARK_USE - : 0) + + SCHEME_DONT_MARK_USE + ((rec[drec].comp && rec[drec].resolve_module_ids) ? SCHEME_RESOLVE_MODIDS : 0), @@ -5264,9 +5264,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env, + (rec[drec].comp ? SCHEME_ELIM_CONST : 0) - + ((rec[drec].comp && rec[drec].dont_mark_local_use) - ? SCHEME_DONT_MARK_USE - : 0) + + SCHEME_DONT_MARK_USE + ((rec[drec].comp && rec[drec].resolve_module_ids) ? SCHEME_RESOLVE_MODIDS : 0), diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index 0604083b89..cdadc363a5 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -4338,7 +4338,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info) Scheme_Object *e, *vars; int start_simltaneous = 0, i_m, cnt; Scheme_Object *cl_first = NULL, *cl_last = NULL; - Scheme_Hash_Table *consts = NULL, *ready_table = NULL; + Scheme_Hash_Table *consts = NULL, *ready_table = NULL, *re_consts = NULL; int cont; cnt = SCHEME_VEC_SIZE(m->body); @@ -4392,6 +4392,10 @@ module_optimize(Scheme_Object *data, Optimize_Info *info) consts = scheme_make_hash_table(SCHEME_hash_ptr); pos = tl->position; scheme_hash_set(consts, scheme_make_integer(pos), e2); + if (!re_consts) + re_consts = scheme_make_hash_table(SCHEME_hash_ptr); + scheme_hash_set(re_consts, scheme_make_integer(i_m), + scheme_make_integer(pos)); } else { /* At least mark it as ready */ if (!ready_table) { @@ -4466,7 +4470,18 @@ module_optimize(Scheme_Object *data, Optimize_Info *info) shift-cloning, since there are no local variables in scope. */ e = scheme_optimize_expr(SCHEME_VEC_ELS(m->body)[start_simltaneous], info); SCHEME_VEC_ELS(m->body)[start_simltaneous] = e; - + + if (re_consts) { + /* Install optimized closures into constant table: */ + Scheme_Object *rpos; + rpos = scheme_hash_get(re_consts, scheme_make_integer(start_simltaneous)); + if (rpos) { + e = (Scheme_Object *)SCHEME_IPTR_VAL(e); + e = SCHEME_CDR(e); + scheme_hash_set(info->top_level_consts, rpos, e); + } + } + if (start_simltaneous == i_m) break; start_simltaneous++; @@ -4481,6 +4496,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info) cl_last = cl_first = NULL; consts = NULL; + re_consts = NULL; start_simltaneous = i_m + 1; } } diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 5696f1398e..9e022f8b5f 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -2082,8 +2082,8 @@ Scheme_Object *scheme_merge_expression_resolve_lifts(Scheme_Object *expr, Resolv Optimize_Info *scheme_optimize_info_create(void); -void scheme_optimize_propagate(Optimize_Info *info, int pos, Scheme_Object *value); -Scheme_Object *scheme_optimize_info_lookup(Optimize_Info *info, int pos, int *closure_offset); +void scheme_optimize_propagate(Optimize_Info *info, int pos, Scheme_Object *value, int single_use); +Scheme_Object *scheme_optimize_info_lookup(Optimize_Info *info, int pos, int *closure_offset, int *single_use); void scheme_optimize_info_used_top(Optimize_Info *info); void scheme_optimize_mutated(Optimize_Info *info, int pos); diff --git a/src/mzscheme/src/syntax.c b/src/mzscheme/src/syntax.c index d7aa7c87c0..baab3ccac7 100644 --- a/src/mzscheme/src/syntax.c +++ b/src/mzscheme/src/syntax.c @@ -1549,7 +1549,7 @@ set_optimize(Scheme_Object *data, Optimize_Info *info) pos = SCHEME_LOCAL_POS(var); /* Register that we use this variable: */ - scheme_optimize_info_lookup(info, pos, NULL); + scheme_optimize_info_lookup(info, pos, NULL, NULL); /* Offset: */ delta = scheme_optimize_info_get_shift(info, pos); @@ -2902,6 +2902,14 @@ static int set_code_flags(Scheme_Compiled_Let_Value *retry_start, return flags; } +static int expr_size(Scheme_Object *o) +{ + if (SAME_TYPE(SCHEME_TYPE(o), scheme_compiled_unclosed_procedure_type)) + return scheme_closure_body_size((Scheme_Closure_Data *)o, 0); + else + return 1; +} + Scheme_Object * scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline) { @@ -3072,7 +3080,12 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline) } if (value && (scheme_compiled_propagate_ok(value, body_info))) { - scheme_optimize_propagate(body_info, pos, value); + 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; } } @@ -3140,7 +3153,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline) clv->value = value; if (!(clv->flags[0] & SCHEME_WAS_SET_BANGED)) { - scheme_optimize_propagate(body_info, clv->position, value); + scheme_optimize_propagate(body_info, clv->position, value, 0); } body_info->transitive_use_pos = 0; @@ -3213,6 +3226,13 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline) pre_body->flags[j] -= SCHEME_WAS_USED; } } + if (pre_body->count == 1) { + /* Drop expr and deduct from size to aid further inlining. */ + int sz; + sz = expr_size(pre_body->value); + pre_body->value = scheme_false; + info->size -= (sz + 1); + } } else { for (j = pre_body->count; j--; ) { pre_body->flags[j] |= SCHEME_WAS_USED;