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

fix bug in bytecode optimizer

Browse Source 
The bug is triggered by unsafe flonum operations, a
conversion that tries to make the arguments more unboxable,
and a `lambda' form within an argument to the unsafe
operation.

Closes PR 12587
This commit is contained in:
Matthew Flatt 2012-02-22 06:06:06 -07:00
parent c1759243d4
commit a025f7e9c8
3 changed files with 102 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1911,6 +1911,20 @@
(parameterize ([read-accept-compiled #t]) (parameterize ([read-accept-compiled #t])
(read (open-input-bytes (get-output-bytes o))))) (read (open-input-bytes (get-output-bytes o)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check compilation of an example that triggers
;; shifting of a closure's coordinates during
;; optimization without reoptimization:
(let ([ns (make-base-namespace)])
(parameterize ([current-namespace ns])
(namespace-require 'racket/unsafe/ops)
(compile '(lambda (a)
(unsafe-fl- a
(lambda ()
(set! a 'v)))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs) (report-errs)

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

@ -109,6 +109,9 @@ static void optimize_info_done(Optimize_Info *info, Optimize_Info *parent);
static Scheme_Object *estimate_closure_size(Scheme_Object *e); static Scheme_Object *estimate_closure_size(Scheme_Object *e);
static Scheme_Object *no_potential_size(Scheme_Object *value); static Scheme_Object *no_potential_size(Scheme_Object *value);
static Scheme_Object *optimize_clone(int dup_ok, Scheme_Object *obj, Optimize_Info *info, int delta, int closure_depth);
static Scheme_Object *optimize_shift(Scheme_Object *obj, int delta, int after_depth);
#define IS_COMPILED_PROC(vals_expr) (SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_compiled_unclosed_procedure_type) \ #define IS_COMPILED_PROC(vals_expr) (SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_compiled_unclosed_procedure_type) \
|| SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_case_lambda_sequence_type)) || SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_case_lambda_sequence_type))
@ -843,7 +846,7 @@ static Scheme_Object *apply_inlined(Scheme_Object *p, Scheme_Closure_Data *data,
val = app2->rand; val = app2->rand;
if (nested_count) if (nested_count)
val = scheme_optimize_shift(val, nested_count, 0); val = optimize_shift(val, nested_count, 0);
lv->value = val; lv->value = val;
flag = closure_argument_flags(data, i); flag = closure_argument_flags(data, i);
@ -1070,10 +1073,10 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
} else } else
sub_info = info; sub_info = info;
/* If scheme_optimize_clone succeeds, inlining succeeds. */ /* If optimize_clone succeeds, inlining succeeds. */
le = scheme_optimize_clone(single_use, data->code, sub_info, le = optimize_clone(single_use, data->code, sub_info,
offset + (outside_nested ? nested_count : 0), offset + (outside_nested ? nested_count : 0),
data->num_params); data->num_params);
if (le) { if (le) {
LOG_INLINE(fprintf(stderr, "Inline %d[%d]<=%d@%d %d %s\n", sz, is_leaf, threshold, info->inline_fuel, LOG_INLINE(fprintf(stderr, "Inline %d[%d]<=%d@%d %d %s\n", sz, is_leaf, threshold, info->inline_fuel,
@ -1330,7 +1333,7 @@ static Scheme_Object *check_app_let_rator(Scheme_Object *app, Scheme_Object *rat
&& scheme_is_compiled_procedure(clv->value, 1, 1)) { && scheme_is_compiled_procedure(clv->value, 1, 1)) {
reset_rator(app, scheme_false); reset_rator(app, scheme_false);
app = scheme_optimize_shift(app, 1, 0); app = optimize_shift(app, 1, 0);
reset_rator(app, scheme_make_local(scheme_local_type, 0, 0)); reset_rator(app, scheme_make_local(scheme_local_type, 0, 0));
clv->body = app; clv->body = app;
@ -1352,7 +1355,7 @@ static Scheme_Object *check_app_let_rator(Scheme_Object *app, Scheme_Object *rat
} }
reset_rator(app, scheme_false); reset_rator(app, scheme_false);
app = scheme_optimize_shift(app, head->count, 0); app = optimize_shift(app, head->count, 0);
reset_rator(app, rator); reset_rator(app, rator);
if (clv) if (clv)
@ -1732,7 +1735,7 @@ static Scheme_Object *check_unbox_rotation(Scheme_Object *_app, Scheme_Object *r
} else } else
((Scheme_App_Rec *)_app)->args[i + 1] = scheme_false; ((Scheme_App_Rec *)_app)->args[i + 1] = scheme_false;
_app = scheme_optimize_shift(_app, delta, 0); _app = optimize_shift(_app, delta, 0);
} }
if (count == 1) if (count == 1)
@ -2415,10 +2418,10 @@ Scheme_Object *scheme_optimize_apply_values(Scheme_Object *f, Scheme_Object *e,
If we can shift-clone it, then it will be back in the right If we can shift-clone it, then it will be back in the right
coordinates. */ coordinates. */
cloned = scheme_optimize_clone(1, e, info, 0, 0); cloned = optimize_clone(1, e, info, 0, 0);
if (cloned) { if (cloned) {
if (SAME_TYPE(SCHEME_TYPE(f_is_proc), scheme_compiled_unclosed_procedure_type)) if (SAME_TYPE(SCHEME_TYPE(f_is_proc), scheme_compiled_unclosed_procedure_type))
f_cloned = scheme_optimize_clone(1, f_is_proc, info, 0, 0); f_cloned = optimize_clone(1, f_is_proc, info, 0, 0);
else { else {
/* Otherwise, no clone is needed; in the case of a lexical /* Otherwise, no clone is needed; in the case of a lexical
variable, we already reversed it. */ variable, we already reversed it. */
@ -2789,10 +2792,10 @@ set_clone(int dup_ok, Scheme_Object *data, Optimize_Info *info, int delta, int c
var = naya->var; var = naya->var;
val = naya->val; val = naya->val;
val = scheme_optimize_clone(dup_ok, val, info, delta, closure_depth); val = optimize_clone(dup_ok, val, info, delta, closure_depth);
if (!val) return NULL; if (!val) return NULL;
if (SAME_TYPE(SCHEME_TYPE(var), scheme_local_type)) { if (SAME_TYPE(SCHEME_TYPE(var), scheme_local_type)) {
var = scheme_optimize_clone(dup_ok, var, info, delta, closure_depth); var = optimize_clone(dup_ok, var, info, delta, closure_depth);
if (!var) return NULL; if (!var) return NULL;
} }
@ -2807,10 +2810,10 @@ static Scheme_Object *set_shift(Scheme_Object *data, int delta, int after_depth)
Scheme_Set_Bang *sb = (Scheme_Set_Bang *)data; Scheme_Set_Bang *sb = (Scheme_Set_Bang *)data;
Scheme_Object *e; Scheme_Object *e;
e = scheme_optimize_shift(sb->var, delta, after_depth); e = optimize_shift(sb->var, delta, after_depth);
sb->var = e; sb->var = e;
e = scheme_optimize_shift(sb->val, delta, after_depth); e = optimize_shift(sb->val, delta, after_depth);
sb->val = e; sb->val = e;
return (Scheme_Object *)sb; return (Scheme_Object *)sb;
@ -2842,10 +2845,10 @@ ref_shift(Scheme_Object *data, int delta, int after_depth)
{ {
Scheme_Object *v; Scheme_Object *v;
v = scheme_optimize_shift(SCHEME_PTR1_VAL(data), delta, after_depth); v = optimize_shift(SCHEME_PTR1_VAL(data), delta, after_depth);
SCHEME_PTR1_VAL(data) = v; SCHEME_PTR1_VAL(data) = v;
v = scheme_optimize_shift(SCHEME_PTR2_VAL(data), delta, after_depth); v = optimize_shift(SCHEME_PTR2_VAL(data), delta, after_depth);
SCHEME_PTR2_VAL(data) = v; SCHEME_PTR2_VAL(data) = v;
return data; return data;
@ -2858,11 +2861,11 @@ ref_clone(int dup_ok, Scheme_Object *data, Optimize_Info *info, int delta, int c
Scheme_Object *a, *b; Scheme_Object *a, *b;
a = SCHEME_PTR1_VAL(data); a = SCHEME_PTR1_VAL(data);
a = scheme_optimize_clone(dup_ok, a, info, delta, closure_depth); a = optimize_clone(dup_ok, a, info, delta, closure_depth);
if (!a) return NULL; if (!a) return NULL;
b = SCHEME_PTR2_VAL(data); b = SCHEME_PTR2_VAL(data);
b = scheme_optimize_clone(dup_ok, a, info, delta, closure_depth); b = optimize_clone(dup_ok, a, info, delta, closure_depth);
if (!b) return NULL; if (!b) return NULL;
naya = scheme_alloc_object(); naya = scheme_alloc_object();
@ -2895,10 +2898,10 @@ apply_values_shift(Scheme_Object *data, int delta, int after_depth)
{ {
Scheme_Object *e; Scheme_Object *e;
e = scheme_optimize_shift(SCHEME_PTR1_VAL(data), delta, after_depth); e = optimize_shift(SCHEME_PTR1_VAL(data), delta, after_depth);
SCHEME_PTR1_VAL(data) = e; SCHEME_PTR1_VAL(data) = e;
e = scheme_optimize_shift(SCHEME_PTR2_VAL(data), delta, after_depth); e = optimize_shift(SCHEME_PTR2_VAL(data), delta, after_depth);
SCHEME_PTR2_VAL(data) = e; SCHEME_PTR2_VAL(data) = e;
return data; return data;
@ -2912,9 +2915,9 @@ apply_values_clone(int dup_ok, Scheme_Object *data, Optimize_Info *info, int del
f = SCHEME_PTR1_VAL(data); f = SCHEME_PTR1_VAL(data);
e = SCHEME_PTR2_VAL(data); e = SCHEME_PTR2_VAL(data);
f = scheme_optimize_clone(dup_ok, f, info, delta, closure_depth); f = optimize_clone(dup_ok, f, info, delta, closure_depth);
if (!f) return NULL; if (!f) return NULL;
e = scheme_optimize_clone(dup_ok, e, info, delta, closure_depth); e = optimize_clone(dup_ok, e, info, delta, closure_depth);
if (!e) return NULL; if (!e) return NULL;
data = scheme_alloc_object(); data = scheme_alloc_object();
@ -2995,7 +2998,7 @@ case_lambda_clone(int dup_ok, Scheme_Object *data, Optimize_Info *info, int delt
for (i = 0; i < seq->count; i++) { for (i = 0; i < seq->count; i++) {
le = seq->array[i]; le = seq->array[i];
le = scheme_optimize_clone(dup_ok, le, info, delta, closure_depth); le = optimize_clone(dup_ok, le, info, delta, closure_depth);
if (!le) return NULL; if (!le) return NULL;
seq2->array[i] = le; seq2->array[i] = le;
} }
@ -3012,7 +3015,7 @@ case_lambda_shift(Scheme_Object *data, int delta, int after_depth)
for (i = 0; i < seq->count; i++) { for (i = 0; i < seq->count; i++) {
le = seq->array[i]; le = seq->array[i];
le = scheme_optimize_shift(le, delta, after_depth); le = optimize_shift(le, delta, after_depth);
seq->array[i] = le; seq->array[i] = le;
} }
@ -3323,7 +3326,7 @@ static Scheme_Object *make_clones(Scheme_Compiled_Let_Value *retry_start,
while (1) { while (1) {
value = clv->value; value = clv->value;
if (IS_COMPILED_PROC(value)) { if (IS_COMPILED_PROC(value)) {
clone = scheme_optimize_clone(1, value, body_info, 0, 0); clone = optimize_clone(1, value, body_info, 0, 0);
if (clone) { if (clone) {
pr = scheme_make_raw_pair(scheme_make_raw_pair(value, clone), NULL); pr = scheme_make_raw_pair(scheme_make_raw_pair(value, clone), NULL);
} else } else
@ -3578,7 +3581,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
value = clv->body; /* = P */ value = clv->body; /* = P */
if (lh->count) if (lh->count)
value = scheme_optimize_shift(value, lh->count, head->count); value = optimize_shift(value, lh->count, head->count);
if (value) { if (value) {
clv->body = value; clv->body = value;
@ -4269,7 +4272,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
} }
if (value) { if (value) {
value = scheme_optimize_clone(1, value, rhs_info, 0, 0); value = optimize_clone(1, value, rhs_info, 0, 0);
if (value) { if (value) {
sub_info = optimize_info_add_frame(info, post_bind ? 0 : extract_depth, 0, 0); sub_info = optimize_info_add_frame(info, post_bind ? 0 : extract_depth, 0, 0);
@ -4465,7 +4468,7 @@ static Scheme_Object *clone_closure_compilation(int dup_ok, Scheme_Object *_data
data = (Scheme_Closure_Data *)_data; data = (Scheme_Closure_Data *)_data;
body = scheme_optimize_clone(dup_ok, data->code, info, delta, closure_depth + data->num_params); body = optimize_clone(dup_ok, data->code, info, delta, closure_depth + data->num_params);
if (!body) return NULL; if (!body) return NULL;
data2 = MALLOC_ONE_TAGGED(Scheme_Closure_Data); data2 = MALLOC_ONE_TAGGED(Scheme_Closure_Data);
@ -4499,10 +4502,30 @@ static Scheme_Object *shift_closure_compilation(Scheme_Object *_data, int delta,
{ {
Scheme_Object *expr; Scheme_Object *expr;
Scheme_Closure_Data *data = (Scheme_Closure_Data *)_data; Scheme_Closure_Data *data = (Scheme_Closure_Data *)_data;
Closure_Info *cl;
int i, sz;
mzshort *naya;
expr = scheme_optimize_shift(data->code, delta, after_depth + data->num_params); after_depth += data->num_params;
expr = optimize_shift(data->code, delta, after_depth);
data->code = expr; data->code = expr;
/* In case the result is not going to be re-optimized, we need
to update base_closure_map. */
sz = data->closure_size;
cl = (Closure_Info *)data->closure_map;
naya = MALLOC_N_ATOMIC(mzshort, sz);
for (i = 0; i < sz; i++) {
naya[i] = cl->base_closure_map[i];
if (naya[i] >= after_depth)
naya[i] += delta;
}
cl->base_closure_map = naya;
return _data; return _data;
} }
@ -4579,7 +4602,7 @@ static Scheme_Object *is_cross_module_inline_candidiate(Scheme_Object *e, Optimi
{ {
if (IS_COMPILED_PROC(e)) { if (IS_COMPILED_PROC(e)) {
if (size_override || (compiled_proc_body_size(e, 1) < CROSS_MODULE_INLINE_SIZE)) if (size_override || (compiled_proc_body_size(e, 1) < CROSS_MODULE_INLINE_SIZE))
return scheme_optimize_clone(0, e, info, 0, 0); return optimize_clone(0, e, info, 0, 0);
} }
return NULL; return NULL;
@ -4743,7 +4766,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
if (sproc) { if (sproc) {
e2 = scheme_make_noninline_proc(e); e2 = scheme_make_noninline_proc(e);
} else if (IS_COMPILED_PROC(e)) { } else if (IS_COMPILED_PROC(e)) {
e2 = scheme_optimize_clone(1, e, info, 0, 0); e2 = optimize_clone(1, e, info, 0, 0);
if (e2) { if (e2) {
Scheme_Object *pr; Scheme_Object *pr;
pr = scheme_make_raw_pair(scheme_make_raw_pair(e2, e), NULL); pr = scheme_make_raw_pair(scheme_make_raw_pair(e2, e), NULL);
@ -5067,7 +5090,7 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
&& single_valued_noncm_expression(o->expr, 5)) && single_valued_noncm_expression(o->expr, 5))
|| ((o->vclock != info->vclock) || ((o->vclock != info->vclock)
&& movable_expression(o->expr, info, o->delta, o->cross_lambda, 0, 5))) { && movable_expression(o->expr, info, o->delta, o->cross_lambda, 0, 5))) {
val = scheme_optimize_clone(1, o->expr, info, o->delta, 0); val = optimize_clone(1, o->expr, info, o->delta, 0);
if (val) { if (val) {
info->size -= 1; info->size -= 1;
o->used = 1; o->used = 1;
@ -5190,7 +5213,7 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
} }
} }
Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_Info *info, int delta, int closure_depth) Scheme_Object *optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_Info *info, int delta, int closure_depth)
/* Past closure_depth, need to reverse optimize to unoptimized with respect to info; /* Past closure_depth, need to reverse optimize to unoptimized with respect to info;
delta is the amount to skip in info to get to the frame that bound the code. delta is the amount to skip in info to get to the frame that bound the code.
If dup_ok is 1, then the old copy will be dropped, so it's ok to "duplicate" If dup_ok is 1, then the old copy will be dropped, so it's ok to "duplicate"
@ -5218,11 +5241,11 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
app2 = MALLOC_ONE_TAGGED(Scheme_App2_Rec); app2 = MALLOC_ONE_TAGGED(Scheme_App2_Rec);
app2->iso.so.type = scheme_application2_type; app2->iso.so.type = scheme_application2_type;
expr = scheme_optimize_clone(dup_ok, app->rator, info, delta, closure_depth); expr = optimize_clone(dup_ok, app->rator, info, delta, closure_depth);
if (!expr) return NULL; if (!expr) return NULL;
app2->rator = expr; app2->rator = expr;
expr = scheme_optimize_clone(dup_ok, app->rand, info, delta, closure_depth); expr = optimize_clone(dup_ok, app->rand, info, delta, closure_depth);
if (!expr) return NULL; if (!expr) return NULL;
app2->rand = expr; app2->rand = expr;
@ -5236,7 +5259,7 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
app2 = scheme_malloc_application(app->num_args + 1); app2 = scheme_malloc_application(app->num_args + 1);
for (i = app->num_args + 1; i--; ) { for (i = app->num_args + 1; i--; ) {
expr = scheme_optimize_clone(dup_ok, app->args[i], info, delta, closure_depth); expr = optimize_clone(dup_ok, app->args[i], info, delta, closure_depth);
if (!expr) return NULL; if (!expr) return NULL;
app2->args[i] = expr; app2->args[i] = expr;
} }
@ -5250,15 +5273,15 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
app2 = MALLOC_ONE_TAGGED(Scheme_App3_Rec); app2 = MALLOC_ONE_TAGGED(Scheme_App3_Rec);
app2->iso.so.type = scheme_application3_type; app2->iso.so.type = scheme_application3_type;
expr = scheme_optimize_clone(dup_ok, app->rator, info, delta, closure_depth); expr = optimize_clone(dup_ok, app->rator, info, delta, closure_depth);
if (!expr) return NULL; if (!expr) return NULL;
app2->rator = expr; app2->rator = expr;
expr = scheme_optimize_clone(dup_ok, app->rand1, info, delta, closure_depth); expr = optimize_clone(dup_ok, app->rand1, info, delta, closure_depth);
if (!expr) return NULL; if (!expr) return NULL;
app2->rand1 = expr; app2->rand1 = expr;
expr = scheme_optimize_clone(dup_ok, app->rand2, info, delta, closure_depth); expr = optimize_clone(dup_ok, app->rand2, info, delta, closure_depth);
if (!expr) return NULL; if (!expr) return NULL;
app2->rand2 = expr; app2->rand2 = expr;
@ -5294,7 +5317,7 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
lv2->position = lv->position; lv2->position = lv->position;
lv2->flags = flags; lv2->flags = flags;
expr = scheme_optimize_clone(dup_ok, lv->value, info, delta, expr = optimize_clone(dup_ok, lv->value, info, delta,
closure_depth + (post_bind ? 0 : head->count)); closure_depth + (post_bind ? 0 : head->count));
if (!expr) return NULL; if (!expr) return NULL;
lv2->value = expr; lv2->value = expr;
@ -5312,7 +5335,7 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
else else
head2->body = body; head2->body = body;
expr = scheme_optimize_clone(dup_ok, body, info, delta, closure_depth + head->count); expr = optimize_clone(dup_ok, body, info, delta, closure_depth + head->count);
if (!expr) return NULL; if (!expr) return NULL;
if (prev) if (prev)
@ -5334,7 +5357,7 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
seq2->count = seq->count; seq2->count = seq->count;
for (i = seq->count; i--; ) { for (i = seq->count; i--; ) {
expr = scheme_optimize_clone(dup_ok, seq->array[i], info, delta, closure_depth); expr = optimize_clone(dup_ok, seq->array[i], info, delta, closure_depth);
if (!expr) return NULL; if (!expr) return NULL;
seq2->array[i] = expr; seq2->array[i] = expr;
} }
@ -5348,15 +5371,15 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
b2 = MALLOC_ONE_TAGGED(Scheme_Branch_Rec); b2 = MALLOC_ONE_TAGGED(Scheme_Branch_Rec);
b2->so.type = scheme_branch_type; b2->so.type = scheme_branch_type;
expr = scheme_optimize_clone(dup_ok, b->test, info, delta, closure_depth); expr = optimize_clone(dup_ok, b->test, info, delta, closure_depth);
if (!expr) return NULL; if (!expr) return NULL;
b2->test = expr; b2->test = expr;
expr = scheme_optimize_clone(dup_ok, b->tbranch, info, delta, closure_depth); expr = optimize_clone(dup_ok, b->tbranch, info, delta, closure_depth);
if (!expr) return NULL; if (!expr) return NULL;
b2->tbranch = expr; b2->tbranch = expr;
expr = scheme_optimize_clone(dup_ok, b->fbranch, info, delta, closure_depth); expr = optimize_clone(dup_ok, b->fbranch, info, delta, closure_depth);
if (!expr) return NULL; if (!expr) return NULL;
b2->fbranch = expr; b2->fbranch = expr;
@ -5369,15 +5392,15 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
wcm2 = MALLOC_ONE_TAGGED(Scheme_With_Continuation_Mark); wcm2 = MALLOC_ONE_TAGGED(Scheme_With_Continuation_Mark);
wcm2->so.type = scheme_with_cont_mark_type; wcm2->so.type = scheme_with_cont_mark_type;
expr = scheme_optimize_clone(dup_ok, wcm->key, info, delta, closure_depth); expr = optimize_clone(dup_ok, wcm->key, info, delta, closure_depth);
if (!expr) return NULL; if (!expr) return NULL;
wcm2->key = expr; wcm2->key = expr;
expr = scheme_optimize_clone(dup_ok, wcm->val, info, delta, closure_depth); expr = optimize_clone(dup_ok, wcm->val, info, delta, closure_depth);
if (!expr) return NULL; if (!expr) return NULL;
wcm2->val = expr; wcm2->val = expr;
expr = scheme_optimize_clone(dup_ok, wcm->body, info, delta, closure_depth); expr = optimize_clone(dup_ok, wcm->body, info, delta, closure_depth);
if (!expr) return NULL; if (!expr) return NULL;
wcm2->body = expr; wcm2->body = expr;
@ -5415,7 +5438,7 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
return NULL; return NULL;
} }
Scheme_Object *scheme_optimize_shift(Scheme_Object *expr, int delta, int after_depth) Scheme_Object *optimize_shift(Scheme_Object *expr, int delta, int after_depth)
/* Shift lexical addresses deeper by delta if already deeper than after_depth; /* Shift lexical addresses deeper by delta if already deeper than after_depth;
can mutate. */ can mutate. */
{ {
@ -5441,7 +5464,7 @@ Scheme_Object *scheme_optimize_shift(Scheme_Object *expr, int delta, int after_d
int i; int i;
for (i = app->num_args + 1; i--; ) { for (i = app->num_args + 1; i--; ) {
expr = scheme_optimize_shift(app->args[i], delta, after_depth); expr = optimize_shift(app->args[i], delta, after_depth);
app->args[i] = expr; app->args[i] = expr;
} }
@ -5451,10 +5474,10 @@ Scheme_Object *scheme_optimize_shift(Scheme_Object *expr, int delta, int after_d
{ {
Scheme_App2_Rec *app = (Scheme_App2_Rec *)expr; Scheme_App2_Rec *app = (Scheme_App2_Rec *)expr;
expr = scheme_optimize_shift(app->rator, delta, after_depth); expr = optimize_shift(app->rator, delta, after_depth);
app->rator = expr; app->rator = expr;
expr = scheme_optimize_shift(app->rand, delta, after_depth); expr = optimize_shift(app->rand, delta, after_depth);
app->rand = expr; app->rand = expr;
return (Scheme_Object *)app; return (Scheme_Object *)app;
@ -5463,13 +5486,13 @@ Scheme_Object *scheme_optimize_shift(Scheme_Object *expr, int delta, int after_d
{ {
Scheme_App3_Rec *app = (Scheme_App3_Rec *)expr; Scheme_App3_Rec *app = (Scheme_App3_Rec *)expr;
expr = scheme_optimize_shift(app->rator, delta, after_depth); expr = optimize_shift(app->rator, delta, after_depth);
app->rator = expr; app->rator = expr;
expr = scheme_optimize_shift(app->rand1, delta, after_depth); expr = optimize_shift(app->rand1, delta, after_depth);
app->rand1 = expr; app->rand1 = expr;
expr = scheme_optimize_shift(app->rand2, delta, after_depth); expr = optimize_shift(app->rand2, delta, after_depth);
app->rand2 = expr; app->rand2 = expr;
return (Scheme_Object *)app; return (Scheme_Object *)app;
@ -5487,12 +5510,12 @@ Scheme_Object *scheme_optimize_shift(Scheme_Object *expr, int delta, int after_d
for (i = head->num_clauses; i--; ) { for (i = head->num_clauses; i--; ) {
lv = (Scheme_Compiled_Let_Value *)body; lv = (Scheme_Compiled_Let_Value *)body;
expr = scheme_optimize_shift(lv->value, delta, after_depth + (post_bind ? 0 : head->count)); expr = optimize_shift(lv->value, delta, after_depth + (post_bind ? 0 : head->count));
lv->value = expr; lv->value = expr;
body = lv->body; body = lv->body;
} }
expr = scheme_optimize_shift(body, delta, after_depth + head->count); expr = optimize_shift(body, delta, after_depth + head->count);
if (head->num_clauses) if (head->num_clauses)
lv->body = expr; lv->body = expr;
@ -5509,7 +5532,7 @@ Scheme_Object *scheme_optimize_shift(Scheme_Object *expr, int delta, int after_d
int i; int i;
for (i = seq->count; i--; ) { for (i = seq->count; i--; ) {
expr = scheme_optimize_shift(seq->array[i], delta, after_depth); expr = optimize_shift(seq->array[i], delta, after_depth);
seq->array[i] = expr; seq->array[i] = expr;
} }
@ -5519,13 +5542,13 @@ Scheme_Object *scheme_optimize_shift(Scheme_Object *expr, int delta, int after_d
{ {
Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)expr; Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)expr;
expr = scheme_optimize_shift(b->test, delta, after_depth); expr = optimize_shift(b->test, delta, after_depth);
b->test = expr; b->test = expr;
expr = scheme_optimize_shift(b->tbranch, delta, after_depth); expr = optimize_shift(b->tbranch, delta, after_depth);
b->tbranch = expr; b->tbranch = expr;
expr = scheme_optimize_shift(b->fbranch, delta, after_depth); expr = optimize_shift(b->fbranch, delta, after_depth);
b->fbranch = expr; b->fbranch = expr;
return (Scheme_Object *)b; return (Scheme_Object *)b;
@ -5534,13 +5557,13 @@ Scheme_Object *scheme_optimize_shift(Scheme_Object *expr, int delta, int after_d
{ {
Scheme_With_Continuation_Mark *wcm = (Scheme_With_Continuation_Mark *)expr; Scheme_With_Continuation_Mark *wcm = (Scheme_With_Continuation_Mark *)expr;
expr = scheme_optimize_shift(wcm->key, delta, after_depth); expr = optimize_shift(wcm->key, delta, after_depth);
wcm->key = expr; wcm->key = expr;
expr = scheme_optimize_shift(wcm->val, delta, after_depth); expr = optimize_shift(wcm->val, delta, after_depth);
wcm->val = expr; wcm->val = expr;
expr = scheme_optimize_shift(wcm->body, delta, after_depth); expr = optimize_shift(wcm->body, delta, after_depth);
wcm->body = expr; wcm->body = expr;
return (Scheme_Object *)wcm; return (Scheme_Object *)wcm;
@ -5564,7 +5587,7 @@ Scheme_Object *scheme_optimize_shift(Scheme_Object *expr, int delta, int after_d
case scheme_begin_for_syntax_type: case scheme_begin_for_syntax_type:
case scheme_require_form_type: case scheme_require_form_type:
case scheme_module_type: case scheme_module_type:
scheme_signal_error("scheme_optimize_shift: no shift available for %d", SCHEME_TYPE(expr)); scheme_signal_error("optimize_shift: no shift available for %d", SCHEME_TYPE(expr));
return NULL; return NULL;
default: default:
return expr; return expr;

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

@ -2646,9 +2646,6 @@ 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_set_context(Optimize_Info *, Scheme_Object *ctx);
void scheme_optimize_info_never_inline(Optimize_Info *); void scheme_optimize_info_never_inline(Optimize_Info *);
Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *obj, Optimize_Info *info, int delta, int closure_depth);
Scheme_Object *scheme_optimize_shift(Scheme_Object *obj, int delta, int after_depth);
Scheme_Object *scheme_toplevel_to_flagged_toplevel(Scheme_Object *tl, int flags); Scheme_Object *scheme_toplevel_to_flagged_toplevel(Scheme_Object *tl, int flags);
int scheme_wants_flonum_arguments(Scheme_Object *rator, int argpos, int rotate_mode); int scheme_wants_flonum_arguments(Scheme_Object *rator, int argpos, int rotate_mode);