Make floating-point abs IEEE 754 compliant

The old code used by via-C backend didn't handle the sign bit of NaN.

See #21043.

4 files changed, 3 insertions, 45 deletions

diff --git a/compiler/GHC/Driver/Config/StgToCmm.hs b/compiler/GHC/Driver/Config/StgToCmm.hs
index 1b05884bb7..7ec80f24d3 100644
--- a/compiler/GHC/Driver/Config/StgToCmm.hs
+++ b/compiler/GHC/Driver/Config/StgToCmm.hs
@@ -51,7 +51,6 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
   , stgToCmmAllowQuotRem2             = (ncg && (x86ish || ppc)) || llvm
   , stgToCmmAllowExtendedAddSubInstrs = (ncg && (x86ish || ppc)) || llvm
   , stgToCmmAllowIntMul2Instr         = (ncg && x86ish) || llvm
-  , stgToCmmAllowFabsInstrs           = (ncg && (x86ish || ppc || aarch64)) || llvm
   -- SIMD flags
   , stgToCmmVecInstrsErr  = vec_err
   , stgToCmmAvx           = isAvxEnabled                   dflags
@@ -72,7 +71,6 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
                       ArchPPC      -> True
                       ArchPPC_64 _ -> True
                       _            -> False
-          aarch64 = platformArch platform == ArchAArch64
           vec_err = case backend dflags of
                       LLVM -> Nothing
                       _    -> Just (unlines ["SIMD vector instructions require the LLVM back-end.", "Please use -fllvm."])
diff --git a/compiler/GHC/StgToCmm/Config.hs b/compiler/GHC/StgToCmm/Config.hs
index d73dd753e6..01b3a3f319 100644
--- a/compiler/GHC/StgToCmm/Config.hs
+++ b/compiler/GHC/StgToCmm/Config.hs
@@ -66,7 +66,6 @@ data StgToCmmConfig = StgToCmmConfig
   , stgToCmmAllowQuotRem2             :: !Bool   -- ^ Allowed to generate QuotRem
   , stgToCmmAllowExtendedAddSubInstrs :: !Bool   -- ^ Allowed to generate AddWordC, SubWordC, Add2, etc.
   , stgToCmmAllowIntMul2Instr         :: !Bool   -- ^ Allowed to generate IntMul2 instruction
-  , stgToCmmAllowFabsInstrs           :: !Bool   -- ^ Allowed to generate Fabs instructions
   , stgToCmmTickyAP                   :: !Bool   -- ^ Disable use of precomputed standard thunks.
   ------------------------------ SIMD flags ------------------------------------
   -- Each of these flags checks vector compatibility with the backend requested
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index b49ad24edd..22367e48ff 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -1103,6 +1103,7 @@ emitPrimOp cfg primop =
   DoubleExpOp    -> \args -> opCallish args MO_F64_Exp
   DoubleExpM1Op  -> \args -> opCallish args MO_F64_ExpM1
   DoubleSqrtOp   -> \args -> opCallish args MO_F64_Sqrt
+  DoubleFabsOp   -> \args -> opCallish args MO_F64_Fabs
 
   FloatPowerOp   -> \args -> opCallish args MO_F32_Pwr
   FloatSinOp     -> \args -> opCallish args MO_F32_Sin
@@ -1122,6 +1123,7 @@ emitPrimOp cfg primop =
   FloatExpOp     -> \args -> opCallish args MO_F32_Exp
   FloatExpM1Op   -> \args -> opCallish args MO_F32_ExpM1
   FloatSqrtOp    -> \args -> opCallish args MO_F32_Sqrt
+  FloatFabsOp    -> \args -> opCallish args MO_F32_Fabs
 
 -- Native word signless ops
 
@@ -1525,16 +1527,6 @@ emitPrimOp cfg primop =
     then Left (MO_S_Mul2     (wordWidth platform))
     else Right genericIntMul2Op
 
-  FloatFabsOp -> \args -> opCallishHandledLater args $
-    if allowFab
-    then Left MO_F32_Fabs
-    else Right $ genericFabsOp W32
-
-  DoubleFabsOp -> \args -> opCallishHandledLater args $
-    if allowFab
-    then Left MO_F64_Fabs
-    else Right $ genericFabsOp W64
-
   -- tagToEnum# is special: we need to pull the constructor
   -- out of the table, and perform an appropriate return.
   TagToEnumOp -> \[amode] -> PrimopCmmEmit_Internal $ \res_ty -> do
@@ -1736,7 +1728,6 @@ emitPrimOp cfg primop =
   allowQuotRem2 = stgToCmmAllowQuotRem2             cfg
   allowExtAdd   = stgToCmmAllowExtendedAddSubInstrs cfg
   allowInt2Mul  = stgToCmmAllowIntMul2Instr         cfg
-  allowFab      = stgToCmmAllowFabsInstrs           cfg
 
 data PrimopCmmEmit
   -- | Out of line fake primop that's actually just a foreign call to other
@@ -2026,34 +2017,6 @@ genericIntMul2Op [res_c, res_h, res_l] both_args@[arg_x, arg_y]
              ]
 genericIntMul2Op _ _ = panic "genericIntMul2Op"
 
--- This replicates what we had in libraries/base/GHC/Float.hs:
---
---    abs x    | x == 0    = 0 -- handles (-0.0)
---             | x >  0    = x
---             | otherwise = negateFloat x
-genericFabsOp :: Width -> GenericOp
-genericFabsOp w [res_r] [aa]
- = do platform <- getPlatform
-      let zero   = CmmLit (CmmFloat 0 w)
-
-          eq x y = CmmMachOp (MO_F_Eq w) [x, y]
-          gt x y = CmmMachOp (MO_F_Gt w) [x, y]
-
-          neg x  = CmmMachOp (MO_F_Neg w) [x]
-
-          g1 = catAGraphs [mkAssign (CmmLocal res_r) zero]
-          g2 = catAGraphs [mkAssign (CmmLocal res_r) aa]
-
-      res_t <- CmmLocal <$> newTemp (cmmExprType platform aa)
-      let g3 = catAGraphs [mkAssign res_t aa,
-                           mkAssign (CmmLocal res_r) (neg (CmmReg res_t))]
-
-      g4 <- mkCmmIfThenElse (gt aa zero) g2 g3
-
-      emit =<< mkCmmIfThenElse (eq aa zero) g1 g4
-
-genericFabsOp _ _ _ = panic "genericFabsOp"
-
 ------------------------------------------------------------------------------
 -- Helpers for translating various minor variants of array indexing.
 
diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T
index af3a91d026..85acd521f6 100644
--- a/testsuite/tests/codeGen/should_run/all.T
+++ b/testsuite/tests/codeGen/should_run/all.T
@@ -207,9 +207,7 @@ test('T16846', [only_ways(['optasm']), exit_code(1)], compile_and_run, [''])
 test('T17920', cmm_src, compile_and_run, [''])
 test('T18527', normal, compile_and_run, ['T18527FFI.c'])
 test('T19149', only_ways('sanity'), compile_and_run, ['T19149_c.c'])
-test('T20275', [when(unregisterised(), skip),
-                unless(arch('i386') or arch('x86_64') or arch('powerpc') or arch('powerpc64') or arch('powerpc64le') or arch('aarch64'), skip)],
-     compile_and_run, [''])
+test('T20275', normal, compile_and_run, [''])
 
 test('CallConv', [when(unregisterised(), skip),
                   unless(arch('x86_64') or arch('aarch64'), skip),