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

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

@ -3227,31 +3227,15 @@ static Scheme_Object *make_clones(Scheme_Compiled_Let_Value *retry_start,
return first; return first;
} }
static int set_code_flags(Scheme_Compiled_Let_Value *retry_start, static int set_one_code_flags(Scheme_Object *value, int flags,
Scheme_Compiled_Let_Value *pre_body, Scheme_Object *first, Scheme_Object *second,
Scheme_Object *clones,
int set_flags, int mask_flags, int just_tentative, int set_flags, int mask_flags, int just_tentative,
int merge_flonum) int merge_flonum)
{ {
Scheme_Case_Lambda *cl, *cl2, *cl3; 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; Scheme_Closure_Data *data, *data2, *data3;
int i, count; 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
flags are updated by optimization. So consult the clone, and set
flags in both. */
clv = retry_start;
while (clones) {
value = clv->value;
if (IS_COMPILED_PROC(value)) {
first = SCHEME_CAR(clones);
if (first) {
if (SAME_TYPE(scheme_compiled_unclosed_procedure_type, SCHEME_TYPE(value))) { if (SAME_TYPE(scheme_compiled_unclosed_procedure_type, SCHEME_TYPE(value))) {
count = 1; count = 1;
cl = NULL; cl = NULL;
@ -3259,8 +3243,8 @@ static int set_code_flags(Scheme_Compiled_Let_Value *retry_start,
cl3 = NULL; cl3 = NULL;
} else { } else {
cl = (Scheme_Case_Lambda *)value; cl = (Scheme_Case_Lambda *)value;
cl2 = (Scheme_Case_Lambda *)SCHEME_CAR(first); cl2 = (Scheme_Case_Lambda *)first;
cl3 = (Scheme_Case_Lambda *)SCHEME_CDR(first); cl3 = (Scheme_Case_Lambda *)second;
count = cl->count; count = cl->count;
} }
@ -3271,8 +3255,8 @@ static int set_code_flags(Scheme_Compiled_Let_Value *retry_start,
data3 = (Scheme_Closure_Data *)cl3->array[i]; data3 = (Scheme_Closure_Data *)cl3->array[i];
} else { } else {
data = (Scheme_Closure_Data *)value; data = (Scheme_Closure_Data *)value;
data2 = (Scheme_Closure_Data *)SCHEME_CAR(first); data2 = (Scheme_Closure_Data *)first;
data3 = (Scheme_Closure_Data *)SCHEME_CDR(first); data3 = (Scheme_Closure_Data *)second;
} }
if (merge_flonum) { if (merge_flonum) {
@ -3287,7 +3271,36 @@ static int set_code_flags(Scheme_Compiled_Let_Value *retry_start,
SCHEME_CLOSURE_DATA_FLAGS(data3) = set_flags | (SCHEME_CLOSURE_DATA_FLAGS(data3) & 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_Compiled_Let_Value *clv;
Scheme_Object *value, *first;
int flags = CLOS_SINGLE_RESULT | CLOS_PRESERVES_MARKS;
/* 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
flags are updated by optimization. So consult the clone, and set
flags in both. */
clv = retry_start;
while (clones) {
value = clv->value;
if (IS_COMPILED_PROC(value)) {
first = SCHEME_CAR(clones);
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); clones = SCHEME_CDR(clones);
} }
@ -4420,7 +4433,6 @@ static int set_code_closure_flags(Scheme_Object *clones,
int just_tentative) int just_tentative)
{ {
Scheme_Object *clone, *orig, *first; Scheme_Object *clone, *orig, *first;
Scheme_Closure_Data *data;
int flags = CLOS_SINGLE_RESULT | CLOS_PRESERVES_MARKS; int flags = CLOS_SINGLE_RESULT | CLOS_PRESERVES_MARKS;
/* The first in a clone pair is the one that is consulted for /* 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); clone = SCHEME_CAR(first);
orig = SCHEME_CDR(first); orig = SCHEME_CDR(first);
data = (Scheme_Closure_Data *)orig; flags = set_one_code_flags(orig, flags,
if (!just_tentative || (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_RESULT_TENTATIVE)) { orig, clone,
flags = (flags & SCHEME_CLOSURE_DATA_FLAGS(data)); set_flags, mask_flags, just_tentative,
SCHEME_CLOSURE_DATA_FLAGS(data) = set_flags | (SCHEME_CLOSURE_DATA_FLAGS(data) & mask_flags); 0);
data = (Scheme_Closure_Data *)clone;
SCHEME_CLOSURE_DATA_FLAGS(data) = set_flags | (SCHEME_CLOSURE_DATA_FLAGS(data) & mask_flags);
}
clones = SCHEME_CDR(clones); clones = SCHEME_CDR(clones);
} }