diff options
-rw-r--r-- | compiler/GHC/Builtin/primops.txt.pp | 8 | ||||
-rw-r--r-- | compiler/GHC/Cmm/MachOp.hs | 5 | ||||
-rw-r--r-- | compiler/GHC/Cmm/Utils.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/X86/CodeGen.hs | 26 | ||||
-rw-r--r-- | compiler/GHC/Driver/Config/StgToCmm.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/StgToCmm/Config.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/StgToCmm/Prim.hs | 16 |
7 files changed, 66 insertions, 2 deletions
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp index 617abe5f9e..9aee1b55de 100644 --- a/compiler/GHC/Builtin/primops.txt.pp +++ b/compiler/GHC/Builtin/primops.txt.pp @@ -3412,6 +3412,14 @@ primop CompactSize "compactSize#" GenPrimOp 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 :) ------------------------------------------------------------------------ diff --git a/compiler/GHC/Cmm/MachOp.hs b/compiler/GHC/Cmm/MachOp.hs index d134fdc346..5029ca54eb 100644 --- a/compiler/GHC/Cmm/MachOp.hs +++ b/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] diff --git a/compiler/GHC/Cmm/Utils.hs b/compiler/GHC/Cmm/Utils.hs index bf8c96fd14..e468cbbd6e 100644 --- a/compiler/GHC/Cmm/Utils.hs +++ b/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 diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs index 8e57473384..346b3cef6a 100644 --- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs +++ b/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 diff --git a/compiler/GHC/Driver/Config/StgToCmm.hs b/compiler/GHC/Driver/Config/StgToCmm.hs index 283ece1d50..f4297305dc 100644 --- a/compiler/GHC/Driver/Config/StgToCmm.hs +++ b/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 diff --git a/compiler/GHC/StgToCmm/Config.hs b/compiler/GHC/StgToCmm/Config.hs index f2bd349ae7..8265cb10ec 100644 --- a/compiler/GHC/StgToCmm/Config.hs +++ b/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 diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs index e17a937a9e..9614689c04 100644 --- a/compiler/GHC/StgToCmm/Prim.hs +++ b/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. |