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

fix optimizer bug related to `case-lambda' at module level

Browse Source 
The bug triggered a crash on ARM, and probably doesn't
affect other platforms, but I'm not competely sure.

Merge to 5.1.2
This commit is contained in:
Matthew Flatt 2011-07-19 15:06:58 -06:00
parent 9595145d79
commit d9ae1d048d
1 changed files with 57 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3227,18 +3227,63 @@ static Scheme_Object *make_clones(Scheme_Compiled_Let_Value *retry_start,
return first;
}
static int set_one_code_flags(Scheme_Object *value, int flags,
Scheme_Object *first, Scheme_Object *second,
int set_flags, int mask_flags, int just_tentative,
int merge_flonum)
{
Scheme_Case_Lambda *cl, *cl2, *cl3;
Scheme_Closure_Data *data, *data2, *data3;
int i, count;
if (SAME_TYPE(scheme_compiled_unclosed_procedure_type, SCHEME_TYPE(value))) {
count = 1;
cl = NULL;
cl2 = NULL;
cl3 = NULL;
} else {
cl = (Scheme_Case_Lambda *)value;
cl2 = (Scheme_Case_Lambda *)first;
cl3 = (Scheme_Case_Lambda *)second;
count = cl->count;
}
for (i = 0; i < count; i++) {
if (cl) {
data = (Scheme_Closure_Data *)cl->array[i];
data2 = (Scheme_Closure_Data *)cl2->array[i];
data3 = (Scheme_Closure_Data *)cl3->array[i];
} else {
data = (Scheme_Closure_Data *)value;
data2 = (Scheme_Closure_Data *)first;
data3 = (Scheme_Closure_Data *)second;
}
if (merge_flonum) {
merge_closure_flonum_map(data, data2);
merge_closure_flonum_map(data, data3);
merge_closure_flonum_map(data, data2);
}
if (!just_tentative || (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_RESULT_TENTATIVE)) {
flags = (flags & SCHEME_CLOSURE_DATA_FLAGS(data));
SCHEME_CLOSURE_DATA_FLAGS(data2) = set_flags | (SCHEME_CLOSURE_DATA_FLAGS(data2) & mask_flags);
SCHEME_CLOSURE_DATA_FLAGS(data3) = set_flags | (SCHEME_CLOSURE_DATA_FLAGS(data3) & mask_flags);
}
}
return flags;
}
static int set_code_flags(Scheme_Compiled_Let_Value *retry_start,
Scheme_Compiled_Let_Value *pre_body,
Scheme_Object *clones,
int set_flags, int mask_flags, int just_tentative,
int merge_flonum)
{
Scheme_Case_Lambda *cl, *cl2, *cl3;
Scheme_Compiled_Let_Value *clv;
Scheme_Object *value, *first;
int flags = CLOS_SINGLE_RESULT | CLOS_PRESERVES_MARKS;
Scheme_Closure_Data *data, *data2, *data3;
int i, count;
/* The first in a clone pair is the one that is consulted for
references. The second one is the clone, and it's the one whose
@ -3251,43 +3296,11 @@ static int set_code_flags(Scheme_Compiled_Let_Value *retry_start,
if (IS_COMPILED_PROC(value)) {
first = SCHEME_CAR(clones);
if (first) {
if (SAME_TYPE(scheme_compiled_unclosed_procedure_type, SCHEME_TYPE(value))) {
count = 1;
cl = NULL;
cl2 = NULL;
cl3 = NULL;
} else {
cl = (Scheme_Case_Lambda *)value;
cl2 = (Scheme_Case_Lambda *)SCHEME_CAR(first);
cl3 = (Scheme_Case_Lambda *)SCHEME_CDR(first);
count = cl->count;
}
for (i = 0; i < count; i++) {
if (cl) {
data = (Scheme_Closure_Data *)cl->array[i];
data2 = (Scheme_Closure_Data *)cl2->array[i];
data3 = (Scheme_Closure_Data *)cl3->array[i];
} else {
data = (Scheme_Closure_Data *)value;
data2 = (Scheme_Closure_Data *)SCHEME_CAR(first);
data3 = (Scheme_Closure_Data *)SCHEME_CDR(first);
}
if (merge_flonum) {
merge_closure_flonum_map(data, data2);
merge_closure_flonum_map(data, data3);
merge_closure_flonum_map(data, data2);
}
if (!just_tentative || (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_RESULT_TENTATIVE)) {
flags = (flags & SCHEME_CLOSURE_DATA_FLAGS(data));
SCHEME_CLOSURE_DATA_FLAGS(data2) = set_flags | (SCHEME_CLOSURE_DATA_FLAGS(data2) & mask_flags);
SCHEME_CLOSURE_DATA_FLAGS(data3) = set_flags | (SCHEME_CLOSURE_DATA_FLAGS(data3) & mask_flags);
}
}
}
if (first)
flags = set_one_code_flags(value, flags,
SCHEME_CAR(first), SCHEME_CDR(first),
set_flags, mask_flags, just_tentative,
merge_flonum);
clones = SCHEME_CDR(clones);
}
@ -4420,7 +4433,6 @@ static int set_code_closure_flags(Scheme_Object *clones,
int just_tentative)
{
Scheme_Object *clone, *orig, *first;
Scheme_Closure_Data *data;
int flags = CLOS_SINGLE_RESULT | CLOS_PRESERVES_MARKS;
/* The first in a clone pair is the one that is consulted for
@ -4433,13 +4445,10 @@ static int set_code_closure_flags(Scheme_Object *clones,
clone = SCHEME_CAR(first);
orig = SCHEME_CDR(first);
data = (Scheme_Closure_Data *)orig;
if (!just_tentative || (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_RESULT_TENTATIVE)) {
flags = (flags & SCHEME_CLOSURE_DATA_FLAGS(data));
SCHEME_CLOSURE_DATA_FLAGS(data) = set_flags | (SCHEME_CLOSURE_DATA_FLAGS(data) & mask_flags);
data = (Scheme_Closure_Data *)clone;
SCHEME_CLOSURE_DATA_FLAGS(data) = set_flags | (SCHEME_CLOSURE_DATA_FLAGS(data) & mask_flags);
}
flags = set_one_code_flags(orig, flags,
orig, clone,
set_flags, mask_flags, just_tentative,
0);
clones = SCHEME_CDR(clones);
}