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

first small step toward cross-module optimization

Browse Source 
Mainly propagates constantness for the benefit of keyword
applications, but also propagates simple constants
This commit is contained in:
Matthew Flatt 2011-08-08 19:53:11 -06:00
parent 5352d670c4
commit f646511ca7
14 changed files with 127 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/racket/bool.rkt
View File

@ -4,16 +4,8 @@
boolean=?
symbol=?)
(define-syntax-rule (define-constant id val)
(...
(define-syntax id
(syntax-id-rules (set!)
[(set! id rhs) (set! val rhs)]
[(id . args) (val . args)]
[_ val]))))
(define-constant true #t)
(define-constant false #f)
(define true #t)
(define false #f)
(define (false? v) (eq? v #f))

8
collects/tests/racket/optimize.rktl
View File

@ -1309,6 +1309,14 @@
(- (expt 2 31) 2))
#f)
;; simple cross-module inlining
(test-comp `(module m racket/base
(require racket/bool)
(list true))
`(module m racket/base
(require racket/bool)
(list #t)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check bytecode verification of lifted functions

34
src/racket/src/compenv.c
View File

@ -622,7 +622,13 @@ Scheme_Object *scheme_register_toplevel_in_prefix(Scheme_Object *var, Scheme_Com
if (o)
return o;
o = scheme_make_toplevel(0, cp->num_toplevels, 0, imported ? SCHEME_TOPLEVEL_READY : 0);
o = scheme_make_toplevel(0, cp->num_toplevels, 0,
(imported
? (SCHEME_TOPLEVEL_READY
| ((SCHEME_MODVAR_FLAGS(var) & 0x1)
? SCHEME_TOPLEVEL_CONST
: 0))
: 0));
cp->num_toplevels++;
scheme_hash_set(ht, var, o);
@ -877,7 +883,7 @@ static Scheme_Local *get_frame_loc(Scheme_Comp_Env *frame,
Scheme_Object *scheme_hash_module_variable(Scheme_Env *env, Scheme_Object *modidx,
Scheme_Object *stxsym, Scheme_Object *insp,
int pos, intptr_t mod_phase)
int pos, intptr_t mod_phase, int is_constant)
{
Scheme_Object *val;
Scheme_Hash_Table *ht;
@ -905,7 +911,7 @@ Scheme_Object *scheme_hash_module_variable(Scheme_Env *env, Scheme_Object *modid
Module_Variable *mv;
mv = MALLOC_ONE_TAGGED(Module_Variable);
mv->so.type = scheme_module_variable_type;
mv->iso.so.type = scheme_module_variable_type;
mv->modidx = modidx;
mv->sym = stxsym;
@ -913,6 +919,9 @@ Scheme_Object *scheme_hash_module_variable(Scheme_Env *env, Scheme_Object *modid
mv->pos = pos;
mv->mod_phase = (int)mod_phase;
if (is_constant)
SCHEME_MODVAR_FLAGS(mv) |= 0x1;
val = (Scheme_Object *)mv;
scheme_hash_set(ht, stxsym, val);
@ -1630,7 +1639,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
int j = 0, p = 0, modpos, skip_stops = 0, module_self_reference = 0;
Scheme_Bucket *b;
Scheme_Object *val, *modidx, *modname, *src_find_id, *find_global_id, *mod_defn_phase;
Scheme_Object *find_id_sym = NULL, *rename_insp = NULL;
Scheme_Object *find_id_sym = NULL, *rename_insp = NULL, *mod_constant = NULL;
Scheme_Env *genv;
intptr_t phase;
@ -1857,7 +1866,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
find_id, src_find_id, NULL, NULL, rename_insp,
-2, 0,
NULL, NULL,
env->genv, NULL);
env->genv, NULL, NULL);
} else {
/* Only try syntax table if there's not an explicit (later)
variable mapping: */
@ -1880,7 +1889,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
else
pos = scheme_check_accessible_in_module(genv, env->insp, in_modidx,
find_id, src_find_id, NULL, NULL, rename_insp, -1, 1,
_protected, NULL, env->genv, NULL);
_protected, NULL, env->genv, NULL, &mod_constant);
modpos = (int)SCHEME_INT_VAL(pos);
} else
modpos = -1;
@ -1915,7 +1924,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
check_taint(src_find_id);
return scheme_hash_module_variable(genv, genv->module->self_modidx, find_id,
genv->module->insp,
-1, genv->mod_phase);
-1, genv->mod_phase, 0);
}
} else
return NULL;
@ -1923,6 +1932,11 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
check_taint(src_find_id);
if ((flags & SCHEME_ELIM_CONST)
&& mod_constant
&& !SAME_OBJ(mod_constant, scheme_void_proc))
return mod_constant;
/* Used to have `&& !SAME_OBJ(modidx, modname)' below, but that was a bad
idea, because it causes module instances to be preserved. */
if (modname && !(flags & SCHEME_RESOLVE_MODIDS)
@ -1934,7 +1948,8 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
/* Create a module variable reference, so that idx is preserved: */
return scheme_hash_module_variable(env->genv, modidx, find_id,
(rename_insp ? rename_insp : genv->module->insp),
modpos, SCHEME_INT_VAL(mod_defn_phase));
modpos, SCHEME_INT_VAL(mod_defn_phase),
!!mod_constant);
}
if (!modname
@ -1944,7 +1959,8 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
/* Need to return a variable reference in this case, too. */
return scheme_hash_module_variable(env->genv, genv->module->self_modidx, find_global_id,
genv->module->insp,
modpos, genv->mod_phase);
modpos, genv->mod_phase,
!!mod_constant);
}
b = scheme_bucket_from_table(genv->toplevel, (char *)find_global_id);

6
src/racket/src/compile.c
View File

@ -755,7 +755,7 @@ defn_targets_syntax (Scheme_Object *var, Scheme_Comp_Env *env, Scheme_Compile_In
/* Create a module variable reference, so that idx is preserved: */
bucket = scheme_hash_module_variable(env->genv, env->genv->module->self_modidx,
name, env->genv->module->insp,
-1, env->genv->mod_phase);
-1, env->genv->mod_phase, 0);
}
/* Get indirection through the prefix: */
bucket = scheme_register_toplevel_in_prefix(bucket, env, rec, drec, 0);
@ -1396,7 +1396,7 @@ ref_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
imported = scheme_is_imported(var, env);
if (rec[drec].comp) {
var = scheme_register_toplevel_in_prefix(var, env, rec, drec, 0);
var = scheme_register_toplevel_in_prefix(var, env, rec, drec, imported);
if (!imported && env->genv->module && !rec[drec].testing_constantness)
SCHEME_TOPLEVEL_FLAGS(var) |= SCHEME_TOPLEVEL_MUTATED;
}
@ -5126,7 +5126,7 @@ top_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
preserved within the module. */
c = scheme_hash_module_variable(env->genv, env->genv->module->self_modidx,
c, env->genv->module->insp,
-1, env->genv->mod_phase);
-1, env->genv->mod_phase, 0);
} else {
c = (Scheme_Object *)scheme_global_bucket(c, env->genv);
}

2
src/racket/src/env.c
View File

@ -1697,7 +1697,7 @@ static Scheme_Object *variable_const_p(int argc, Scheme_Object *argv[])
if (!SAME_TYPE(SCHEME_TYPE(v), scheme_global_ref_type))
scheme_wrong_type("variable-reference-constant?", "variable-reference", 0, argc, argv);
if (SCHEME_PAIR_FLAGS(v) & 0x1)
if (SCHEME_VARREF_FLAGS(v) & 0x1)
return scheme_true;
v = SCHEME_PTR1_VAL(v);

7
src/racket/src/eval.c
View File

@ -726,7 +726,8 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx,
if (check_access && !SAME_OBJ(menv, env)) {
varname = scheme_check_accessible_in_module(menv, insp, NULL, varname, NULL, NULL,
insp, NULL, pos, 0, NULL, NULL, env, NULL);
insp, NULL, pos, 0, NULL, NULL, env, NULL,
NULL);
}
}
@ -1848,8 +1849,8 @@ ref_execute (Scheme_Object *data)
SCHEME_PTR1_VAL(o) = var;
SCHEME_PTR2_VAL(o) = (env ? (Scheme_Object *)env : scheme_false);
if (SCHEME_PAIR_FLAGS(data) & 0x1)
SCHEME_PAIR_FLAGS(o) |= 0x1;
if (SCHEME_VARREF_FLAGS(data) & 0x1)
SCHEME_VARREF_FLAGS(o) |= 0x1;
return o;
}

2
src/racket/src/jit.c
View File

@ -64,7 +64,7 @@ static Scheme_Object *make_global_const_ref(Scheme_Object *var, Scheme_Object *d
GC_CAN_IGNORE Scheme_Object *o;
o = make_global_ref(var, dummy);
SCHEME_PAIR_FLAGS(o) |= 0x1;
SCHEME_VARREF_FLAGS(o) |= 0x1;
return o;
}

2
src/racket/src/jitinline.c
View File

@ -431,7 +431,7 @@ static int generate_inlined_constant_varref_test(mz_jit_state *jitter, Scheme_Ob
GC_CAN_IGNORE jit_insn *ref1, *ref2;
int pos;
if (SCHEME_PAIR_FLAGS(obj) & 0x1) {
if (SCHEME_VARREF_FLAGS(obj) & 0x1) {
jit_movi_p(JIT_R0, scheme_true);
return 1;
}

7
src/racket/src/marshal.c
View File

@ -450,7 +450,7 @@ static Scheme_Object *write_set_bang(Scheme_Object *obj)
Scheme_Object *write_varref(Scheme_Object *o)
{
int is_const = (SCHEME_PAIR_FLAGS(o) & 0x1);
int is_const = (SCHEME_VARREF_FLAGS(o) & 0x1);
if (is_const) {
if (SCHEME_PTR1_VAL(o) != SCHEME_PTR2_VAL(o))
@ -470,9 +470,10 @@ Scheme_Object *read_varref(Scheme_Object *o)
data = scheme_alloc_object();
data->type = scheme_varref_form_type;
SCHEME_PTR2_VAL(data) = SCHEME_CDR(o);
if (SAME_OBJ(SCHEME_CAR(o), scheme_true))
if (SAME_OBJ(SCHEME_CAR(o), scheme_true)) {
SCHEME_VARREF_FLAGS(data) |= 0x1;
SCHEME_PTR1_VAL(data) = SCHEME_CDR(o);
else
} else
SCHEME_PTR1_VAL(data) = SCHEME_CAR(o);
return data;

51
src/racket/src/module.c
View File

@ -3473,9 +3473,43 @@ static void setup_accessible_table(Scheme_Module *m)
}
}
if (!j)
if (!j) {
/* find constants: */
int i, cnt = SCHEME_VEC_SIZE(m->body), k;
Scheme_Object *form, *tl;
for (i = 0; i < cnt; i++) {
form = SCHEME_VEC_ELS(m->body)[i];
if (SAME_TYPE(SCHEME_TYPE(form), scheme_define_values_type)) {
for (k = SCHEME_VEC_SIZE(form); k-- > 1; ) {
tl = SCHEME_VEC_ELS(form)[k];
if (SCHEME_TOPLEVEL_FLAGS(tl) & SCHEME_TOPLEVEL_CONST) {
int pos = SCHEME_TOPLEVEL_POS(tl);
if (pos < m->prefix->num_toplevels) {
tl = m->prefix->toplevels[pos];
if (SCHEME_SYMBOLP(tl)) {
Scheme_Object *v;
v = scheme_hash_get(ht, tl);
if (!v) scheme_signal_error("internal error: defined name inaccessible");
if ((SCHEME_VEC_SIZE(form) == 2)
&& scheme_compiled_duplicate_ok(SCHEME_VEC_ELS(form)[0], 1)) {
/* record simple constant from cross-module propagation: */
v = scheme_make_pair(v, SCHEME_VEC_ELS(form)[0]);
} else {
/* record simply that it's constant: */
v = scheme_box(v);
}
scheme_hash_set(ht, tl, v);
} else
scheme_signal_error("internal error: strange defn target %d", SCHEME_TYPE(tl));
}
}
}
}
}
m->accessible = ht;
else
} else
m->et_accessible = ht;
}
}
@ -3555,7 +3589,8 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
Scheme_Object *rename_insp,
int position, int want_pos,
int *_protected, int *_unexported,
Scheme_Env *from_env, int *_would_complain)
Scheme_Env *from_env, int *_would_complain,
Scheme_Object **_is_constant)
/* Returns the actual name when !want_pos, needed in case of
uninterned names. Otherwise, returns a position value on success.
If position < -1, then merely checks for protected syntax.
@ -3678,6 +3713,16 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
else
pos = NULL;
if (pos) {
if (SCHEME_BOXP(pos)) {
if (_is_constant) *_is_constant = scheme_void_proc; /* a hack to indicated "unknown constant" */
pos = SCHEME_BOX_VAL(pos);
} else if (SCHEME_PAIRP(pos)) {
if (_is_constant) *_is_constant = SCHEME_CDR(pos);
pos = SCHEME_CAR(pos);
}
}
if (pos) {
if (position < -1) {
if (SCHEME_INT_VAL(pos) < 0)

30
src/racket/src/optimize.c
View File

@ -2476,25 +2476,27 @@ static Scheme_Object *optimize_sequence(Scheme_Object *o, Optimize_Info *info, i
return (Scheme_Object *)s;
}
int scheme_compiled_duplicate_ok(Scheme_Object *fb)
int scheme_compiled_duplicate_ok(Scheme_Object *fb, int cross_module)
{
return (SCHEME_VOIDP(fb)
|| SAME_OBJ(fb, scheme_true)
|| SCHEME_FALSEP(fb)
|| SCHEME_SYMBOLP(fb)
|| (SCHEME_SYMBOLP(fb) && (!cross_module || !SCHEME_SYM_WEIRDP(fb)))
|| SCHEME_KEYWORDP(fb)
|| SCHEME_EOFP(fb)
|| SCHEME_INTP(fb)
|| SCHEME_NULLP(fb)
|| (SCHEME_CHARP(fb) && (SCHEME_CHAR_VAL(fb) < 256))
|| SAME_TYPE(SCHEME_TYPE(fb), scheme_local_type)
/* Values that are hashed by the printer to avoid
duplication: */
|| SCHEME_CHAR_STRINGP(fb)
|| SCHEME_BYTE_STRINGP(fb)
|| SAME_TYPE(SCHEME_TYPE(fb), scheme_regexp_type)
|| SCHEME_NUMBERP(fb)
|| SCHEME_PRIMP(fb));
|| (!cross_module
&&
/* Values that are hashed by the printer to avoid
duplication: */
(SCHEME_CHAR_STRINGP(fb)
|| SCHEME_BYTE_STRINGP(fb)
|| SAME_TYPE(SCHEME_TYPE(fb), scheme_regexp_type)
|| SCHEME_NUMBERP(fb)
|| SCHEME_PRIMP(fb))));
}
static int equivalent_exprs(Scheme_Object *a, Scheme_Object *b)
@ -2613,7 +2615,7 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
for simple constants K. This is useful to expose simple
tests to the JIT. */
if (SAME_TYPE(SCHEME_TYPE(t), scheme_branch_type)
&& scheme_compiled_duplicate_ok(fb)) {
&& scheme_compiled_duplicate_ok(fb, 0)) {
Scheme_Branch_Rec *b2 = (Scheme_Branch_Rec *)t;
if (SCHEME_FALSEP(b2->fbranch)) {
Scheme_Branch_Rec *b3;
@ -3130,7 +3132,7 @@ int scheme_is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator)
int scheme_compiled_propagate_ok(Scheme_Object *value, Optimize_Info *info)
{
if (scheme_compiled_duplicate_ok(value))
if (scheme_compiled_duplicate_ok(value, 0))
return 1;
if (SAME_TYPE(SCHEME_TYPE(value), scheme_compiled_unclosed_procedure_type)) {
@ -3152,6 +3154,8 @@ int scheme_compiled_propagate_ok(Scheme_Object *value, Optimize_Info *info)
if (SAME_TYPE(SCHEME_TYPE(value), scheme_compiled_toplevel_type)) {
if (SCHEME_TOPLEVEL_FLAGS(value) & SCHEME_TOPLEVEL_CONST)
return 1;
if (info->top_level_consts) {
int pos;
pos = SCHEME_TOPLEVEL_POS(value);
@ -4962,7 +4966,7 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
}
if (c) {
if (scheme_compiled_duplicate_ok(c))
if (scheme_compiled_duplicate_ok(c, 0))
return c;
/* We can't inline, but mark the top level as a constant,
@ -5239,7 +5243,7 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
return NULL;
default:
if (t > _scheme_compiled_values_types_) {
if (dup_ok || scheme_compiled_duplicate_ok(expr))
if (dup_ok || scheme_compiled_duplicate_ok(expr, 0))
return expr;
}
}

2
src/racket/src/read.c
View File

@ -5053,7 +5053,7 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
pos = read_compact_number(port);
mv = MALLOC_ONE_TAGGED(Module_Variable);
mv->so.type = scheme_module_variable_type;
mv->iso.so.type = scheme_module_variable_type;
if (SCHEME_SYMBOLP(mod))
mod = scheme_intern_resolved_module_path(mod);
mv->modidx = mod;

4
src/racket/src/resolve.c
View File

@ -675,12 +675,12 @@ ref_resolve(Scheme_Object *data, Resolve_Info *rslv)
if (SAME_OBJ(v, scheme_true)
|| SAME_OBJ(v, scheme_false)) {
if (SCHEME_TRUEP(v))
SCHEME_PAIR_FLAGS(data) |= 0x1; /* => constant */
SCHEME_VARREF_FLAGS(data) |= 0x1; /* => constant */
v = SCHEME_PTR2_VAL(data);
} else if (SAME_TYPE(SCHEME_TYPE(v), scheme_local_type)) {
v = scheme_resolve_expr(v, rslv);
if (SAME_TYPE(SCHEME_TYPE(v), scheme_local_type))
SCHEME_PAIR_FLAGS(data) |= 0x1; /* because mutable would be unbox */
SCHEME_VARREF_FLAGS(data) |= 0x1; /* because mutable would be unbox */
v = SCHEME_PTR2_VAL(data);
} else
v = scheme_resolve_expr(v, rslv);

13
src/racket/src/schpriv.h
View File

@ -2546,7 +2546,7 @@ Scheme_Object *scheme_optimize_apply_values(Scheme_Object *f, Scheme_Object *e,
int e_single_result,
int context);
int scheme_compiled_duplicate_ok(Scheme_Object *o);
int scheme_compiled_duplicate_ok(Scheme_Object *o, int cross_mod);
int scheme_compiled_propagate_ok(Scheme_Object *o, Optimize_Info *info);
int scheme_is_statically_proc(Scheme_Object *value, Optimize_Info *info);
Scheme_Object *scheme_make_noninline_proc(Scheme_Object *e);
@ -3046,13 +3046,17 @@ typedef struct Scheme_Modidx {
} Scheme_Modidx;
typedef struct Module_Variable {
Scheme_Object so; /* scheme_module_variable_type */
Scheme_Inclhash_Object iso; /* 0x1 flag => constant */
Scheme_Object *modidx;
Scheme_Object *sym;
Scheme_Object *insp; /* for checking protected/unexported access */
int pos, mod_phase;
} Module_Variable;
#define SCHEME_MODVAR_FLAGS(pr) MZ_OPT_HASH_KEY(&((Module_Variable *)pr)->iso)
#define SCHEME_VARREF_FLAGS(pr) MZ_OPT_HASH_KEY(&((Scheme_Simple_Object *)pr)->iso)
void scheme_add_global_keyword(const char *name, Scheme_Object *v, Scheme_Env *env);
void scheme_add_global_keyword_symbol(Scheme_Object *name, Scheme_Object *v, Scheme_Env *env);
void scheme_add_global_constant(const char *name, Scheme_Object *v, Scheme_Env *env);
@ -3100,7 +3104,8 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
Scheme_Object *rename_insp,
int position, int want_pos,
int *_protected, int *_unexported,
Scheme_Env *from_env, int *_would_complain);
Scheme_Env *from_env, int *_would_complain,
Scheme_Object **_is_constant);
void scheme_check_unsafe_accessible(Scheme_Object *insp, Scheme_Env *from_env);
Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *name);
@ -3115,7 +3120,7 @@ int scheme_resolved_module_path_value_matches(Scheme_Object *rmp, Scheme_Object
Scheme_Object *scheme_hash_module_variable(Scheme_Env *env, Scheme_Object *modidx,
Scheme_Object *stxsym, Scheme_Object *insp,
int pos, intptr_t mod_phase);
int pos, intptr_t mod_phase, int is_constant);
Scheme_Env *scheme_get_kernel_env();