From a86b851f74441bf2e996cc7c0a8f33094b2c4afb Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 18 Mar 2014 09:05:01 -0600 Subject: [PATCH] fix compiler--validator mismatch on bitwise specializations --- .../racket-test/tests/racket/optimize.rktl | 17 ++++++ racket/src/racket/src/number.c | 13 +++++ racket/src/racket/src/optimize.c | 57 ++++++++++++------- racket/src/racket/src/schpriv.h | 4 ++ racket/src/racket/src/schvers.h | 4 +- 5 files changed, 73 insertions(+), 22 deletions(-) diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl index bd7ddbb5bb..4ad749b545 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl @@ -3390,6 +3390,23 @@ 5) (void))))) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Check that bytecode validator is consistent with respect to the +;; optimizer and special-casing of bitwise operators: + +(let ([o (open-output-bytes)]) + (write (compile + #'(module function racket/base + (lambda (x) + (let ([v (bitwise-xor 0 + (let ([v (random)]) + (begin + (bitwise-and x 2))))]) + (list (bitwise-and v 2) v))))) + o) + (eval (parameterize ([read-accept-compiled #t]) + (read (open-input-bytes (get-output-bytes o)))))) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (report-errs) diff --git a/racket/src/racket/src/number.c b/racket/src/racket/src/number.c index 7d1d6bb482..21ca40ce84 100644 --- a/racket/src/racket/src/number.c +++ b/racket/src/racket/src/number.c @@ -221,6 +221,11 @@ static Scheme_Object *exact_to_extfl(int argc, Scheme_Object *argv[]); #endif /* globals */ +READ_ONLY Scheme_Object *scheme_unsafe_fxand_proc; +READ_ONLY Scheme_Object *scheme_unsafe_fxior_proc; +READ_ONLY Scheme_Object *scheme_unsafe_fxxor_proc; +READ_ONLY Scheme_Object *scheme_unsafe_fxrshift_proc; + READ_ONLY double scheme_infinity_val; READ_ONLY double scheme_minus_infinity_val; READ_ONLY double scheme_floating_point_zero = 0.0; @@ -1287,18 +1292,24 @@ void scheme_init_unsafe_number(Scheme_Env *env) | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL | SCHEME_PRIM_PRODUCES_FIXNUM); scheme_add_global_constant("unsafe-fxand", p, env); + REGISTER_SO(scheme_unsafe_fxand_proc); + scheme_unsafe_fxand_proc = p; p = scheme_make_folding_prim(unsafe_fx_or, "unsafe-fxior", 2, 2, 1); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL | SCHEME_PRIM_PRODUCES_FIXNUM); scheme_add_global_constant("unsafe-fxior", p, env); + REGISTER_SO(scheme_unsafe_fxior_proc); + scheme_unsafe_fxior_proc = p; p = scheme_make_folding_prim(unsafe_fx_xor, "unsafe-fxxor", 2, 2, 1); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL | SCHEME_PRIM_PRODUCES_FIXNUM); scheme_add_global_constant("unsafe-fxxor", p, env); + REGISTER_SO(scheme_unsafe_fxxor_proc); + scheme_unsafe_fxxor_proc = p; p = scheme_make_folding_prim(unsafe_fx_not, "unsafe-fxnot", 1, 1, 1); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED @@ -1317,6 +1328,8 @@ void scheme_init_unsafe_number(Scheme_Env *env) | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL | SCHEME_PRIM_PRODUCES_FIXNUM); scheme_add_global_constant("unsafe-fxrshift", p, env); + REGISTER_SO(scheme_unsafe_fxrshift_proc); + scheme_unsafe_fxrshift_proc = p; p = scheme_make_folding_prim(unsafe_fx_to_fl, "unsafe-fx->fl", 1, 1, 1); if (scheme_can_inline_fp_op()) diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index 950e07f7fa..384a44474e 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -1961,7 +1961,9 @@ static int produces_local_type(Scheme_Object *rator, int argc) } static int expr_produces_local_type(Scheme_Object *expr, int fuel) -/* can be called by the JIT */ +/* can be called by the JIT; beware that the validator must be + able to reconstruct the result in a shallow way, so don't + make the result of a function call depend on its arguments */ { if (fuel <= 0) return 0; @@ -1983,26 +1985,19 @@ static int expr_produces_local_type(Scheme_Object *expr, int fuel) { Scheme_App3_Rec *app = (Scheme_App3_Rec *)expr; - if (SCHEME_PRIMP(app->rator) - && (SCHEME_PRIM_PROC_OPT_FLAGS(app->rator) & SCHEME_PRIM_IS_BINARY_INLINED)) { - /* Recognize combinations of bitwise operations as generating fixnums */ - if (IS_NAMED_PRIM(app->rator, "bitwise-and")) { - if ((expr_produces_local_type(app->rand1, fuel-1) == SCHEME_LOCAL_TYPE_FIXNUM) - || (expr_produces_local_type(app->rand2, fuel-1) == SCHEME_LOCAL_TYPE_FIXNUM)) - return SCHEME_LOCAL_TYPE_FIXNUM; - } else if (IS_NAMED_PRIM(app->rator, "bitwise-ior") - || IS_NAMED_PRIM(app->rator, "bitwise-xor")) { - if ((expr_produces_local_type(app->rand1, fuel-1) == SCHEME_LOCAL_TYPE_FIXNUM) - && (expr_produces_local_type(app->rand2, fuel-1) == SCHEME_LOCAL_TYPE_FIXNUM)) - return SCHEME_LOCAL_TYPE_FIXNUM; - } else if (IS_NAMED_PRIM(app->rator, "arithmetic-shift")) { - if (SCHEME_INTP(app->rand2) && (SCHEME_INT_VAL(app->rand2) <= 0) - && (expr_produces_local_type(app->rand1, fuel-1) == SCHEME_LOCAL_TYPE_FIXNUM)) - return SCHEME_LOCAL_TYPE_FIXNUM; - } + && (SCHEME_PRIM_PROC_OPT_FLAGS(app->rator) & SCHEME_PRIM_IS_BINARY_INLINED) + && IS_NAMED_PRIM(app->rator, "bitwise-and")) { + /* Assume that a fixnum argument to bitwise-and will never get lost, + and so the validator will be able to confirm that a `bitwise-and` + combination produces a fixnum. */ + if ((SCHEME_INTP(app->rand1) + && IN_FIXNUM_RANGE_ON_ALL_PLATFORMS(SCHEME_INT_VAL(app->rand1))) + || (SCHEME_INTP(app->rand2) + && IN_FIXNUM_RANGE_ON_ALL_PLATFORMS(SCHEME_INT_VAL(app->rand2)))) + return SCHEME_LOCAL_TYPE_FIXNUM; } - + return produces_local_type(app->rator, 2); } break; @@ -2038,7 +2033,7 @@ static int expr_produces_local_type(Scheme_Object *expr, int fuel) if (SCHEME_LONG_DBLP(expr)) return SCHEME_LOCAL_TYPE_EXTFLONUM; #endif - if (SCHEME_INTP(expr) + if (SCHEME_INTP(expr) && IN_FIXNUM_RANGE_ON_ALL_PLATFORMS(SCHEME_INT_VAL(expr))) return SCHEME_LOCAL_TYPE_FIXNUM; return 0; @@ -2801,6 +2796,28 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz return app->rand1; } #endif + } else if (SCHEME_PRIMP(app->rator) + && (SCHEME_PRIM_PROC_OPT_FLAGS(app->rator) & SCHEME_PRIM_IS_BINARY_INLINED)) { + /* Recognize combinations of bitwise operations as generating fixnums */ + if (IS_NAMED_PRIM(app->rator, "bitwise-and") + || IS_NAMED_PRIM(app->rator, "bitwise-ior") + || IS_NAMED_PRIM(app->rator, "bitwise-xor")) { + if ((scheme_expr_produces_local_type(app->rand1) == SCHEME_LOCAL_TYPE_FIXNUM) + && (scheme_expr_produces_local_type(app->rand2) == SCHEME_LOCAL_TYPE_FIXNUM)) { + if (IS_NAMED_PRIM(app->rator, "bitwise-and")) + app->rator = scheme_unsafe_fxand_proc; + else if (IS_NAMED_PRIM(app->rator, "bitwise-ior")) + app->rator = scheme_unsafe_fxior_proc; + else + app->rator = scheme_unsafe_fxxor_proc; + } + } else if (IS_NAMED_PRIM(app->rator, "arithmetic-shift")) { + if (SCHEME_INTP(app->rand2) && (SCHEME_INT_VAL(app->rand2) <= 0) + && (scheme_expr_produces_local_type(app->rand1) == SCHEME_LOCAL_TYPE_FIXNUM)) { + app->rator = scheme_unsafe_fxrshift_proc; + app->rand2 = scheme_make_integer(-(SCHEME_INT_VAL(app->rand2))); + } + } } register_local_argument_types(NULL, NULL, app, info); diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 6ae73b2167..69c925b690 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -462,6 +462,10 @@ extern Scheme_Object *scheme_struct_type_p_proc; extern Scheme_Object *scheme_current_inspector_proc; extern Scheme_Object *scheme_make_inspector_proc; extern Scheme_Object *scheme_varref_const_p_proc; +extern Scheme_Object *scheme_unsafe_fxand_proc; +extern Scheme_Object *scheme_unsafe_fxior_proc; +extern Scheme_Object *scheme_unsafe_fxxor_proc; +extern Scheme_Object *scheme_unsafe_fxrshift_proc; extern Scheme_Object *scheme_define_values_syntax, *scheme_define_syntaxes_syntax; extern Scheme_Object *scheme_lambda_syntax; diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index c1a2a0ef27..f21403bf3f 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "6.0.0.4" +#define MZSCHEME_VERSION "6.0.0.5" #define MZSCHEME_VERSION_X 6 #define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 4 +#define MZSCHEME_VERSION_W 5 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)