Rewrite flonum-copysign/abs/negate primitives using integer masks.
authorTaylor R Campbell <campbell@mumble.net>
Thu, 13 Dec 2018 00:13:09 +0000 (00:13 +0000)
committerTaylor R Campbell <campbell@mumble.net>
Sat, 15 Dec 2018 22:33:21 +0000 (22:33 +0000)
Otherwise these spuriously raise exceptions on i387 because merely
loading a signalling NaN onto the fp stack does so.

src/microcode/flonum.c

index b1668ca113fe871cf97c32ad2af84c61ebb04bdb..14bcb943e2560cc81da4ecd0dd69836e8575909c 100644 (file)
@@ -119,16 +119,15 @@ DEFINE_PRIMITIVE ("FLONUM-MODULO", Prim_flonum_modulo, 2, 2, 0)
 DEFINE_PRIMITIVE ("FLONUM-NEGATE", Prim_flonum_negate, 1, 1, 0)
 {
   PRIMITIVE_HEADER (1);
-  FLONUM_RESULT (- (arg_flonum (1)));
+  FLONUM_BINARY64_RESULT
+    ((UINT64_C (0x8000000000000000)) ^ (arg_flonum_binary64 (1)));
 }
 
 DEFINE_PRIMITIVE ("FLONUM-ABS", Prim_flonum_abs, 1, 1, 0)
 {
   PRIMITIVE_HEADER (1);
-  {
-    double x = (arg_flonum (1));
-    FLONUM_RESULT (fabs (x));
-  }
+  FLONUM_BINARY64_RESULT
+    ((UINT64_C (0x7fffffffffffffff)) & (arg_flonum_binary64 (1)));
 }
 
 static void
@@ -647,9 +646,11 @@ DEFINE_PRIMITIVE ("FLONUM-COPYSIGN", Prim_flonum_copysign, 2, 2, 0)
 {
   PRIMITIVE_HEADER (2);
   {
-    double magnitude = (arg_flonum (1));
-    double sign = (arg_flonum (2));
-    FLONUM_RESULT (copysign (magnitude, sign));
+    uint64_t magnitude = (arg_flonum_binary64 (1));
+    uint64_t sign = (arg_flonum_binary64 (2));
+    FLONUM_BINARY64_RESULT
+      ((magnitude & (UINT64_C (0x7fffffffffffffff)))
+       | (sign & (UINT64_C (0x8000000000000000))));
   }
 }