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

allow cross-module inlining to introduce a variable reference

Browse Source 
Formerly, cross-module inlining would not work for a function like

  (define (f x)
    (if .... .... (slow x)))

unless `slow` was also inlined into `f`. This commit changes
cross-module inlining so that it allows a call to `f` to be replaced
with an expression that references other module-level bindings (that
are not primitives), such as `slow`.

Adjusting the inlining rules can always make some program worse. In
this case, a hueristic about whether to export an optimized or
unoptimized variant of a fnuciton for inlining tends to collide with
the adjusted inlining rule, so this commit tweaks that heuristic, too.
This commit is contained in:
Matthew Flatt 2016-03-06 14:14:40 -07:00
parent 7e2195fdba
commit c1d44cedba
12 changed files with 448 additions and 142 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
pkgs/racket-test-core/tests/racket/optimize.rktl
View File

@ -3285,6 +3285,25 @@
empty? ; so that it counts as imported
(null? 10)))
(test-comp `(module m racket/base
(module a racket/base
(provide b c)
(define c #f)
(set! c c)
(define (b) (c)))
(module d racket/base
(require (submod ".." a))
(list b c (b))))
`(module m racket/base
(module a racket/base
(provide b c)
(define c #f)
(set! c c)
(define (b) (c)))
(module d racket/base
(require (submod ".." a))
(list b c (c)))))
(module check-inline-request racket/base
(require racket/performance-hint)
(provide loop)

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

@ -1485,7 +1485,7 @@ scheme_compile_lookup(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
if (modname) {
val = scheme_module_syntax(modname, env->genv, find_id, SCHEME_INT_VAL(mod_defn_phase));
if (val && !(flags & SCHEME_NO_CERT_CHECKS))
scheme_check_accessible_in_module(genv, in_modidx,
scheme_check_accessible_in_module_instance(genv,
find_id, src_find_id,
env->insp, rename_insp,
-2, 0,
@ -1511,7 +1511,7 @@ scheme_compile_lookup(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
if (flags & SCHEME_NO_CERT_CHECKS)
pos = 0;
else
pos = scheme_check_accessible_in_module(genv, in_modidx,
pos = scheme_check_accessible_in_module_instance(genv,
find_id, src_find_id,
env->insp, rename_insp,
-1, 1,
@ -1579,8 +1579,17 @@ scheme_compile_lookup(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
is_constant = 2;
shape = intern_struct_proc_shape(SCHEME_PROC_SHAPE_MODE(mod_constant));
} else if (SAME_TYPE(SCHEME_TYPE(mod_constant), scheme_inline_variant_type)) {
if (_inline_variant)
*_inline_variant = mod_constant;
if (_inline_variant) {
/* In case the inline variant includes references to module
variables, we'll need to shift the references: */
Scheme_Object *shiftable;
shiftable = scheme_make_vector(4, scheme_false);
SCHEME_VEC_ELS(shiftable)[0] = mod_constant;
SCHEME_VEC_ELS(shiftable)[1] = genv->module->me->src_modidx;
SCHEME_VEC_ELS(shiftable)[2] = modidx;
SCHEME_VEC_ELS(shiftable)[3] = mod_defn_phase;
*_inline_variant = shiftable;
}
is_constant = 2;
shape = scheme_get_or_check_procedure_shape(mod_constant, NULL);
} else {

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

@ -3404,7 +3404,7 @@ Scheme_Env *scheme_environment_from_dummy(Scheme_Object *dummy)
static void *eval_letmacro_rhs_k(void);
static Scheme_Object *eval_letmacro_rhs(Scheme_Object *a, Scheme_Comp_Env *rhs_env,
static Scheme_Object *eval_letmacro_rhs(Scheme_Object *a, Scheme_Env *genv, Scheme_Comp_Env *rhs_env,
int max_let_depth, Resolve_Prefix *rp,
int phase)
{
@ -3417,12 +3417,13 @@ static Scheme_Object *eval_letmacro_rhs(Scheme_Object *a, Scheme_Comp_Env *rhs_e
p->ku.k.p1 = a;
p->ku.k.p2 = rhs_env;
p->ku.k.p3 = rp;
p->ku.k.p4 = genv;
p->ku.k.i1 = max_let_depth;
p->ku.k.i2 = phase;
return (Scheme_Object *)scheme_enlarge_runstack(depth, eval_letmacro_rhs_k);
}
save_runstack = scheme_push_prefix(NULL, rp, NULL, NULL, phase, phase, rhs_env->genv, NULL);
save_runstack = scheme_push_prefix(genv, 1, rp, NULL, NULL, phase, phase, rhs_env->genv, NULL);
if (scheme_omittable_expr(a, 1, -1, OMITTABLE_RESOLVED, NULL, NULL)) {
/* short cut */
@ -3460,10 +3461,12 @@ static void *eval_letmacro_rhs_k(void)
Scheme_Comp_Env *rhs_env;
int max_let_depth, phase;
Resolve_Prefix *rp;
Scheme_Env *genv;
a = (Scheme_Object *)p->ku.k.p1;
rhs_env = (Scheme_Comp_Env *)p->ku.k.p2;
rp = (Resolve_Prefix *)p->ku.k.p3;
genv = (Scheme_Env *)p->ku.k.p4;
max_let_depth = p->ku.k.i1;
phase = p->ku.k.i2;
@ -3471,7 +3474,7 @@ static void *eval_letmacro_rhs_k(void)
p->ku.k.p2 = NULL;
p->ku.k.p3 = NULL;
return (void *)eval_letmacro_rhs(a, rhs_env, max_let_depth, rp, phase);
return (void *)eval_letmacro_rhs(a, genv, rhs_env, max_let_depth, rp, phase);
}
void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object *a,
@ -3521,15 +3524,11 @@ void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object
a = scheme_letrec_check_expr(a);
oi = scheme_optimize_info_create(eenv->prefix, 1);
oi = scheme_optimize_info_create(eenv->prefix, eenv->genv, insp, 1);
if (!(rec[drec].comp_flags & COMP_CAN_INLINE))
scheme_optimize_info_never_inline(oi);
a = scheme_optimize_expr(a, oi, 0);
/* For internal defn, don't simplify as resolving, because the
expression may have syntax objects with a lexical rename that
is still being extended.
For letrec-syntaxes+values, don't simplify because it's too expensive. */
rp = scheme_resolve_prefix(eenv->genv->phase, eenv->prefix, insp);
ri = scheme_resolve_info_create(rp);
@ -3547,7 +3546,7 @@ void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object
}
a_expr = a;
a = eval_letmacro_rhs(a_expr, rhs_env,
a = eval_letmacro_rhs(a_expr, eenv->genv, rhs_env,
scheme_resolve_info_max_let_depth(ri),
rp, eenv->genv->phase);

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

@ -1425,7 +1425,8 @@ scheme_do_add_global_symbol(Scheme_Env *env, Scheme_Object *sym,
if (constant && scheme_defining_primitives) {
((Scheme_Bucket_With_Flags *)b)->id = builtin_ref_counter++;
((Scheme_Bucket_With_Flags *)b)->flags |= (GLOB_HAS_REF_ID | GLOB_IS_CONST | GLOB_STRONG_HOME_LINK);
}
} else if (constant)
((Scheme_Bucket_With_Flags *)b)->flags |= (GLOB_IS_CONST | GLOB_STRONG_HOME_LINK);
scheme_set_bucket_home(b, env);
} else
scheme_add_to_table(env->syntax, (const char *)sym, obj, constant);

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

@ -900,7 +900,7 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx,
}
if (check_access && !SAME_OBJ(menv, env)) {
varname = scheme_check_accessible_in_module(menv, NULL, varname, NULL,
varname = scheme_check_accessible_in_module_instance(menv, varname, NULL,
NULL, insp,
pos, 0,
NULL, NULL,
@ -909,8 +909,9 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx,
}
if (exprs) {
Scheme_Object *simplified;
if (self) {
exprs[which] = varname;
simplified = varname;
} else {
if (flags & SCHEME_MODVAR_CONST) {
Scheme_Object *v;
@ -919,14 +920,17 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx,
SCHEME_VEC_ELS(v)[2] = (shape ? shape : scheme_false);
if (mod_phase != 0)
SCHEME_VEC_ELS(v)[3] = scheme_make_integer(mod_phase);
simplified = v;
} else {
Scheme_Object *v = modname;
if (mod_phase != 0)
v = scheme_make_pair(v, scheme_make_integer(mod_phase));
v = scheme_make_pair(varname, v);
exprs[which] = v;
simplified = v;
}
simplified = scheme_make_mutable_pair(simplified, exprs[which]);
}
exprs[which] = simplified;
}
bkt = scheme_global_bucket(varname, menv);
@ -944,8 +948,8 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx,
bad_reason = "has the wrong procedure or structure-type shape";
}
} else {
if (!(((Scheme_Bucket_With_Flags *)bkt)->flags & GLOB_IS_IMMUTATED))
bad_reason = "not constant";
if (!(((Scheme_Bucket_With_Flags *)bkt)->flags & (GLOB_IS_CONST | GLOB_IS_IMMUTATED)))
bad_reason = "is not constant";
}
}
@ -982,6 +986,12 @@ static Scheme_Object *link_toplevel(Scheme_Object **exprs, int which, Scheme_Env
{
Scheme_Object *expr = exprs[which];
if (SCHEME_MPAIRP(expr)) {
/* Simplified reference was installed by link_module_variable;
simplified is in CAR, and original is in CDR */
expr = SCHEME_CAR(expr);
}
if (SCHEME_FALSEP(expr)) {
/* See scheme_make_environment_dummy */
Scheme_Bucket *b;
@ -1997,7 +2007,7 @@ define_execute_with_dynamic_state(Scheme_Object *vec, int delta, int defmacro,
if (dm_env) {
scheme_prepare_exp_env(dm_env);
save_runstack = scheme_push_prefix(dm_env->exp_env, rp, NULL, NULL, 1, 1, NULL, scheme_false);
save_runstack = scheme_push_prefix(dm_env->exp_env, 0, rp, NULL, NULL, 1, 1, NULL, scheme_false);
vals = scheme_eval_linked_expr_multi_with_dynamic_state(vals_expr, dyn_state);
scheme_pop_prefix(save_runstack);
} else {
@ -2446,7 +2456,7 @@ do_define_syntaxes_execute(Scheme_Object *form, Scheme_Env *dm_env)
form = SCHEME_VEC_ELS(form)[0];
save_runstack = scheme_push_prefix(dm_env->exp_env, rp, NULL, NULL, 1, 1, NULL, scheme_false);
save_runstack = scheme_push_prefix(dm_env->exp_env, 0, rp, NULL, NULL, 1, 1, NULL, scheme_false);
while (!SCHEME_NULLP(form)) {
ignore_result(scheme_eval_linked_expr_multi_with_dynamic_state(SCHEME_CAR(form), &dyn_state));
@ -4054,7 +4064,8 @@ static Scheme_Object *binding_namess_as_list(Scheme_Hash_Table *binding_namess)
return l;
}
static Scheme_Object *optimize_resolve_expr(Scheme_Object* o, Comp_Prefix *cp,
static Scheme_Object *optimize_resolve_expr(Scheme_Object* o,
Comp_Prefix *cp, Scheme_Env *env, Scheme_Object *insp,
Scheme_Object *src_insp_desc,
Scheme_Object *binding_namess,
int comp_flags)
@ -4070,7 +4081,7 @@ static Scheme_Object *optimize_resolve_expr(Scheme_Object* o, Comp_Prefix *cp,
enforce_consts = SCHEME_TRUEP(scheme_get_param(config, MZCONFIG_COMPILE_MODULE_CONSTS));
if (enforce_consts)
comp_flags |= COMP_ENFORCE_CONSTS;
oi = scheme_optimize_info_create(cp, 1);
oi = scheme_optimize_info_create(cp, env, insp, 1);
scheme_optimize_info_enforce_const(oi, enforce_consts);
if (!(comp_flags & COMP_CAN_INLINE))
scheme_optimize_info_never_inline(oi);
@ -4259,7 +4270,7 @@ static void *compile_k(void)
o = scheme_letrec_check_expr(o);
oi = scheme_optimize_info_create(cenv->prefix, 1);
oi = scheme_optimize_info_create(cenv->prefix, genv, insp, 1);
scheme_optimize_info_enforce_const(oi, enforce_consts);
if (!(comp_flags & COMP_CAN_INLINE))
scheme_optimize_info_never_inline(oi);
@ -4448,7 +4459,7 @@ static void *eval_k(void)
scheme_install_binding_names(top->binding_namess, env);
save_runstack = scheme_push_prefix(env, rp, NULL, NULL, 0, env->phase, NULL, scheme_false);
save_runstack = scheme_push_prefix(env, 0, rp, NULL, NULL, 0, env->phase, NULL, scheme_false);
if (as_tail) {
/* Cons up a closure to capture the prefix */
@ -4940,7 +4951,9 @@ static Scheme_Object *recompile_top(Scheme_Object *top, int comp_flags)
printf("%s\n\n", scheme_print_to_string(code, NULL));
#endif
top = optimize_resolve_expr(code, cp, ((Scheme_Compilation_Top*)top)->prefix->src_insp_desc,
top = optimize_resolve_expr(code, cp, scheme_get_env(NULL),
scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR),
((Scheme_Compilation_Top*)top)->prefix->src_insp_desc,
((Scheme_Compilation_Top*)top)->binding_namess,
comp_flags);
@ -5969,7 +5982,7 @@ int scheme_prefix_depth(Resolve_Prefix *rp)
return 0;
}
Scheme_Object **scheme_push_prefix(Scheme_Env *genv, Resolve_Prefix *rp,
Scheme_Object **scheme_push_prefix(Scheme_Env *genv, int already_linked, Resolve_Prefix *rp,
Scheme_Object *src_modidx, Scheme_Object *now_modidx,
int src_phase, int now_phase,
Scheme_Env *dummy_env, Scheme_Object *insp)
@ -6002,8 +6015,12 @@ Scheme_Object **scheme_push_prefix(Scheme_Env *genv, Resolve_Prefix *rp,
for (i = 0; i < rp->num_toplevels; i++) {
v = rp->toplevels[i];
if (genv || SCHEME_FALSEP(v))
if (!already_linked || SCHEME_FALSEP(v))
v = link_toplevel(rp->toplevels, i, genv ? genv : dummy_env, src_modidx, now_modidx, insp);
else if (SAME_TYPE(SCHEME_TYPE(v), scheme_module_variable_type)) {
/* not already linked, after all */
v = link_toplevel(rp->toplevels, i, genv, src_modidx, now_modidx, insp);
}
pf->a[i] = v;
}
@ -6013,7 +6030,7 @@ Scheme_Object **scheme_push_prefix(Scheme_Env *genv, Resolve_Prefix *rp,
i = rp->num_toplevels;
v = scheme_make_shift(scheme_make_integer(now_phase - src_phase),
src_modidx, now_modidx,
genv ? genv->module_registry->exports : NULL,
!already_linked ? genv->module_registry->exports : NULL,
rp->src_insp_desc, insp);
if (v || (rp->delay_info_rpair && SCHEME_CDR(rp->delay_info_rpair))) {
/* Put lazy-shift info in pf->a[i]: */

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

@ -4518,18 +4518,21 @@ Scheme_Env *scheme_module_access(Scheme_Object *name, Scheme_Env *env, intptr_t
return menv;
}
static void check_certified(Scheme_Object *stx,
static void check_certified(Scheme_Object *guard_insp,
Scheme_Object *current_insp, Scheme_Object *binding_insp,
Scheme_Object *in_modidx,
Scheme_Env *env, Scheme_Object *symbol,
int var, int prot, int *_would_complain)
Scheme_Object *stx, /* for error reporting */
Scheme_Module *module, /* for error reporting */
Scheme_Object *symbol, /* for error reporting */
int var, /* for error reporting */
int prot, /* for error reporting */
int *_would_complain)
{
int need_cert = 1;
if (need_cert && current_insp)
need_cert = scheme_module_protected_wrt(env->guard_insp, current_insp);
need_cert = scheme_module_protected_wrt(guard_insp, current_insp);
if (need_cert && binding_insp)
need_cert = scheme_module_protected_wrt(env->guard_insp, binding_insp);
need_cert = scheme_module_protected_wrt(guard_insp, binding_insp);
if (need_cert) {
if (_would_complain) {
@ -4544,7 +4547,7 @@ static void check_certified(Scheme_Object *stx,
"access disallowed by code inspector to %s %s from module: %D",
prot ? "protected" : "unexported",
var ? "variable" : "syntax",
scheme_get_modsrc(env->module));
scheme_get_modsrc(module));
}
}
}
@ -4567,13 +4570,15 @@ static Scheme_Object *to_defined_symbol(Scheme_Object *symbol, Scheme_Env *env)
return to_defined_symbol_at_phase(symbol, env, scheme_make_integer(env->phase));
}
Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object *in_modidx,
Scheme_Object *symbol, Scheme_Object *stx,
static Scheme_Object *check_accessible_in_module(Scheme_Module *module, intptr_t mod_phase, Scheme_Object *guard_insp,
Scheme_Object *symbol,
Scheme_Object *stx, /* for error reporting, only */
Scheme_Object *current_insp,
Scheme_Object *binding_insp,
int position, int want_pos,
int *_protected, int *_unexported,
Scheme_Env *from_env, int *_would_complain,
Scheme_Env *from_env, /* for error reporting, only */
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.
@ -4584,27 +4589,24 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
{
Scheme_Module_Phase_Exports *pt;
if (!SCHEME_SYMBOLP(symbol))
symbol = to_defined_symbol(symbol, env);
if (scheme_is_kernel_env(env)
|| ((env->module->primitive && !env->module->exp_infos[0]->provide_protects))) {
if (SAME_OBJ(scheme_get_kernel_env()->module, module)
|| ((module->primitive && !module->exp_infos[0]->provide_protects))) {
if (want_pos)
return scheme_make_integer(-1);
else
return symbol;
}
switch (env->mod_phase) {
switch (mod_phase) {
case 0:
pt = env->module->me->rt;
pt = module->me->rt;
break;
case 1:
pt = env->module->me->et;
pt = module->me->et;
break;
default:
pt = (Scheme_Module_Phase_Exports *)scheme_hash_get(env->module->me->other_phases,
scheme_make_integer(env->mod_phase));
pt = (Scheme_Module_Phase_Exports *)scheme_hash_get(module->me->other_phases,
scheme_make_integer(mod_phase));
break;
}
@ -4626,9 +4628,9 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
int num_indirect_provides;
Scheme_Object **indirect_provides;
if ((env->mod_phase >= 0) && (env->mod_phase < env->module->num_phases)) {
num_indirect_provides = env->module->exp_infos[env->mod_phase]->num_indirect_provides;
indirect_provides = env->module->exp_infos[env->mod_phase]->indirect_provides;
if ((mod_phase >= 0) && (mod_phase < module->num_phases)) {
num_indirect_provides = module->exp_infos[mod_phase]->num_indirect_provides;
indirect_provides = module->exp_infos[mod_phase]->indirect_provides;
} else {
num_indirect_provides = 0;
indirect_provides = NULL;
@ -4649,11 +4651,11 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
&& !memcmp(SCHEME_SYM_VAL(isym), SCHEME_SYM_VAL(symbol), SCHEME_SYM_LEN(isym)))) {
if ((position < pt->num_var_provides)
&& scheme_module_protected_wrt(env->guard_insp, current_insp)) {
&& scheme_module_protected_wrt(guard_insp, current_insp)) {
char *provide_protects;
if ((env->mod_phase >= 0) && (env->mod_phase < env->module->num_phases))
provide_protects = env->module->exp_infos[env->mod_phase]->provide_protects;
if ((mod_phase >= 0) && (mod_phase < module->num_phases))
provide_protects = module->exp_infos[mod_phase]->provide_protects;
else
provide_protects = NULL;
@ -4661,12 +4663,12 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
&& provide_protects[position]) {
if (_protected)
*_protected = 1;
check_certified(stx, current_insp, binding_insp, in_modidx, env, symbol, 1, 1, _would_complain);
check_certified(guard_insp, current_insp, binding_insp, stx, module, symbol, 1, 1, _would_complain);
}
}
if (need_cert)
check_certified(stx, current_insp, binding_insp, in_modidx, env, symbol, 1, 0, _would_complain);
check_certified(guard_insp, current_insp, binding_insp, stx, module, symbol, 1, 0, _would_complain);
if (want_pos)
return scheme_make_integer(position);
@ -4678,8 +4680,8 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
} else {
Scheme_Object *pos;
if (env->mod_phase < env->module->num_phases)
pos = scheme_hash_get(env->module->exp_infos[env->mod_phase]->accessible, symbol);
if (mod_phase < module->num_phases)
pos = scheme_hash_get(module->exp_infos[mod_phase]->accessible, symbol);
else
pos = NULL;
@ -4719,8 +4721,8 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
if (pos) {
char *provide_protects;
if ((env->mod_phase >= 0) && (env->mod_phase < env->module->num_phases))
provide_protects = env->module->exp_infos[env->mod_phase]->provide_protects;
if ((mod_phase >= 0) && (mod_phase < module->num_phases))
provide_protects = module->exp_infos[mod_phase]->provide_protects;
else
provide_protects = NULL;
@ -4729,7 +4731,7 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
&& provide_protects[SCHEME_INT_VAL(pos)]) {
if (_protected)
*_protected = 1;
check_certified(stx, current_insp, binding_insp, in_modidx, env, symbol, 1, 1, _would_complain);
check_certified(guard_insp, current_insp, binding_insp, stx, module, symbol, 1, 1, _would_complain);
}
if ((position >= -1)
@ -4739,7 +4741,7 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
*_protected = 1;
if (_unexported)
*_unexported = 1;
check_certified(stx, current_insp, binding_insp, in_modidx, env, symbol, 1, 0, _would_complain);
check_certified(guard_insp, current_insp, binding_insp, stx, module, symbol, 1, 0, _would_complain);
}
if (want_pos)
@ -4752,7 +4754,7 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
/* unexported syntax -- need cert */
if (_unexported)
*_unexported = 1;
check_certified(stx, current_insp, binding_insp, in_modidx, env, symbol, 0, 0, _would_complain);
check_certified(guard_insp, current_insp, binding_insp, stx, module, symbol, 0, 0, _would_complain);
return NULL;
}
}
@ -4790,14 +4792,66 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
srclen ? " importing module: " : "",
srcstr, srclen,
srclen ? "\n" : "",
scheme_get_modsrc(env->module),
env->mod_phase,
scheme_get_modsrc(module),
mod_phase,
(position >= 0) ? " and at the expected position" : "");
}
return NULL;
}
Scheme_Object *scheme_check_accessible_in_module_instance(Scheme_Env *env,
Scheme_Object *symbol,
Scheme_Object *stx, /* for error reporting, only */
Scheme_Object *current_insp,
Scheme_Object *binding_insp,
int position, int want_pos,
int *_protected, int *_unexported,
Scheme_Env *from_env, /* for error reporting, only */
int *_would_complain,
Scheme_Object **_is_constant)
{
if (!SCHEME_SYMBOLP(symbol))
symbol = to_defined_symbol(symbol, env);
return check_accessible_in_module(env->module, env->mod_phase, env->guard_insp,
symbol, stx,
current_insp, binding_insp,
position, want_pos,
_protected, _unexported,
from_env,
_would_complain,
_is_constant);
}
int scheme_check_accessible_in_module_name(Scheme_Object *modidx, intptr_t mod_phase, Scheme_Env *env,
Scheme_Object *symbol, int position,
Scheme_Object *current_insp, Scheme_Object *binding_insp,
Scheme_Object **_is_constant)
{
Scheme_Module *module;
Scheme_Object *modname;
int would_complain = 0;
modname = scheme_module_resolve(modidx, 0);
module = registry_get_loaded(env, modname);
if (!module)
return 0;
(void)check_accessible_in_module(module, mod_phase, scheme_make_inspector(module->insp),
symbol, NULL,
current_insp, binding_insp,
position, 0,
NULL, NULL,
NULL,
&would_complain,
_is_constant);
return !would_complain;
}
void scheme_check_unsafe_accessible(Scheme_Object *insp, Scheme_Env *from_env)
{
Scheme_Env *unsafe_env;
@ -5939,7 +5993,7 @@ void *scheme_module_run_finish(Scheme_Env *menv, Scheme_Env *env)
LOG_START_RUN(menv->module);
save_runstack = scheme_push_prefix(menv, m->prefix,
save_runstack = scheme_push_prefix(menv, 0, m->prefix,
m->me->src_modidx, menv->link_midx,
0, menv->phase, NULL,
menv->access_insp);
@ -6407,7 +6461,7 @@ static void eval_exptime(Scheme_Object *names, int count,
if (SCHEME_TYPE(expr) > _scheme_values_types_) {
vals = expr;
} else {
save_runstack = scheme_push_prefix(genv, rp,
save_runstack = scheme_push_prefix(genv, 0, rp,
(shift ? genv->module->me->src_modidx : NULL),
(shift ? genv->link_midx : NULL),
at_phase, genv->phase,
@ -8558,7 +8612,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
o = scheme_letrec_check_expr((Scheme_Object *)env->genv->module);
oi = scheme_optimize_info_create(env->prefix, 1);
oi = scheme_optimize_info_create(env->prefix, env->genv, env->insp, 1);
scheme_optimize_info_enforce_const(oi, rec[drec].comp_flags & COMP_ENFORCE_CONSTS);
if (!(rec[drec].comp_flags & COMP_CAN_INLINE))
scheme_optimize_info_never_inline(oi);
@ -9286,7 +9340,7 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
m = scheme_letrec_check_expr(m);
oi = scheme_optimize_info_create(eenv->prefix, 1);
oi = scheme_optimize_info_create(eenv->prefix, eenv->genv, env->insp, 1);
scheme_optimize_info_set_context(oi, (Scheme_Object *)env->genv->module);
if (!(rec[drec].comp_flags & COMP_CAN_INLINE))
scheme_optimize_info_never_inline(oi);

4
racket/src/racket/src/mzmark_optimize.inc
View File

@ -15,6 +15,8 @@ static int mark_optimize_info_MARK(void *p, struct NewGC *gc) {
gcMARK2(i->next, gc);
gcMARK2(i->consts, gc);
gcMARK2(i->cp, gc);
gcMARK2(i->env, gc);
gcMARK2(i->insp, gc);
gcMARK2(i->top_level_consts, gc);
gcMARK2(i->transitive_use_var, gc);
gcMARK2(i->context, gc);
@ -38,6 +40,8 @@ static int mark_optimize_info_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(i->next, gc);
gcFIXUP2(i->consts, gc);
gcFIXUP2(i->cp, gc);
gcFIXUP2(i->env, gc);
gcFIXUP2(i->insp, gc);
gcFIXUP2(i->top_level_consts, gc);
gcFIXUP2(i->transitive_use_var, gc);
gcFIXUP2(i->context, gc);

12
racket/src/racket/src/mzmark_resolve.inc
View File

@ -69,6 +69,12 @@ static int mark_unresolve_info_MARK(void *p, struct NewGC *gc) {
gcMARK2(i->closures, gc);
gcMARK2(i->module, gc);
gcMARK2(i->comp_prefix, gc);
gcMARK2(i->new_toplevels, gc);
gcMARK2(i->from_modidx, gc);
gcMARK2(i->to_modidx, gc);
gcMARK2(i->opt_env, gc);
gcMARK2(i->opt_insp, gc);
gcMARK2(i->inline_variants, gc);
gcMARK2(i->toplevels, gc);
gcMARK2(i->definitions, gc);
gcMARK2(i->ref_lifts, gc);
@ -91,6 +97,12 @@ static int mark_unresolve_info_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(i->closures, gc);
gcFIXUP2(i->module, gc);
gcFIXUP2(i->comp_prefix, gc);
gcFIXUP2(i->new_toplevels, gc);
gcFIXUP2(i->from_modidx, gc);
gcFIXUP2(i->to_modidx, gc);
gcFIXUP2(i->opt_env, gc);
gcFIXUP2(i->opt_insp, gc);
gcFIXUP2(i->inline_variants, gc);
gcFIXUP2(i->toplevels, gc);
gcFIXUP2(i->definitions, gc);
gcFIXUP2(i->ref_lifts, gc);

8
racket/src/racket/src/mzmarksrc.c
View File

@ -1339,6 +1339,12 @@ mark_unresolve_info {
gcMARK2(i->closures, gc);
gcMARK2(i->module, gc);
gcMARK2(i->comp_prefix, gc);
gcMARK2(i->new_toplevels, gc);
gcMARK2(i->from_modidx, gc);
gcMARK2(i->to_modidx, gc);
gcMARK2(i->opt_env, gc);
gcMARK2(i->opt_insp, gc);
gcMARK2(i->inline_variants, gc);
gcMARK2(i->toplevels, gc);
gcMARK2(i->definitions, gc);
gcMARK2(i->ref_lifts, gc);
@ -1409,6 +1415,8 @@ mark_optimize_info {
gcMARK2(i->next, gc);
gcMARK2(i->consts, gc);
gcMARK2(i->cp, gc);
gcMARK2(i->env, gc);
gcMARK2(i->insp, gc);
gcMARK2(i->top_level_consts, gc);
gcMARK2(i->transitive_use_var, gc);
gcMARK2(i->context, gc);

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

@ -37,6 +37,7 @@
#define OPT_LIMIT_FUNCTION_RESIZE 0
#define OPT_BRANCH_ADDS_NO_SIZE 1
#define OPT_DELAY_GROUP_PROPAGATE 0
#define OPT_PRE_OPTIMIZE_FOR_CROSS_MODULE(size_override) (size_override)
#define MAX_PROC_INLINE_SIZE 256
#define CROSS_MODULE_INLINE_SIZE 8
@ -57,6 +58,10 @@ struct Optimize_Info
Comp_Prefix *cp;
int init_kclock;
/* Compilation context, used for unresolving for cross-module inlining: */
Scheme_Env *env;
Scheme_Object *insp;
/* Propagated up and down the chain: */
int size;
int vclock; /* virtual clock that ticks for a side effect, a branch,
@ -2057,10 +2062,14 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
if (!iv)
iv = scheme_hash_get(iv_ht, scheme_false);
}
if (SAME_TYPE(SCHEME_TYPE(iv), scheme_inline_variant_type)) {
if (SAME_TYPE(SCHEME_TYPE(iv), scheme_vector_type)) { /* inline variant + shift info */
int has_cases = 0;
Scheme_Object *orig_iv = iv;
iv = scheme_unresolve(iv, argc, &has_cases);
MZ_ASSERT(SAME_TYPE(scheme_inline_variant_type, SCHEME_TYPE(SCHEME_VEC_ELS(iv)[0])));
/* unresolving may add new top-levels to `info->cp`: */
iv = scheme_unresolve(SCHEME_VEC_ELS(iv)[0], argc, &has_cases,
info->cp, info->env, info->insp, SCHEME_INT_VAL(SCHEME_VEC_ELS(iv)[3]),
SCHEME_VEC_ELS(iv)[1], SCHEME_VEC_ELS(iv)[2]);
if (has_cases) {
if (!iv_ht) {
iv_ht = scheme_make_hash_table(SCHEME_hash_ptr);
@ -5510,7 +5519,7 @@ static Scheme_Object *do_define_syntaxes_optimize(Scheme_Object *data, Optimize_
val = SCHEME_VEC_ELS(data)[3];
einfo = scheme_optimize_info_create(info->cp, 0);
einfo = scheme_optimize_info_create(info->cp, info->env, info->insp, 0);
if (info->inline_fuel < 0)
einfo->inline_fuel = -1;
einfo->logger = info->logger;
@ -5535,7 +5544,7 @@ static Scheme_Object *begin_for_syntax_optimize(Scheme_Object *data, Optimize_In
l = SCHEME_VEC_ELS(data)[2];
while (!SCHEME_NULLP(l)) {
einfo = scheme_optimize_info_create(info->cp, 0);
einfo = scheme_optimize_info_create(info->cp, info->env, info->insp, 0);
if (info->inline_fuel < 0)
einfo->inline_fuel = -1;
einfo->logger = info->logger;
@ -7851,7 +7860,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
e = SCHEME_VEC_ELS(e)[1];
old_e = scheme_hash_get(info->top_level_consts, rpos);
if (old_e && SCHEME_LAMBDAP(old_e)) {
if (old_e && SCHEME_LAMBDAP(old_e) && OPT_PRE_OPTIMIZE_FOR_CROSS_MODULE(1)) {
if (!originals)
originals = scheme_make_hash_table(SCHEME_hash_ptr);
scheme_hash_set(originals, scheme_make_integer(start_simultaneous), old_e);
@ -7937,7 +7946,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
Scheme_Object *sub_e, *alt_e;
sub_e = SCHEME_VEC_ELS(e)[1];
alt_e = is_cross_module_inline_candidiate(sub_e, info, 0);
if (!alt_e && originals) {
if (!alt_e && originals && OPT_PRE_OPTIMIZE_FOR_CROSS_MODULE(size_override)) {
alt_e = scheme_hash_get(originals, scheme_make_integer(i_m));
if (SAME_OBJ(alt_e, sub_e) && !size_override)
alt_e = NULL;
@ -8514,7 +8523,7 @@ Scheme_Object *optimize_clone(int single_use, Scheme_Object *expr, Optimize_Info
/* compile-time env for optimization */
/*========================================================================*/
Optimize_Info *scheme_optimize_info_create(Comp_Prefix *cp, int get_logger)
Optimize_Info *scheme_optimize_info_create(Comp_Prefix *cp, Scheme_Env *env, Scheme_Object *insp, int get_logger)
{
Optimize_Info *info;
@ -8525,6 +8534,8 @@ Optimize_Info *scheme_optimize_info_create(Comp_Prefix *cp, int get_logger)
info->inline_fuel = INITIAL_INLINING_FUEL;
info->flatten_fuel = INITIAL_FLATTENING_FUEL;
info->cp = cp;
info->env = env;
info->insp = insp;
if (get_logger) {
Scheme_Logger *logger;
@ -8771,7 +8782,7 @@ static Optimize_Info *optimize_info_add_frame(Optimize_Info *info, int orig, int
{
Optimize_Info *naya;
naya = scheme_optimize_info_create(info->cp, 0);
naya = scheme_optimize_info_create(info->cp, info->env, info->insp, 0);
naya->flags = (short)flags;
naya->next = info;
naya->original_frame = orig;

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

@ -2886,7 +2886,26 @@ typedef struct Unresolve_Info {
int inlining;
Scheme_Module *module;
Comp_Prefix *comp_prefix;
Comp_Prefix *comp_prefix; /* Top-level and syntax-constant info for
top-level unresolved. This prefix is
the unresolved from of the original
resolved prefix.
When unresolving a single lambda for
inlining, this prefix is NULL, and
tenattive additions are added to
`new_toplevels`, instead. */
Scheme_Hash_Table *new_toplevels; /* toplevels to add to an optimiation context */
int new_toplevel_offset; /* the number of toplevels already registered in the
optimization context */
Scheme_Object *from_modidx, *to_modidx; /* non-NULL => shift for adding to `new_toplevels` */
intptr_t toplevel_ref_phase;
Scheme_Env *opt_env;
Scheme_Object *opt_insp;
Scheme_Object *inline_variants;
Scheme_Hash_Table *toplevels;
Scheme_Object *definitions;
int lift_offset, lift_to_local;
@ -2899,7 +2918,7 @@ static void locate_cyclic_closures(Scheme_Object *e, Unresolve_Info *ui);
static Scheme_IR_Let_Header *make_let_header(int count);
static Scheme_IR_Let_Value *make_ir_let_value(int count);
static Unresolve_Info *new_unresolve_info(Scheme_Prefix *prefix, int comp_flags)
static Unresolve_Info *new_unresolve_info(Resolve_Prefix *prefix, int comp_flags)
{
Unresolve_Info *ui;
Scheme_IR_Local **vars;
@ -2908,12 +2927,13 @@ static Unresolve_Info *new_unresolve_info(Scheme_Prefix *prefix, int comp_flags)
ui = MALLOC_ONE_RT(Unresolve_Info);
SET_REQUIRED_TAG(ui->type = scheme_rt_unresolve_info);
ui->prefix = prefix;
ui->stack_pos = 0;
ui->stack_size = 10;
vars = MALLOC_N(Scheme_IR_Local *, ui->stack_size);
ui->vars = vars;
ui->inlining = 1;
ht = scheme_make_hash_table(SCHEME_hash_ptr);
ui->toplevels = ht;
ui->definitions = scheme_null;
@ -3091,6 +3111,7 @@ static int unresolve_toplevel_pos(int pos, Unresolve_Info *ui)
LOG_UNRESOLVE(printf("pos before = %d\n", pos));
if (ui->prefix->num_stxes
&& (pos > (ui->prefix->num_toplevels + ui->prefix->num_stxes))) {
/* shift lifted reference down to toplevel range */
pos -= ui->prefix->num_stxes + 1; /* extra slot for lazy syntax */
}
LOG_UNRESOLVE(printf("pos = %d\n", pos));
@ -3100,10 +3121,118 @@ static int unresolve_toplevel_pos(int pos, Unresolve_Info *ui)
static Scheme_Object *unresolve_toplevel(Scheme_Object *rdata, Unresolve_Info *ui)
{
Scheme_Object *v, *opos;
int pos;
Scheme_Object *v;
if (!ui->prefix) return_NULL;
if (ui->inlining) {
/* Create a reference that works for the optimization context. */
int pos = SCHEME_TOPLEVEL_POS(rdata);
if (ui->prefix->num_stxes
&& (pos > (ui->prefix->num_toplevels + ui->prefix->num_stxes))) {
/* Cannot refer to a lift across a module boundary. */
return_NULL;
} else {
Scheme_Object *hv, *modidx, *mod_constant;
int flags, is_constant;
int sym_pos;
intptr_t mod_defn_phase;
flags = SCHEME_TOPLEVEL_FLAGS(rdata) & SCHEME_TOPLEVEL_FLAGS_MASK;
switch (flags) {
case SCHEME_TOPLEVEL_CONST:
is_constant = 2;
break;
case SCHEME_TOPLEVEL_FIXED:
is_constant = 1;
break;
case SCHEME_TOPLEVEL_READY:
default:
/* Since we're referencing from an imported context, the
variable is now at least ready: */
flags = SCHEME_TOPLEVEL_READY;
is_constant = 0;
}
v = ui->prefix->toplevels[pos];
if (SCHEME_MPAIRP(v)) {
/* Simplified version was installed by link_module_variable; original is in CDR */
v = SCHEME_CDR(v);
}
if (SCHEME_SYMBOLP(v)) {
mod_defn_phase = ui->toplevel_ref_phase;
modidx = ui->to_modidx;
sym_pos = -1;
hv = scheme_hash_module_variable(ui->opt_env, modidx,
v, ui->opt_insp,
sym_pos, mod_defn_phase, is_constant,
NULL);
} else {
Module_Variable *mv = (Module_Variable *)v;
MZ_ASSERT(SAME_TYPE(SCHEME_TYPE(v), scheme_module_variable_type));
mod_defn_phase = mv->mod_phase;
modidx = scheme_modidx_shift(mv->modidx, ui->from_modidx, ui->to_modidx);
hv = scheme_hash_module_variable(ui->opt_env, modidx,
mv->sym, ui->opt_insp,
mv->pos, mv->mod_phase, is_constant,
mv->shape);
v = mv->sym;
sym_pos = mv->pos;
}
mod_constant = NULL;
if (!scheme_check_accessible_in_module_name(modidx, mod_defn_phase, ui->opt_env,
v, sym_pos,
ui->opt_insp, NULL,
&mod_constant))
return_NULL;
/* Check whether this variable is already known in the optimzation context: */
v = scheme_hash_get(ui->comp_prefix->toplevels, hv);
if (!v) {
/* Not already in optimization context; check/extend tentative additions */
if (!ui->new_toplevels) {
Scheme_Hash_Table *ht;
ht = scheme_make_hash_table(SCHEME_hash_ptr);
ui->new_toplevels = ht;
}
v = scheme_hash_get(ui->new_toplevels, hv);
if (!v) {
int new_pos = ui->new_toplevel_offset + ui->new_toplevels->count;
v = scheme_make_toplevel(0, new_pos, 0, flags);
scheme_hash_set(ui->new_toplevels, hv, v);
if (mod_constant
&& ui->comp_prefix->inline_variants) {
if (SAME_TYPE(SCHEME_TYPE(mod_constant), scheme_inline_variant_type)) {
Scheme_Object *shiftable;
shiftable = scheme_make_vector(4, scheme_false);
SCHEME_VEC_ELS(shiftable)[0] = mod_constant;
SCHEME_VEC_ELS(shiftable)[1] = ui->from_modidx;
SCHEME_VEC_ELS(shiftable)[2] = ui->to_modidx;
SCHEME_VEC_ELS(shiftable)[3] = scheme_make_integer(mod_defn_phase);
mod_constant = shiftable;
} else if (SAME_TYPE(SCHEME_TYPE(mod_constant), scheme_struct_proc_shape_type)) {
/* keep it */
} else
mod_constant = NULL;
if (mod_constant) {
mod_constant = scheme_make_pair(scheme_make_pair(scheme_make_integer(new_pos),
mod_constant),
ui->inline_variants);
ui->inline_variants = mod_constant;
}
}
}
}
MZ_ASSERT(SAME_TYPE(SCHEME_TYPE(v), scheme_ir_toplevel_type));
}
} else {
/* If needed, shift top-level position to account for moving
lifts to toplevels. */
Scheme_Object *opos;
int pos;
pos = unresolve_toplevel_pos(SCHEME_TOPLEVEL_POS(rdata), ui);
opos = scheme_make_integer(pos);
@ -3116,6 +3245,7 @@ static Scheme_Object *unresolve_toplevel(Scheme_Object *rdata, Unresolve_Info *u
scheme_hash_set(ui->toplevels, opos, v);
}
LOG_UNRESOLVE(printf("flags for %d: %d\n", pos, SCHEME_TOPLEVEL_FLAGS(rdata) & SCHEME_TOPLEVEL_FLAGS_MASK));
}
ui->has_tl = 1;
@ -3186,9 +3316,7 @@ static Scheme_Object *unresolve_define_or_begin_syntaxes(int def, Scheme_Object
} else
names = NULL;
nui = new_unresolve_info(NULL, ui->comp_flags);
nui->inlining = 0;
nui->prefix = prefix;
nui = new_unresolve_info(prefix, ui->comp_flags);
nui->lift_to_local = 1;
dummy = unresolve_expr(dummy, ui, 0);
@ -3739,16 +3867,13 @@ Scheme_Object *unresolve_module(Scheme_Object *e, Unresolve_Info *ui_in)
Unresolve_Info *ui;
int i, cnt, len;
ui = new_unresolve_info(NULL, ui_in->comp_flags);
ui->inlining = 0;
ui = new_unresolve_info(m->prefix, ui_in->comp_flags);
ui->module = m;
cp = unresolve_prefix(m->prefix, ui);
if (!cp) return_NULL;
ui->comp_prefix = cp;
ui->prefix = m->prefix;
cnt = SCHEME_VEC_SIZE(m->bodies[0]);
bs = scheme_make_vector(cnt, NULL);
@ -4431,7 +4556,7 @@ static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui, int a
Scheme_Quote_Syntax *qs = (Scheme_Quote_Syntax *)e;
Scheme_Local *cqs;
if (!ui->prefix) return_NULL;
if (ui->inlining) return_NULL;
cqs = (Scheme_Local *)scheme_malloc_atomic_tagged(sizeof(Scheme_Local));
cqs->iso.so.type = scheme_ir_quote_syntax_type;
@ -4466,6 +4591,9 @@ static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui, int a
}
Scheme_Object *scheme_unresolve_top(Scheme_Object* o, Comp_Prefix **cp, int comp_flags)
/* Convert from "resolved" form back to the intermediate representation used
by the optimizer. Unresolving generates an intermediate-representation prefix
(for top levels and syntax literals) in addition to the code. */
{
Scheme_Compilation_Top *top = (Scheme_Compilation_Top *)o;
Scheme_Object *code = top->code, *defns;
@ -4474,9 +4602,7 @@ Scheme_Object *scheme_unresolve_top(Scheme_Object* o, Comp_Prefix **cp, int comp
Unresolve_Info *ui;
int len, i;
ui = new_unresolve_info(NULL, comp_flags);
ui->inlining = 0;
ui->prefix = rp;
ui = new_unresolve_info(rp, comp_flags);
c = unresolve_prefix(rp, ui);
ui->comp_prefix = c;
@ -4507,10 +4633,18 @@ Scheme_Object *scheme_unresolve_top(Scheme_Object* o, Comp_Prefix **cp, int comp
return code;
}
Scheme_Object *scheme_unresolve(Scheme_Object *iv, int argc, int *_has_cases)
Scheme_Object *scheme_unresolve(Scheme_Object *iv, int argc, int *_has_cases,
Comp_Prefix *cp, Scheme_Env *env, Scheme_Object *insp, intptr_t ref_phase,
Scheme_Object *from_modidx, Scheme_Object *to_modidx)
/* Convert a single function from "resolved" form back to the
intermediate representation used by the optimizer. Unresolving can
add new items to the intermediate-representation prefix for top levels. */
{
Scheme_Object *o;
Scheme_Lambda *lam = NULL;
Unresolve_Info *ui;
MZ_ASSERT(SAME_TYPE(SCHEME_TYPE(iv), scheme_inline_variant_type));
o = SCHEME_VEC_ELS(iv)[1];
@ -4545,12 +4679,44 @@ Scheme_Object *scheme_unresolve(Scheme_Object *iv, int argc, int *_has_cases)
if (!lam)
return_NULL;
if (lam->closure_size)
return_NULL;
ui = new_unresolve_info((Resolve_Prefix *)SCHEME_VEC_ELS(iv)[2], 0);
ui->inlining = 1;
ui->from_modidx = from_modidx;
ui->to_modidx = to_modidx;
ui->new_toplevel_offset = cp->num_toplevels;
ui->comp_prefix = cp;
ui->opt_env = env;
ui->opt_insp = insp;
ui->toplevel_ref_phase = ref_phase;
ui->inline_variants = scheme_null;
/* convert an optimized & resolved closure back to compiled form: */
return unresolve_lambda(lam,
new_unresolve_info((Scheme_Prefix *)SCHEME_VEC_ELS(iv)[2], 0));
o = unresolve_lambda(lam, ui);
if (o) {
/* Added any toplevels? */
if (ui->new_toplevels) {
int i;
Scheme_Object *l;
for (i = ui->new_toplevels->size; i--; ) {
if (ui->new_toplevels->vals[i]) {
scheme_hash_set(cp->toplevels,
ui->new_toplevels->keys[i],
ui->new_toplevels->vals[i]);
cp->num_toplevels++;
}
}
for (l = ui->inline_variants; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
scheme_hash_set(ui->comp_prefix->inline_variants,
SCHEME_CAR(SCHEME_CAR(l)),
SCHEME_CDR(SCHEME_CAR(l)));
}
}
}
return o;
}
/*========================================================================*/

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

@ -3274,7 +3274,9 @@ Scheme_Object *scheme_optimize_extract_tail_inside(Scheme_Object *t2);
Scheme_Object *scheme_resolve_expr(Scheme_Object *, Resolve_Info *);
Scheme_Object *scheme_resolve_list(Scheme_Object *, Resolve_Info *);
Scheme_Object *scheme_unresolve(Scheme_Object *, int argv, int *_has_cases);
Scheme_Object *scheme_unresolve(Scheme_Object *, int argv, int *_has_cases,
Comp_Prefix *cp, Scheme_Env *env, Scheme_Object *insp, intptr_t ref_phase,
Scheme_Object *from_modidx, Scheme_Object *to_modidx);
Scheme_Object *scheme_unresolve_top(Scheme_Object *, Comp_Prefix **, int comp_flags);
int scheme_check_leaf_rator(Scheme_Object *le, int *_flags);
@ -3294,7 +3296,7 @@ int scheme_resolve_info_use_jit(Resolve_Info *ri);
void scheme_enable_expression_resolve_lifts(Resolve_Info *ri);
Scheme_Object *scheme_merge_expression_resolve_lifts(Scheme_Object *expr, Resolve_Prefix *rp, Resolve_Info *ri);
Optimize_Info *scheme_optimize_info_create(Comp_Prefix *cp, int get_logger);
Optimize_Info *scheme_optimize_info_create(Comp_Prefix *cp, Scheme_Env *env, Scheme_Object *insp, int get_logger);
void scheme_optimize_info_enforce_const(Optimize_Info *, int enforce_const);
void scheme_optimize_info_set_context(Optimize_Info *, Scheme_Object *ctx);
void scheme_optimize_info_never_inline(Optimize_Info *);
@ -3518,7 +3520,7 @@ void scheme_install_binding_names(Scheme_Object *binding_namess, Scheme_Env *env
Scheme_Hash_Table *scheme_get_binding_names_table(Scheme_Env *env);
int scheme_prefix_depth(Resolve_Prefix *rp);
Scheme_Object **scheme_push_prefix(Scheme_Env *genv, Resolve_Prefix *rp,
Scheme_Object **scheme_push_prefix(Scheme_Env *genv, int already_linked, Resolve_Prefix *rp,
Scheme_Object *src_modix, Scheme_Object *now_modix,
int src_phase, int now_phase,
Scheme_Env *dummy_env, Scheme_Object *insp);
@ -3890,13 +3892,17 @@ int scheme_module_export_position(Scheme_Object *modname, Scheme_Env *env, Schem
Scheme_Module_Exports *scheme_make_module_exports();
Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object *in_modidx,
Scheme_Object *scheme_check_accessible_in_module_instance(Scheme_Env *env,
Scheme_Object *symbol, Scheme_Object *stx,
Scheme_Object *current_insp, Scheme_Object *binding_insp,
int position, int want_pos,
int *_protected, int *_unexported,
Scheme_Env *from_env, int *_would_complain,
Scheme_Object **_is_constant);
int scheme_check_accessible_in_module_name(Scheme_Object *modidx, intptr_t mod_phase, Scheme_Env *env,
Scheme_Object *symbol, int position,
Scheme_Object *current_insp, Scheme_Object *binding_insp,
Scheme_Object **_is_constant);
Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *name, int mod_phase);
Scheme_Object *scheme_modidx_shift(Scheme_Object *modidx,