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

fix bytecode compiler bugs in tracking known-flonum arguments

Browse Source
This commit is contained in:
Matthew Flatt 2010-11-12 15:26:45 -07:00
parent 0ac5ff9be0
commit 42a4465fb0
5 changed files with 68 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1363,6 +1363,25 @@
((proc 98)
x)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that an unboxable flonum argument
;; is not incorrectly inferred:
(test '(done)
'unboxing-inference-test
(let ()
(define (f x y)
(if (zero? y)
;; prevents inlining:
'(done)
(if (zero? y)
;; incorrectly triggered unboxing,
;; once upon a time:
(fl+ x 1.0)
;; not a float argument => no unboxing of x:
(f y (sub1 y)))))
(f 1.0 100)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

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

@ -2814,14 +2814,14 @@ static void register_flonum_argument_types(Scheme_App_Rec *app, Scheme_App2_Rec
if (!map) {
map = MALLOC_N_ATOMIC(char, n);
memset(map, 1, n);
memset(map, 0, i);
}
}
if (map && !is_flonum)
map[i] = 0;
}
if (map)
scheme_set_closure_flonum_map(data, map);
scheme_set_closure_flonum_map(data, map);
}
}
}

39
src/racket/src/fun.c
View File

@ -1143,12 +1143,41 @@ void scheme_set_closure_flonum_map(Scheme_Closure_Data *data, char *flonum_map)
cl->flonum_map = flonum_map;
}
for (i = data->num_params; i--; ) {
if (flonum_map[i]) break;
}
if (flonum_map) {
for (i = data->num_params; i--; ) {
if (flonum_map[i]) break;
}
if (i < 0) {
cl->flonum_map = NULL;
if (i < 0) {
cl->flonum_map = NULL;
}
}
}
void scheme_merge_closure_flonum_map(Scheme_Closure_Data *data1, Scheme_Closure_Data *data2)
{
Closure_Info *cl1 = (Closure_Info *)data1->closure_map;
Closure_Info *cl2 = (Closure_Info *)data2->closure_map;
if (cl1->has_flomap) {
if (!cl1->flonum_map || !cl2->has_flomap) {
cl2->has_flomap = 1;
cl2->flonum_map = cl1->flonum_map;
} else if (cl2->flonum_map) {
int i;
for (i = data1->num_params; i--; ) {
if (cl1->flonum_map[i] != cl2->flonum_map[i]) {
cl2->flonum_map = NULL;
cl1->flonum_map = NULL;
break;
}
}
} else {
cl1->flonum_map = NULL;
}
} else if (cl2->has_flomap) {
cl1->has_flomap = 1;
cl1->flonum_map = cl2->flonum_map;
}
}

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

@ -2548,6 +2548,7 @@ int scheme_optimize_is_flonum_valued(Optimize_Info *info, int pos);
int scheme_is_flonum_expression(Scheme_Object *expr, Optimize_Info *info);
char *scheme_get_closure_flonum_map(Scheme_Closure_Data *data, int arg_n, int *ok);
void scheme_set_closure_flonum_map(Scheme_Closure_Data *data, char *flonum_map);
void scheme_merge_closure_flonum_map(Scheme_Closure_Data *data1, Scheme_Closure_Data *data2);
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);

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

@ -3018,7 +3018,8 @@ static Scheme_Object *make_clones(Scheme_Compiled_Let_Value *retry_start,
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 set_flags, int mask_flags, int just_tentative,
int merge_flonum)
{
Scheme_Compiled_Let_Value *clv;
Scheme_Object *value, *first;
@ -3036,11 +3037,17 @@ static int set_code_flags(Scheme_Compiled_Let_Value *retry_start,
if (SAME_TYPE(scheme_compiled_unclosed_procedure_type, SCHEME_TYPE(value))) {
data = (Scheme_Closure_Data *)value;
first = SCHEME_CAR(clones);
if (merge_flonum) {
scheme_merge_closure_flonum_map(data, (Scheme_Closure_Data *)SCHEME_CAR(first));
scheme_merge_closure_flonum_map(data, (Scheme_Closure_Data *)SCHEME_CDR(first));
scheme_merge_closure_flonum_map(data, (Scheme_Closure_Data *)SCHEME_CAR(first));
}
if (!just_tentative || (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_RESULT_TENTATIVE)) {
flags = (flags & SCHEME_CLOSURE_DATA_FLAGS(data));
first = SCHEME_CAR(clones);
data = (Scheme_Closure_Data *)SCHEME_CDR(first);
SCHEME_CLOSURE_DATA_FLAGS(data) = set_flags | (SCHEME_CLOSURE_DATA_FLAGS(data) & mask_flags);
data = (Scheme_Closure_Data *)SCHEME_CAR(first);
@ -3611,6 +3618,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
(void)set_code_flags(retry_start, pre_body, clones,
CLOS_SINGLE_RESULT | CLOS_PRESERVES_MARKS | CLOS_RESULT_TENTATIVE,
0xFFFF,
0,
0);
/* Re-optimize loop: */
clv = retry_start;
@ -3690,11 +3698,12 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
clv = (Scheme_Compiled_Let_Value *)clv->body;
}
/* Check flags loop: */
flags = set_code_flags(retry_start, pre_body, clones, 0, 0xFFFF, 0);
flags = set_code_flags(retry_start, pre_body, clones, 0, 0xFFFF, 0, 0);
/* Reset-flags loop: */
(void)set_code_flags(retry_start, pre_body, clones,
(flags & (CLOS_SINGLE_RESULT | CLOS_PRESERVES_MARKS)),
~(CLOS_SINGLE_RESULT | CLOS_PRESERVES_MARKS | CLOS_RESULT_TENTATIVE),
1,
1);
}
retry_start = NULL;