AArch64 NCG: Emit FABS instructions for fabsFloat# and fabsDouble#

Closes #20275

4 files changed, 24 insertions, 4 deletions

diff --git a/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs b/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
index a01d1dea12..8d77e8df63 100644
--- a/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
@@ -1228,6 +1228,13 @@ genCCall target dest_regs arg_regs bid = do
             `appOL` moveStackUp (stackSpace `div` 8)
       return (code, Nothing)
 
+    PrimTarget MO_F32_Fabs
+      | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs ->
+        unaryFloatOp W32 (\d x -> unitOL $ FABS d x) arg_reg dest_reg
+    PrimTarget MO_F64_Fabs
+      | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs ->
+        unaryFloatOp W64 (\d x -> unitOL $ FABS d x) arg_reg dest_reg
+
     -- or a possibly side-effecting machine operation
     -- mop :: CallishMachOp (see GHC.Cmm.MachOp)
     PrimTarget mop -> do
@@ -1278,7 +1285,7 @@ genCCall target dest_regs arg_regs bid = do
         MO_F32_Log1P -> mkCCall "log1pf"
         MO_F32_Exp   -> mkCCall "expf"
         MO_F32_ExpM1 -> mkCCall "expm1f"
-        MO_F32_Fabs  -> mkCCall "fasbf"
+        MO_F32_Fabs  -> mkCCall "fabsf"
         MO_F32_Sqrt  -> mkCCall "sqrtf"
 
         -- 64-bit primops
@@ -1513,3 +1520,10 @@ genCCall target dest_regs arg_regs bid = do
       if isFloatFormat format
         then readResults (gpReg:gpRegs) fpRegs dsts (fpReg:accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w fpReg))
         else readResults gpRegs (fpReg:fpRegs) dsts (gpReg:accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w gpReg))
+
+    unaryFloatOp w op arg_reg dest_reg = do
+      platform <- getPlatform
+      (reg_fx, _format_x, code_fx) <- getFloatReg arg_reg
+      let dst = getRegisterReg platform (CmmLocal dest_reg)
+      let code = code_fx `appOL` op (OpReg w dst) (OpReg w reg_fx)
+      return (code, Nothing)
diff --git a/compiler/GHC/CmmToAsm/AArch64/Instr.hs b/compiler/GHC/CmmToAsm/AArch64/Instr.hs
index 6318441b07..189f57464b 100644
--- a/compiler/GHC/CmmToAsm/AArch64/Instr.hs
+++ b/compiler/GHC/CmmToAsm/AArch64/Instr.hs
@@ -133,6 +133,7 @@ regUsageOfInstr platform instr = case instr of
   FCVT dst src             -> usage (regOp src, regOp dst)
   SCVTF dst src            -> usage (regOp src, regOp dst)
   FCVTZS dst src           -> usage (regOp src, regOp dst)
+  FABS dst src             -> usage (regOp src, regOp dst)
 
   _ -> panic "regUsageOfInstr"
 
@@ -263,6 +264,7 @@ patchRegsOfInstr instr env = case instr of
     FCVT o1 o2     -> FCVT (patchOp o1) (patchOp o2)
     SCVTF o1 o2    -> SCVTF (patchOp o1) (patchOp o2)
     FCVTZS o1 o2   -> FCVTZS (patchOp o1) (patchOp o2)
+    FABS o1 o2     -> FABS (patchOp o1) (patchOp o2)
 
     _ -> pprPanic "patchRegsOfInstr" (text $ show instr)
     where
@@ -629,6 +631,8 @@ data Instr
     | SCVTF Operand Operand
     -- Float ConVerT to Zero Signed
     | FCVTZS Operand Operand
+    -- Float ABSolute value
+    | FABS Operand Operand
 
 instance Show Instr where
     show (LDR _f o1 o2) = "LDR " ++ show o1 ++ ", " ++ show o2
diff --git a/compiler/GHC/CmmToAsm/AArch64/Ppr.hs b/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
index 6a799f2e9a..9c50a46292 100644
--- a/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
@@ -554,10 +554,11 @@ pprInstr platform instr = case instr of
 
   -- 8. Synchronization Instructions -------------------------------------------
   DMBSY -> text "\tdmb sy"
-  -- 8. Synchronization Instructions -------------------------------------------
+  -- 9. Floating Point Instructions --------------------------------------------
   FCVT o1 o2 -> text "\tfcvt" <+> pprOp platform o1 <> comma <+> pprOp platform o2
   SCVTF o1 o2 -> text "\tscvtf" <+> pprOp platform o1 <> comma <+> pprOp platform o2
   FCVTZS o1 o2 -> text "\tfcvtzs" <+> pprOp platform o1 <> comma <+> pprOp platform o2
+  FABS o1 o2 -> text "\tfabs" <+> pprOp platform o1 <> comma <+> pprOp platform o2
 
 pprBcond :: Cond -> SDoc
 pprBcond c = text "b." <> pprCond c
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index e268761cd7..ab1ac89576 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -1554,12 +1554,12 @@ emitPrimOp dflags primop = case primop of
     else Right genericIntMul2Op
 
   FloatFabsOp -> \args -> opCallishHandledLater args $
-    if (ncg && x86ish || ppc) || llvm
+    if (ncg && (x86ish || ppc || aarch64)) || llvm
     then Left MO_F32_Fabs
     else Right $ genericFabsOp W32
 
   DoubleFabsOp -> \args -> opCallishHandledLater args $
-    if (ncg && x86ish || ppc) || llvm
+    if (ncg && (x86ish || ppc || aarch64)) || llvm
     then Left MO_F64_Fabs
     else Right $ genericFabsOp W64
 
@@ -1770,6 +1770,7 @@ emitPrimOp dflags primop = case primop of
           ArchPPC      -> True
           ArchPPC_64 _ -> True
           _            -> False
+  aarch64 = platformArch platform == ArchAArch64
 
 data PrimopCmmEmit
   -- | Out of line fake primop that's actually just a foreign call to other