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

fix compiler--validator mismatch on bitwise specializations

Browse Source
This commit is contained in:
Matthew Flatt 2014-03-18 09:05:01 -06:00
parent e545926e76
commit a86b851f74
5 changed files with 73 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl
View File

@ -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)

13
racket/src/racket/src/number.c
View File

@ -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())

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

@ -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);

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

@ -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;

4
racket/src/racket/src/schvers.h
View File

@ -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)