suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

optimizer inlining improvements, especially to ensure that single-use bindings are inlined

Browse Source 
svn: r9094
This commit is contained in:
Matthew Flatt 2008-03-27 16:07:42 +00:00
parent 6597fbb7c7
commit 61ea615004
8 changed files with 88 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/scheme/private/for.ss
View File

@ -624,7 +624,7 @@
[(_ [orig-stx nested? #f binds] ([fold-var fold-init] ...) () . body) [(_ [orig-stx nested? #f binds] ([fold-var fold-init] ...) () . body)
#`(for/foldX/derived [orig-stx nested? #t binds] ([fold-var fold-init] ...) () . body)] #`(for/foldX/derived [orig-stx nested? #t binds] ([fold-var fold-init] ...) () . body)]
;; Emit case: ;; 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 ...] (with-syntax ([(([outer-binding ...]
outer-check outer-check
[loop-binding ...] [loop-binding ...]
@ -641,7 +641,7 @@
(let-values (inner-binding ... ...) (let-values (inner-binding ... ...)
(if (and pre-guard ...) (if (and pre-guard ...)
(let-values ([(fold-var ...) (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 ...) (if (and post-guard ...)
(comp-loop fold-var ... loop-arg ... ...) (comp-loop fold-var ... loop-arg ... ...)
(values* fold-var ...))) (values* fold-var ...)))

2
collects/tests/mzscheme/benchmarks/common/wrap.ss
View File

@ -1,7 +1,7 @@
(module wrap mzscheme (module wrap mzscheme
(provide (rename module-begin #%module-begin)) (provide (rename module-begin #%module-begin))
(require mzlib/include) (require (lib "include.ss"))
(define-syntax (module-begin stx) (define-syntax (module-begin stx)
(let ([name (syntax-property stx 'enclosing-module-name)]) (let ([name (syntax-property stx 'enclosing-module-name)])
#`(#%plain-module-begin #`(#%plain-module-begin

19
collects/tests/mzscheme/optimize.ss
View File

@ -627,6 +627,25 @@
'(module m mzscheme '(module m mzscheme
(printf "pre\n"))) (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 ;; Check bytecode verification of lifted functions

19
src/mzscheme/src/env.c
View File

@ -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; 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)[0] = info->consts;
SCHEME_VEC_ELS(p)[1] = scheme_make_integer(pos); SCHEME_VEC_ELS(p)[1] = scheme_make_integer(pos);
SCHEME_VEC_ELS(p)[2] = value; SCHEME_VEC_ELS(p)[2] = value;
SCHEME_VEC_ELS(p)[3] = (single_use ? scheme_true : scheme_false);
info->consts = p; info->consts = p;
} }
@ -3057,7 +3058,7 @@ int scheme_optimize_any_uses(Optimize_Info *info, int start_pos, int end_pos)
return 0; 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; Scheme_Object *p, *n;
int delta = 0; 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]; n = SCHEME_VEC_ELS(p)[1];
if (SCHEME_INT_VAL(n) == pos) { if (SCHEME_INT_VAL(n) == pos) {
n = SCHEME_VEC_ELS(p)[2]; 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 (SAME_TYPE(SCHEME_TYPE(n), scheme_compiled_unclosed_procedure_type)) {
if (!closure_offset) if (!closure_offset)
break; 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 a value, because chaining would normally happen on the
propagate-call side. Chaining there also means that we propagate-call side. Chaining there also means that we
avoid stack overflow here. */ 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) { if (!n) {
/* Return shifted reference to other local: */ /* 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; 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) Optimize_Info *scheme_optimize_info_add_frame(Optimize_Info *info, int orig, int current, int flags)

22
src/mzscheme/src/eval.c
View File

@ -2258,16 +2258,17 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
int *_flags) int *_flags)
/* If not app, app2, or app3, just return a known procedure, if any */ /* 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)) { if (SAME_TYPE(SCHEME_TYPE(le), scheme_local_type)) {
/* Check for inlining: */ /* 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) if (!le)
return NULL; return NULL;
} }
while (SAME_TYPE(SCHEME_TYPE(le), scheme_compiled_toplevel_type)) { while (SAME_TYPE(SCHEME_TYPE(le), scheme_compiled_toplevel_type)) {
single_use = 0;
if (info->top_level_consts) { if (info->top_level_consts) {
int pos; int pos;
pos = SCHEME_TOPLEVEL_POS(le); 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) { if (data->num_params == argc) {
sz = scheme_closure_body_size(data, 1); 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); le = scheme_optimize_clone(0, data->code, info, offset, argc);
if (le) { if (le) {
LOG_INLINE(fprintf(stderr, "Inline %s\n", data->name ? scheme_write_to_string(data->name, NULL) : "???")); 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 { } else {
LOG_INLINE(fprintf(stderr, "No inline %s\n", data->name ? scheme_write_to_string(data->name, NULL) : "???")); 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; int offset;
Scheme_Object *expr; Scheme_Object *expr;
expr = scheme_optimize_reverse(info, SCHEME_LOCAL_POS(app->rand), 0); 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->preserves_marks = 1;
info->single_result = 1; info->single_result = 1;
return scheme_true; return scheme_true;
@ -2866,7 +2868,7 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info)
pos = SCHEME_LOCAL_POS(expr); 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 (val) {
if (SAME_TYPE(SCHEME_TYPE(val), scheme_compiled_toplevel_type)) if (SAME_TYPE(SCHEME_TYPE(val), scheme_compiled_toplevel_type))
return scheme_optimize_expr(val, info); 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, val = scheme_lookup_binding(name, env,
SCHEME_NULL_FOR_UNBOUND SCHEME_NULL_FOR_UNBOUND
+ SCHEME_APP_POS + SCHEME_ENV_CONSTANTS_OK + SCHEME_APP_POS + SCHEME_ENV_CONSTANTS_OK
+ ((rec[drec].comp && rec[drec].dont_mark_local_use) + SCHEME_DONT_MARK_USE
? SCHEME_DONT_MARK_USE
: 0)
+ ((rec[drec].comp && rec[drec].resolve_module_ids) + ((rec[drec].comp && rec[drec].resolve_module_ids)
? SCHEME_RESOLVE_MODIDS ? SCHEME_RESOLVE_MODIDS
: 0), : 0),
@ -5264,9 +5264,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
+ (rec[drec].comp + (rec[drec].comp
? SCHEME_ELIM_CONST ? SCHEME_ELIM_CONST
: 0) : 0)
+ ((rec[drec].comp && rec[drec].dont_mark_local_use) + SCHEME_DONT_MARK_USE
? SCHEME_DONT_MARK_USE
: 0)
+ ((rec[drec].comp && rec[drec].resolve_module_ids) + ((rec[drec].comp && rec[drec].resolve_module_ids)
? SCHEME_RESOLVE_MODIDS ? SCHEME_RESOLVE_MODIDS
: 0), : 0),

18
src/mzscheme/src/module.c
View File

@ -4338,7 +4338,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info)
Scheme_Object *e, *vars; Scheme_Object *e, *vars;
int start_simltaneous = 0, i_m, cnt; int start_simltaneous = 0, i_m, cnt;
Scheme_Object *cl_first = NULL, *cl_last = NULL; 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; int cont;
cnt = SCHEME_VEC_SIZE(m->body); 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); consts = scheme_make_hash_table(SCHEME_hash_ptr);
pos = tl->position; pos = tl->position;
scheme_hash_set(consts, scheme_make_integer(pos), e2); 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 { } else {
/* At least mark it as ready */ /* At least mark it as ready */
if (!ready_table) { if (!ready_table) {
@ -4467,6 +4471,17 @@ module_optimize(Scheme_Object *data, Optimize_Info *info)
e = scheme_optimize_expr(SCHEME_VEC_ELS(m->body)[start_simltaneous], info); e = scheme_optimize_expr(SCHEME_VEC_ELS(m->body)[start_simltaneous], info);
SCHEME_VEC_ELS(m->body)[start_simltaneous] = e; 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) if (start_simltaneous == i_m)
break; break;
start_simltaneous++; start_simltaneous++;
@ -4481,6 +4496,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info)
cl_last = cl_first = NULL; cl_last = cl_first = NULL;
consts = NULL; consts = NULL;
re_consts = NULL;
start_simltaneous = i_m + 1; start_simltaneous = i_m + 1;
} }
} }

4
src/mzscheme/src/schpriv.h
View File

@ -2082,8 +2082,8 @@ Scheme_Object *scheme_merge_expression_resolve_lifts(Scheme_Object *expr, Resolv
Optimize_Info *scheme_optimize_info_create(void); Optimize_Info *scheme_optimize_info_create(void);
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 *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);
void scheme_optimize_info_used_top(Optimize_Info *info); void scheme_optimize_info_used_top(Optimize_Info *info);
void scheme_optimize_mutated(Optimize_Info *info, int pos); void scheme_optimize_mutated(Optimize_Info *info, int pos);

26
src/mzscheme/src/syntax.c
View File

@ -1549,7 +1549,7 @@ set_optimize(Scheme_Object *data, Optimize_Info *info)
pos = SCHEME_LOCAL_POS(var); pos = SCHEME_LOCAL_POS(var);
/* Register that we use this variable: */ /* Register that we use this variable: */
scheme_optimize_info_lookup(info, pos, NULL); scheme_optimize_info_lookup(info, pos, NULL, NULL);
/* Offset: */ /* Offset: */
delta = scheme_optimize_info_get_shift(info, pos); 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; 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_Object *
scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline) 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))) { 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; did_set_value = 1;
} }
} }
@ -3140,7 +3153,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline)
clv->value = value; clv->value = value;
if (!(clv->flags[0] & SCHEME_WAS_SET_BANGED)) { 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; 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; 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 { } else {
for (j = pre_body->count; j--; ) { for (j = pre_body->count; j--; ) {
pre_body->flags[j] |= SCHEME_WAS_USED; pre_body->flags[j] |= SCHEME_WAS_USED;