add unsafe-flabs and unsafe-fxabs (4.2.2.4)

svn: r16234

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
+@scheme[*], @scheme[/], and @scheme[abs], but constrained to consume
-numbers}. The result is always a real @tech{inexact number}.}
+real @tech{inexact numbers}. The result is always a real @tech{inexact
+number}.}
 
 
 @deftogether[(

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)

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_p(JIT_R1, scheme_make_integer(0));
-              jit_movi_l(JIT_R1, 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;

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);
+}

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

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)