From 42a4465fb0a795a696cae82e77bb2a3f3d350205 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 12 Nov 2010 15:26:45 -0700 Subject: [PATCH] fix bytecode compiler bugs in tracking known-flonum arguments --- collects/tests/racket/optimize.rktl | 19 +++++++++++++++ src/racket/src/eval.c | 4 ++-- src/racket/src/fun.c | 37 +++++++++++++++++++++++++---- src/racket/src/schpriv.h | 1 + src/racket/src/syntax.c | 17 +++++++++---- 5 files changed, 68 insertions(+), 10 deletions(-) diff --git a/collects/tests/racket/optimize.rktl b/collects/tests/racket/optimize.rktl index 7a588cad42..69cecde375 100644 --- a/collects/tests/racket/optimize.rktl +++ b/collects/tests/racket/optimize.rktl @@ -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) diff --git a/src/racket/src/eval.c b/src/racket/src/eval.c index 73e1bca4a7..537eeb4b6c 100644 --- a/src/racket/src/eval.c +++ b/src/racket/src/eval.c @@ -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); } } } diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c index 9f1b61a844..aea64cc386 100644 --- a/src/racket/src/fun.c +++ b/src/racket/src/fun.c @@ -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; } } diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 3073939415..86af9ddf4b 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -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); diff --git a/src/racket/src/syntax.c b/src/racket/src/syntax.c index 2d5b625a81..6acb9014ff 100644 --- a/src/racket/src/syntax.c +++ b/src/racket/src/syntax.c @@ -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; @@ -3035,12 +3036,18 @@ static int set_code_flags(Scheme_Compiled_Let_Value *retry_start, value = clv->value; 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;