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)
#`(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 ...)))

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

@ -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

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

@ -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

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;
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)

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)
/* 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),

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

@ -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;
}
}

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);
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);

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);
/* 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;