diff --git a/collects/scribblings/reference/unsafe.scrbl b/collects/scribblings/reference/unsafe.scrbl index a6764b53ec..e1bb4a7692 100644 --- a/collects/scribblings/reference/unsafe.scrbl +++ b/collects/scribblings/reference/unsafe.scrbl @@ -34,10 +34,11 @@ can be prevented by adjusting the code inspector (see @defproc[(unsafe-fx* [a fixnum?][b fixnum?]) fixnum?] @defproc[(unsafe-fxquotient [a fixnum?][b fixnum?]) fixnum?] @defproc[(unsafe-fxremainder [a fixnum?][b fixnum?]) fixnum?] +@defproc[(unsafe-fxabs [a fixnum?]) fixnum?] )]{ For @tech{fixnums}: Like @scheme[+], @scheme[-], @scheme[*], -@scheme[quotient], and @scheme[remainder], but constrained to consume +@scheme[quotient], @scheme[remainder], and @scheme[abs], but constrained to consume @tech{fixnums} and produce a @tech{fixnum} result. The mathematical operation on @scheme[a] and @scheme[b] must be representable as a @tech{fixnum}. In the case of @scheme[unsafe-fxquotient] and @@ -89,11 +90,13 @@ Like @scheme[exact->inexact], but constrained to consume @tech{fixnums}. @defproc[(unsafe-fl- [a inexact-real?][b inexact-real?]) inexact-real?] @defproc[(unsafe-fl* [a inexact-real?][b inexact-real?]) inexact-real?] @defproc[(unsafe-fl/ [a inexact-real?][b inexact-real?]) inexact-real?] +@defproc[(unsafe-flabs [a inexact-real?]) inexact-real?] )]{ For real @tech{inexact numbers}: Like @scheme[+], @scheme[-], -@scheme[*], and @scheme[/], but constrained to consume real @tech{inexact -numbers}. The result is always a real @tech{inexact number}.} +@scheme[*], @scheme[/], and @scheme[abs], but constrained to consume +real @tech{inexact numbers}. The result is always a real @tech{inexact +number}.} @deftogether[( diff --git a/collects/tests/mzscheme/unsafe.ss b/collects/tests/mzscheme/unsafe.ss index 267882034d..ea1c466a2b 100644 --- a/collects/tests/mzscheme/unsafe.ss +++ b/collects/tests/mzscheme/unsafe.ss @@ -119,6 +119,13 @@ (test-bin 8 'unsafe-fxrshift 32 2) (test-bin 8 'unsafe-fxrshift 8 0) + (test-un 5 unsafe-fxabs 5) + (test-un 5 unsafe-fxabs -5) + (test-un 5.0 unsafe-flabs 5.0) + (test-un 5.0 unsafe-flabs -5.0) + (test-un 0.0 unsafe-flabs -0.0) + (test-un +inf.0 unsafe-flabs -inf.0) + (test-un 8.0 'unsafe-fx->fl 8) (test-un -8.0 'unsafe-fx->fl -8) @@ -127,6 +134,7 @@ (test-tri 9.0 '(lambda (x y z) (unsafe-fl+ y (unsafe-fl- x z))) 4.5 7.0 2.5) (test-bin 10.0 '(lambda (x y) (unsafe-fl+ (unsafe-fx->fl x) y)) 2 8.0) (test-bin 10.0 '(lambda (x y) (unsafe-fl+ (unsafe-fx->fl x) y)) 2 8.0) + (test-bin 9.5 '(lambda (x y) (unsafe-fl+ (unsafe-flabs x) y)) -2.0 7.5) (test-tri (/ 20.0 0.8) '(lambda (x y z) (unsafe-fl/ (unsafe-fl* x z) y)) 4.0 0.8 5.0) (test-tri (/ 0.8 20.0) '(lambda (x y z) (unsafe-fl/ y (unsafe-fl* x z))) 4.0 0.8 5.0) (test-tri #t '(lambda (x y z) (unsafe-fl< (unsafe-fl+ x y) z)) 1.2 3.4 5.0) diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index f8105bb34b..5b15f056e5 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -3197,6 +3197,7 @@ static int is_unboxable_op(Scheme_Object *obj, int flag) if (IS_NAMED_PRIM(obj, "unsafe-fl-")) return 1; if (IS_NAMED_PRIM(obj, "unsafe-fl*")) return 1; if (IS_NAMED_PRIM(obj, "unsafe-fl/")) return 1; + if (IS_NAMED_PRIM(obj, "unsafe-flabs")) return 1; if (IS_NAMED_PRIM(obj, "unsafe-fx->fl")) return 1; return 0; @@ -4210,10 +4211,8 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj /* watch out for most negative fixnum! */ if (!unsafe_fx) (void)jit_beqi_p(refslow, JIT_R0, (void *)(((long)1 << ((8 * JIT_WORD_SIZE) - 1)) | 0x1)); - jit_rshi_l(JIT_R0, JIT_R0, 1); - jit_movi_l(JIT_R1, 0); + jit_movi_p(JIT_R1, scheme_make_integer(0)); jit_subr_l(JIT_R0, JIT_R1, JIT_R0); - jit_lshi_l(JIT_R0, JIT_R0, 1); jit_ori_l(JIT_R0, JIT_R0, 0x1); __START_INNER_TINY__(branch_short); mz_patch_branch(refc); @@ -4921,6 +4920,12 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in } else if (IS_NAMED_PRIM(rator, "abs")) { generate_arith(jitter, rator, app->rand, NULL, 1, 11, 0, 0, NULL, 1, 0, 0); return 1; + } else if (IS_NAMED_PRIM(rator, "unsafe-fxabs")) { + generate_arith(jitter, rator, app->rand, NULL, 1, 11, 0, 0, NULL, 1, 1, 0); + return 1; + } else if (IS_NAMED_PRIM(rator, "unsafe-flabs")) { + generate_arith(jitter, rator, app->rand, NULL, 1, 11, 0, 0, NULL, 1, 0, 1); + return 1; } else if (IS_NAMED_PRIM(rator, "exact->inexact")) { generate_arith(jitter, rator, app->rand, NULL, 1, 12, 0, 0, NULL, 1, 0, 0); return 1; diff --git a/src/mzscheme/src/numarith.c b/src/mzscheme/src/numarith.c index d5e91969ae..a090f37e6c 100644 --- a/src/mzscheme/src/numarith.c +++ b/src/mzscheme/src/numarith.c @@ -40,11 +40,13 @@ static Scheme_Object *fx_minus (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_mult (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_div (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_rem (int argc, Scheme_Object *argv[]); +static Scheme_Object *fx_abs (int argc, Scheme_Object *argv[]); static Scheme_Object *fl_plus (int argc, Scheme_Object *argv[]); static Scheme_Object *fl_minus (int argc, Scheme_Object *argv[]); static Scheme_Object *fl_mult (int argc, Scheme_Object *argv[]); static Scheme_Object *fl_div (int argc, Scheme_Object *argv[]); +static Scheme_Object *fl_abs (int argc, Scheme_Object *argv[]); #define zeroi scheme_exact_zero @@ -127,6 +129,10 @@ void scheme_init_unsafe_numarith(Scheme_Env *env) SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED; scheme_add_global_constant("unsafe-fxremainder", p, env); + p = scheme_make_folding_prim(fx_abs, "unsafe-fxabs", 1, 1, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED; + scheme_add_global_constant("unsafe-fxabs", p, env); + p = scheme_make_folding_prim(fl_plus, "unsafe-fl+", 2, 2, 1); if (scheme_can_inline_fp_op()) @@ -147,6 +153,11 @@ void scheme_init_unsafe_numarith(Scheme_Env *env) if (scheme_can_inline_fp_op()) SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED; scheme_add_global_constant("unsafe-fl/", p, env); + + p = scheme_make_folding_prim(fl_abs, "unsafe-flabs", 1, 1, 1); + if (scheme_can_inline_fp_op()) + SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED; + scheme_add_global_constant("unsafe-flabs", p, env); } Scheme_Object * @@ -783,6 +794,15 @@ UNSAFE_FX(fx_mult, *, mult) UNSAFE_FX(fx_div, /, quotient) UNSAFE_FX(fx_rem, %, rem_prim) +static Scheme_Object *fx_abs(int argc, Scheme_Object *argv[]) +{ + long v; + if (scheme_current_thread->constant_folding) return scheme_abs(argc, argv); + v = SCHEME_INT_VAL(argv[0]); + if (v < 0) v = -v; + return scheme_make_integer(v); +} + #define UNSAFE_FL(name, op, fold) \ static Scheme_Object *name(int argc, Scheme_Object *argv[]) \ { \ @@ -796,3 +816,12 @@ UNSAFE_FL(fl_plus, +, plus) UNSAFE_FL(fl_minus, -, minus) UNSAFE_FL(fl_mult, *, mult) UNSAFE_FL(fl_div, /, div_prim) + +static Scheme_Object *fl_abs(int argc, Scheme_Object *argv[]) +{ + double v; + if (scheme_current_thread->constant_folding) return scheme_abs(argc, argv); + v = SCHEME_DBL_VAL(argv[0]); + v = fabs(v); + return scheme_make_double(v); +} diff --git a/src/mzscheme/src/schminc.h b/src/mzscheme/src/schminc.h index 37497bc7ab..719168ccde 100644 --- a/src/mzscheme/src/schminc.h +++ b/src/mzscheme/src/schminc.h @@ -14,7 +14,7 @@ #define USE_COMPILED_STARTUP 1 #define EXPECTED_PRIM_COUNT 959 -#define EXPECTED_UNSAFE_COUNT 39 +#define EXPECTED_UNSAFE_COUNT 41 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/src/mzscheme/src/schvers.h b/src/mzscheme/src/schvers.h index 7fe93e462a..53133e62eb 100644 --- a/src/mzscheme/src/schvers.h +++ b/src/mzscheme/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "4.2.2.3" +#define MZSCHEME_VERSION "4.2.2.4" #define MZSCHEME_VERSION_X 4 #define MZSCHEME_VERSION_Y 2 #define MZSCHEME_VERSION_Z 2 -#define MZSCHEME_VERSION_W 3 +#define MZSCHEME_VERSION_W 4 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)