summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorARATA Mizuki <minorinoki@gmail.com>2022-02-03 21:44:57 +0900
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-05-11 08:22:57 -0400
commit8500206ea7084f3914efd3fe7f4336f2893eb4ac (patch)
treee03394e1b712e8d9edf131eda1f5872edd6ffb82
parent5b791ed3baf9875931c3bf3b67e8d83d0b3c94e2 (diff)
downloadhaskell-8500206ea7084f3914efd3fe7f4336f2893eb4ac.tar.gz
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.
-rw-r--r--compiler/GHC/Driver/Config/StgToCmm.hs2
-rw-r--r--compiler/GHC/StgToCmm/Config.hs1
-rw-r--r--compiler/GHC/StgToCmm/Prim.hs41
-rw-r--r--testsuite/tests/codeGen/should_run/all.T4
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),