diff options
author | Cheng Shao <terrorjack@type.dance> | 2023-01-24 17:37:53 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-01-25 03:54:50 -0500 |
commit | bc038c3bd45ee99db9fba23a823a906735740200 (patch) | |
tree | 20f01bffbcf8ade838508080b883d39ecbd9ccfc | |
parent | 3097282777a28770f0d597355e33b45d2f11e1d4 (diff) | |
download | haskell-bc038c3bd45ee99db9fba23a823a906735740200.tar.gz |
compiler: fix handling of MO_F_Neg in wasm NCG
In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an
oversight, there actually exists f32.neg/f64.neg opcodes in the wasm
spec and those should be used instead! The old behavior almost works,
expect when GHC compiles the -0.0 literal, which will incorrectly
become 0.0.
-rw-r--r-- | compiler/GHC/CmmToAsm/Wasm/Asm.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/Wasm/FromCmm.hs | 31 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/Wasm/Types.hs | 1 |
3 files changed, 29 insertions, 4 deletions
diff --git a/compiler/GHC/CmmToAsm/Wasm/Asm.hs b/compiler/GHC/CmmToAsm/Wasm/Asm.hs index 5ccce28676..6f342818a4 100644 --- a/compiler/GHC/CmmToAsm/Wasm/Asm.hs +++ b/compiler/GHC/CmmToAsm/Wasm/Asm.hs @@ -359,6 +359,7 @@ asmTellWasmInstr ty_word instr = case instr of WasmF32DemoteF64 -> asmTellLine "f32.demote_f64" WasmF64PromoteF32 -> asmTellLine "f64.promote_f32" WasmAbs ty -> asmTellLine $ asmFromWasmType ty <> ".abs" + WasmNeg ty -> asmTellLine $ asmFromWasmType ty <> ".neg" WasmCond t -> do asmTellLine "if" asmWithTab $ asmTellWasmInstr ty_word t diff --git a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs index 7016613d9d..e1ca600cba 100644 --- a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs +++ b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs @@ -224,6 +224,28 @@ extendSubword W32 TagI64 (WasmExpr instr) = WasmExpr $ instr `WasmConcat` WasmI64Extend32S extendSubword _ _ expr = expr +-- | Lower an unary homogeneous operation. +lower_MO_Un_Homo :: + ( forall pre t. + WasmTypeTag t -> + WasmInstr + w + (t : pre) + (t : pre) + ) -> + CLabel -> + CmmType -> + [CmmExpr] -> + WasmCodeGenM w (SomeWasmExpr w) +lower_MO_Un_Homo op lbl t0 [x] = case someWasmTypeFromCmmType t0 of + SomeWasmType ty -> do + WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x + pure $ + SomeWasmExpr ty $ + WasmExpr $ + x_instr `WasmConcat` op ty +lower_MO_Un_Homo _ _ _ _ = panic "lower_MO_Un_Homo: unreachable" + -- | Lower a binary homogeneous operation. Homogeneous: result type is -- the same with operand types. lower_MO_Bin_Homo :: @@ -699,11 +721,12 @@ lower_CmmMachOp lbl (MO_F_Sub w0) xs = lbl (cmmFloat w0) xs -lower_CmmMachOp lbl (MO_F_Neg w0) [x] = - lower_CmmMachOp +lower_CmmMachOp lbl (MO_F_Neg w0) xs = + lower_MO_Un_Homo + WasmNeg lbl - (MO_F_Sub w0) - [CmmLit $ CmmFloat 0 w0, x] + (cmmFloat w0) + xs lower_CmmMachOp lbl (MO_F_Mul w0) xs = lower_MO_Bin_Homo WasmMul diff --git a/compiler/GHC/CmmToAsm/Wasm/Types.hs b/compiler/GHC/CmmToAsm/Wasm/Types.hs index fa3287f0ec..284d62b173 100644 --- a/compiler/GHC/CmmToAsm/Wasm/Types.hs +++ b/compiler/GHC/CmmToAsm/Wasm/Types.hs @@ -305,6 +305,7 @@ data WasmInstr :: WasmType -> [WasmType] -> [WasmType] -> Type where WasmF32DemoteF64 :: WasmInstr w ('F64 : pre) ('F32 : pre) WasmF64PromoteF32 :: WasmInstr w ('F32 : pre) ('F64 : pre) WasmAbs :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre) + WasmNeg :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre) WasmCond :: WasmInstr w pre pre -> WasmInstr w (w : pre) pre newtype WasmExpr w t = WasmExpr (forall pre. WasmInstr w pre (t : pre)) |