From 64b0d4d061902c0f7443355fa4877ff6aad946d5 Mon Sep 17 00:00:00 2001
From: Fangyi Zhou <me@fangyi.io>
Date: Fri, 21 Feb 2025 16:31:08 +0000
Subject: [PATCH] wasm: use primitive opcodes for fabs and sqrt
- Add new `WasmInstr` constructor `WasmSqrt` for sqrt, corresponding to
primitivie operations in wasm.
- When lowering CallishMachOp, use `WasmAbs` and `WasmSqrt` for F32 and
F64 fabs and sqrt.
---
compiler/GHC/CmmToAsm/Wasm/Asm.hs | 1 +
compiler/GHC/CmmToAsm/Wasm/FromCmm.hs | 30 +++++++++++++++++++++++----
compiler/GHC/CmmToAsm/Wasm/Types.hs | 1 +
3 files changed, 28 insertions(+), 4 deletions(-)
diff --git a/compiler/GHC/CmmToAsm/Wasm/Asm.hs b/compiler/GHC/CmmToAsm/Wasm/Asm.hs
index e4f03ef3afe..392ab34b7fb 100644
--- a/compiler/GHC/CmmToAsm/Wasm/Asm.hs
+++ b/compiler/GHC/CmmToAsm/Wasm/Asm.hs
@@ -374,6 +374,7 @@ asmTellWasmInstr ty_word instr = case instr of
WasmF32DemoteF64 -> asmTellLine "f32.demote_f64"
WasmF64PromoteF32 -> asmTellLine "f64.promote_f32"
WasmAbs ty -> asmTellLine $ asmFromWasmType ty <> ".abs"
+ WasmSqrt ty -> asmTellLine $ asmFromWasmType ty <> ".sqrt"
WasmNeg ty -> asmTellLine $ asmFromWasmType ty <> ".neg"
WasmMin ty -> asmTellLine $ asmFromWasmType ty <> ".min"
WasmMax ty -> asmTellLine $ asmFromWasmType ty <> ".max"
diff --git a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
index cb408ba3f61..b50795bff7e 100644
--- a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
+++ b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
@@ -1108,6 +1108,28 @@ lower_CMO_Un_Homo lbl op [reg] [x] = do
x_instr `WasmConcat` WasmCCall op `WasmConcat` WasmLocalSet ty ri
lower_CMO_Un_Homo _ _ _ _ = panic "lower_CMO_Un_Homo: unreachable"
+-- | Lower an unary homogeneous 'CallishMachOp' to a primitive operation.
+lower_CMO_Un_Homo_Prim ::
+ CLabel ->
+ ( forall pre t.
+ WasmTypeTag t ->
+ WasmInstr
+ w
+ (t : pre)
+ (t : pre)
+ ) ->
+ WasmTypeTag t ->
+ [CmmFormal] ->
+ [CmmActual] ->
+ WasmCodeGenM w (WasmStatements w)
+lower_CMO_Un_Homo_Prim lbl op ty [reg] [x] = do
+ (ri, _) <- onCmmLocalReg reg
+ WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x
+ pure $
+ WasmStatements $
+ x_instr `WasmConcat` op ty `WasmConcat` WasmLocalSet ty ri
+lower_CMO_Un_Homo_Prim _ _ _ _ _ = panic "lower_CMO_Bin_Homo_Prim: unreachable"
+
-- | Lower a binary homogeneous 'CallishMachOp' to a ccall.
lower_CMO_Bin_Homo ::
CLabel ->
@@ -1211,8 +1233,8 @@ lower_CallishMachOp lbl MO_F64_Log rs xs = lower_CMO_Un_Homo lbl "log" rs xs
lower_CallishMachOp lbl MO_F64_Log1P rs xs = lower_CMO_Un_Homo lbl "log1p" rs xs
lower_CallishMachOp lbl MO_F64_Exp rs xs = lower_CMO_Un_Homo lbl "exp" rs xs
lower_CallishMachOp lbl MO_F64_ExpM1 rs xs = lower_CMO_Un_Homo lbl "expm1" rs xs
-lower_CallishMachOp lbl MO_F64_Fabs rs xs = lower_CMO_Un_Homo lbl "fabs" rs xs
-lower_CallishMachOp lbl MO_F64_Sqrt rs xs = lower_CMO_Un_Homo lbl "sqrt" rs xs
+lower_CallishMachOp lbl MO_F64_Fabs rs xs = lower_CMO_Un_Homo_Prim lbl WasmAbs TagF64 rs xs
+lower_CallishMachOp lbl MO_F64_Sqrt rs xs = lower_CMO_Un_Homo_Prim lbl WasmSqrt TagF64 rs xs
lower_CallishMachOp lbl MO_F32_Pwr rs xs = lower_CMO_Bin_Homo lbl "powf" rs xs
lower_CallishMachOp lbl MO_F32_Sin rs xs = lower_CMO_Un_Homo lbl "sinf" rs xs
lower_CallishMachOp lbl MO_F32_Cos rs xs = lower_CMO_Un_Homo lbl "cosf" rs xs
@@ -1235,8 +1257,8 @@ lower_CallishMachOp lbl MO_F32_Log1P rs xs =
lower_CallishMachOp lbl MO_F32_Exp rs xs = lower_CMO_Un_Homo lbl "expf" rs xs
lower_CallishMachOp lbl MO_F32_ExpM1 rs xs =
lower_CMO_Un_Homo lbl "expm1f" rs xs
-lower_CallishMachOp lbl MO_F32_Fabs rs xs = lower_CMO_Un_Homo lbl "fabsf" rs xs
-lower_CallishMachOp lbl MO_F32_Sqrt rs xs = lower_CMO_Un_Homo lbl "sqrtf" rs xs
+lower_CallishMachOp lbl MO_F32_Fabs rs xs = lower_CMO_Un_Homo_Prim lbl WasmAbs TagF32 rs xs
+lower_CallishMachOp lbl MO_F32_Sqrt rs xs = lower_CMO_Un_Homo_Prim lbl WasmSqrt TagF32 rs xs
lower_CallishMachOp lbl (MO_UF_Conv w0) rs xs = lower_MO_UF_Conv lbl w0 rs xs
lower_CallishMachOp _ MO_AcquireFence _ _ = pure $ WasmStatements WasmNop
lower_CallishMachOp _ MO_ReleaseFence _ _ = pure $ WasmStatements WasmNop
diff --git a/compiler/GHC/CmmToAsm/Wasm/Types.hs b/compiler/GHC/CmmToAsm/Wasm/Types.hs
index 8738428237f..1b85f03c856 100644
--- a/compiler/GHC/CmmToAsm/Wasm/Types.hs
+++ b/compiler/GHC/CmmToAsm/Wasm/Types.hs
@@ -310,6 +310,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)
+ WasmSqrt :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
WasmNeg :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
WasmMin :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
WasmMax :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
--
GitLab