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

adjust inlining algorithm again; better JIT compilation of nested branches; better JIT handling of literal floating-point numbers

Browse Source 
svn: r17484
This commit is contained in:
Matthew Flatt 2010-01-05 15:13:03 +00:00
parent e1a98129dc
commit 3902824d88
7 changed files with 869 additions and 334 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/compiler/main.ss
View File

@ -55,6 +55,8 @@
(define default-plt-name "archive")
(define disable-inlining (make-parameter #f))
(define plt-output (make-parameter #f))
(define plt-name (make-parameter default-plt-name))
(define plt-files-replace (make-parameter #f))
@ -177,6 +179,12 @@
(,(format "Output -z to \"compiled\", -e to ~s"
(path->string (build-path "compiled" "native"
(system-library-subpath #f)))))]]
[help-labels
"----------------------- bytecode compilation flags --------------------------"]
[once-each
[("--disable-inline")
,(lambda (f) (disable-inlining #t))
("Disable procedure inlining during compilation")]]
[help-labels
"--------------------- executable configuration flags ------------------------"]
[once-each
@ -487,7 +495,9 @@
(let ([name (extract-base-filename/ss file 'mzc)])
(when (compiler:option:somewhat-verbose)
(printf "\"~a\":\n" file))
(mc file)
(parameterize ([compile-context-preservation-enabled
(disable-inlining)])
(mc file))
(let ([dest (append-zo-suffix
(let-values ([(base name dir?) (split-path file)])
(build-path (if (symbol? base) 'same base)

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

@ -781,13 +781,16 @@
15)
15)
(test-comp '(letrec ((even
(let ([unused 6])
(let ([even (lambda (x) (if (zero? x) #t (even (sub1 x))))])
(values even)))))
(even 10000))
'(letrec ((even (lambda (x) (if (zero? x) #t (even (sub1 x))))))
(even 10000)))
(parameterize ([compile-context-preservation-enabled
;; Avoid different amounts of unrolling
#t])
(test-comp '(letrec ((even
(let ([unused 6])
(let ([even (lambda (x) (if (zero? x) #t (even (sub1 x))))])
(values even)))))
(even 10000))
'(letrec ((even (lambda (x) (if (zero? x) #t (even (sub1 x))))))
(even 10000))))
(test-comp '(procedure? add1)
#t)

1114
src/mzscheme/src/jit.c
View File

File diff suppressed because it is too large Load Diff

1
src/mzscheme/src/lightning/i386/core.h
View File

@ -58,6 +58,7 @@ struct jit_local_state {
int tiny_jumps;
int framesize;
#endif
int r0_can_be_tmp;
int argssize;
};

8
src/mzscheme/src/lightning/i386/fp.h
View File

@ -319,12 +319,12 @@ union jit_double_imm {
#define jit_fp_btest(d, s1, s2, n, _and, cmp, res) \
(((s1) == 0 ? FCOMr((s2)) : (FLDr((s1)), FUCOMPr((s2) + 1))), \
PUSHQr(_EAX), \
(_jitl.r0_can_be_tmp ? 0 : PUSHQr(_EAX)), \
FNSTSWr(_EAX), \
SHRLir(n, _EAX), \
(void)((_and) ? ANDLir ((_and), _EAX) : 0), \
((cmp) ? CMPLir ((cmp), _AL) : 0), \
(void) POPQr(_EAX), \
(void) (_jitl.r0_can_be_tmp ? 0 : POPQr(_EAX)), \
res ((d), 0, 0, 0), _jit.x.pc)
#define jit_fp_test_fppop(d, n, _and, res) \
@ -338,12 +338,12 @@ union jit_double_imm {
#define jit_fp_btest_fppop(d, n, _and, cmp, res) \
(FUCOMPPr(1), \
PUSHQr(_EAX), \
(_jitl.r0_can_be_tmp ? 0 : PUSHQr(_EAX)), \
FNSTSWr(_EAX), \
SHRLir(n, _EAX), \
(void)((_and) ? ANDLir ((_and), _EAX) : 0), \
(void)((cmp) ? CMPLir ((cmp), _AL) : 0), \
POPQr(_EAX), \
(void) (_jitl.r0_can_be_tmp ? 0 : POPQr(_EAX)), \
res ((d), 0, 0, 0), _jit.x.pc)
#define jit_nothing_needed(x)

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

@ -5127,7 +5127,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;
int cont, next_pos_ready = -1, inline_fuel;
old_context = info->context;
info->context = (Scheme_Object *)m;
@ -5178,8 +5178,12 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
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;
e = scheme_optimize_expr(SCHEME_VEC_ELS(m->body)[i_m], info, 0);
info->use_psize = 0;
info->inline_fuel = inline_fuel;
SCHEME_VEC_ELS(m->body)[i_m] = e;
if (info->enforce_const) {
@ -5309,11 +5313,28 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
while (1) {
/* Re-optimize this expression. We can optimize anything without
shift-cloning, since there are no local variables in scope. */
e = scheme_optimize_expr(SCHEME_VEC_ELS(m->body)[start_simltaneous], info, 0);
int old_sz, new_sz;
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
old_sz = 0;
} else
old_sz = 0;
e = scheme_optimize_expr(e, info, 0);
SCHEME_VEC_ELS(m->body)[start_simltaneous] = e;
if (re_consts) {
/* Install optimized closures into constant table: */
/* Install optimized closures into constant table --- unless they
grow too much: */
Scheme_Object *rpos;
rpos = scheme_hash_get(re_consts, scheme_make_integer(start_simltaneous));
if (rpos) {
@ -5322,7 +5343,14 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
if (!scheme_compiled_propagate_ok(e, info)
&& scheme_is_statically_proc(e, info))
e = scheme_make_noninline_proc(e);
scheme_hash_set(info->top_level_consts, rpos, 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
new_sz = 0;
if (!new_sz || !old_sz || (new_sz < 2 * old_sz))
scheme_hash_set(info->top_level_consts, rpos, e);
}
}

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

@ -3035,7 +3035,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
Scheme_Once_Used *first_once_used = NULL, *last_once_used = NULL;
int i, j, pos, is_rec, not_simply_let_star = 0;
int size_before_opt, did_set_value;
int remove_last_one = 0;
int remove_last_one = 0, inline_fuel;
/* Special case: (let ([x E]) x) where E is lambda, case-lambda, or
a constant. (If we allowed arbitrary E here, it would affect the
@ -3141,8 +3141,14 @@ 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;
value = scheme_optimize_expr(pre_body->value, rhs_info, 0);
pre_body->value = value;
info->inline_fuel = inline_fuel;
body_info->transitive_use_pos = 0;
@ -3327,7 +3333,12 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
clv->value = value;
if (!(clv->flags[0] & SCHEME_WAS_SET_BANGED)) {
scheme_optimize_propagate(body_info, clv->position, value, 0);
/* Register re-optimized as the value for the binding, but
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)
scheme_optimize_propagate(body_info, clv->position, value, 0);
}
body_info->transitive_use_pos = 0;