[Git][ghc/ghc][wip/andreask/cmov-primop] Add a cmov# primop

Andreas Klebinger (@AndreasK) gitlab at gitlab.haskell.org
Sun Jan 8 21:52:14 UTC 2023



Andreas Klebinger pushed to branch wip/andreask/cmov-primop at Glasgow Haskell Compiler / GHC


Commits:
4bfbebdf by Andreas Klebinger at 2023-01-08T22:50:31+01:00
Add a cmov# primop

The cmov# primop allows users to force GHC to emit a conditional move
instead of a branch if so desired.

- - - - -


7 changed files:

- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Cmm/MachOp.hs
- compiler/GHC/Cmm/Utils.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/Driver/Config/StgToCmm.hs
- compiler/GHC/StgToCmm/Config.hs
- compiler/GHC/StgToCmm/Prim.hs


Changes:

=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -3411,6 +3411,14 @@ primop CompactSize "compactSize#" GenPrimOp
    has_side_effects = True
    out_of_line      = True
 
+------------------------------------------------------------------------
+section "Cmove"
+------------------------------------------------------------------------
+
+primop CMovOp "cmov#" GenPrimOp
+   Int# -> o -> o -> (# o #)
+   { Returns the last argument if the first argument is zero, the first argument otherwise. }
+
 ------------------------------------------------------------------------
 section "Unsafe pointer equality"
 --  (#1 Bad Guy: Alastair Reid :)


=====================================
compiler/GHC/Cmm/MachOp.hs
=====================================
@@ -108,6 +108,9 @@ data MachOp
   | MO_U_Shr Width      -- unsigned shift right
   | MO_S_Shr Width      -- signed shift right
 
+  -- | Conditional move. First argument tells us which arg to select.
+  | MO_Cmov Width
+
   -- Conversions.  Some of these will be NOPs.
   -- Floating-point conversions use the signed variant.
   | MO_SF_Conv Width Width      -- Signed int -> Float
@@ -412,6 +415,7 @@ machOpResultType platform mop tys =
     MO_Shl   r          -> cmmBits r
     MO_U_Shr r          -> cmmBits r
     MO_S_Shr r          -> cmmBits r
+    MO_Cmov r           -> cmmBits r
 
     MO_SS_Conv _ to     -> cmmBits to
     MO_UU_Conv _ to     -> cmmBits to
@@ -503,6 +507,7 @@ machOpArgReps platform op =
     MO_Shl   r          -> [r, wordWidth platform]
     MO_U_Shr r          -> [r, wordWidth platform]
     MO_S_Shr r          -> [r, wordWidth platform]
+    MO_Cmov r           -> [wordWidth platform, r, r]
 
     MO_SS_Conv from _   -> [from]
     MO_UU_Conv from _   -> [from]


=====================================
compiler/GHC/Cmm/Utils.hs
=====================================
@@ -38,7 +38,7 @@ module GHC.Cmm.Utils(
         cmmNeWord, cmmEqWord,
         cmmOrWord, cmmAndWord,
         cmmSubWord, cmmAddWord, cmmMulWord, cmmQuotWord,
-        cmmToWord,
+        cmmToWord, cmmCMov,
 
         cmmMkAssign,
 
@@ -390,6 +390,12 @@ cmmToWord platform e
     w = cmmExprWidth platform e
     word = wordWidth platform
 
+-- Might not be supported on all platforms
+cmmCMov :: Platform -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
+cmmCMov platform cond x y =
+  CmmMachOp (MO_Cmov (cmmExprWidth platform x))
+    [cmmNeWord platform (cmmToWord platform cond) (zeroExpr platform),x,y]
+
 cmmMkAssign :: Platform -> CmmExpr -> Unique -> (CmmNode O O, CmmExpr)
 cmmMkAssign platform expr uq =
   let !ty = cmmExprType platform expr


=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -379,7 +379,11 @@ type InstrBlock
 -- | Condition codes passed up the tree.
 --
 data CondCode
-        = CondCode Bool Cond InstrBlock
+        = CondCode
+        { _cond_is_float :: Bool
+        , _cond_cond :: Cond
+        , _cond_instr :: InstrBlock
+        }
 
 
 -- | Register's passed up the tree.  If the stix code forces the register
@@ -1148,6 +1152,26 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps
 
            return (Fixed format result code)
 
+getRegister' _bid _is32Bit (CmmMachOp mop [x, y, z]) = -- triadic MachOps
+    case mop of
+        MO_Cmov width -> do
+            let format = (intFormat width)
+
+            CondCode is_float cond code_cond <- getCondCode x
+            massert (not is_float)
+
+            (y_reg, code_y) <- getSomeReg y
+
+            get_code_z <- getAnyReg z
+            let cmov_code dst_reg =
+                  code_y `appOL` (get_code_z dst_reg) `appOL` code_cond `appOL`
+                        toOL [CMOV cond format (OpReg y_reg) dst_reg]
+            return $ Any format cmov_code
+        _other -> pprPanic "getRegister(x86) - trinary CmmMachOp (1)" (pprMachOp mop)
+  where
+
+
+
 
 getRegister' _ _ (CmmLoad mem pk _)
   | isFloatType pk


=====================================
compiler/GHC/Driver/Config/StgToCmm.hs
=====================================
@@ -51,6 +51,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
   , stgToCmmAllowQuotRem2             = (ncg && (x86ish || ppc)) || llvm
   , stgToCmmAllowExtendedAddSubInstrs = (ncg && (x86ish || ppc)) || llvm
   , stgToCmmAllowIntMul2Instr         = (ncg && x86ish) || llvm
+  , stgToCmmAllowCMovInstr             = (ncg && x86_64)
   -- SIMD flags
   , stgToCmmVecInstrsErr  = vec_err
   , stgToCmmAvx           = isAvxEnabled                   dflags
@@ -70,6 +71,9 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
                       ArchX86    -> True
                       ArchX86_64 -> True
                       _          -> False
+          x86_64 = case platformArch platform of
+                      ArchX86_64 -> True
+                      _          -> False
           ppc     = case platformArch platform of
                       ArchPPC      -> True
                       ArchPPC_64 _ -> True


=====================================
compiler/GHC/StgToCmm/Config.hs
=====================================
@@ -66,6 +66,7 @@ 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
+  , stgToCmmAllowCMovInstr            :: !Bool   -- ^ Allowed to generate conditional move instructions.
   , stgToCmmTickyAP                   :: !Bool   -- ^ Disable use of precomputed standard thunks.
   ------------------------------ SIMD flags ------------------------------------
   -- Each of these flags checks vector compatibility with the backend requested


=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -341,6 +341,12 @@ emitPrimOp cfg primop =
 
   EqStablePtrOp -> \args -> opTranslate args (mo_wordEq platform)
 
+  CMovOp -> \[cond, x, y] ->
+        opIntoRegs $ \[res] -> if allowCmov
+          then emitAssign (CmmLocal res) (cmmCMov platform cond x y)
+          -- Fall back to using a branch
+          else emitGenericCMov [res] [cond, x, y]
+
   ReallyUnsafePtrEqualityOp -> \[arg1, arg2] -> opIntoRegs $ \[res] ->
     emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq platform) [arg1,arg2])
 
@@ -1735,6 +1741,7 @@ emitPrimOp cfg primop =
   allowQuotRem2 = stgToCmmAllowQuotRem2             cfg
   allowExtAdd   = stgToCmmAllowExtendedAddSubInstrs cfg
   allowInt2Mul  = stgToCmmAllowIntMul2Instr         cfg
+  allowCmov     = stgToCmmAllowCMovInstr            cfg
 
 data PrimopCmmEmit
   -- | Out of line fake primop that's actually just a foreign call to other
@@ -2024,6 +2031,15 @@ genericIntMul2Op [res_c, res_h, res_l] both_args@[arg_x, arg_y]
              ]
 genericIntMul2Op _ _ = panic "genericIntMul2Op"
 
+-- | Emulate cmov by using a branch, urkh
+emitGenericCMov :: GenericOp
+emitGenericCMov [res] [cond, arg_x, arg_y]
+ = do true_lbl <- newBlockId
+      emitAssign (CmmLocal res) arg_x
+      emit =<< mkCmmIfGoto cond true_lbl
+      emitAssign (CmmLocal res) arg_y
+      emitLabel true_lbl
+emitGenericCMov _ _ = panic "genericIntMul2Op"
 ------------------------------------------------------------------------------
 -- Helpers for translating various minor variants of array indexing.
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bfbebdf48a1e01a551ca7a3f083ffe34650d13d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bfbebdf48a1e01a551ca7a3f083ffe34650d13d
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230108/7ad8bb1d/attachment-0001.html>


More information about the ghc-commits mailing list