[commit: ghc] master: PPC NCG: Generate MO_?_QuotRem for subword sizes (9e7d58c)
git at git.haskell.org
git at git.haskell.org
Tue Dec 11 23:22:05 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/9e7d58c894571f3c114c4f793b52f9d17c4c57fe/ghc
>---------------------------------------------------------------
commit 9e7d58c894571f3c114c4f793b52f9d17c4c57fe
Author: Peter Trommler <ptrommler at acm.org>
Date: Tue Dec 11 13:22:00 2018 -0500
PPC NCG: Generate MO_?_QuotRem for subword sizes
Handle Int*QuotRemOP and Word*QuotRemOp in PPC NCG.
Refactor common code with remainder operation.
Test Plan: validate (I validated on Linux powerpc64le and x86_64)
Reviewers: erikd, hvr, bgamari, simonmar
Reviewed By: bgamari
Subscribers: rwbarton, carter
Differential Revision: https://phabricator.haskell.org/D5323
>---------------------------------------------------------------
9e7d58c894571f3c114c4f793b52f9d17c4c57fe
compiler/codeGen/StgCmmPrim.hs | 35 +++++++++++-------------------
compiler/nativeGen/PPC/CodeGen.hs | 45 +++++++++++++++++++++------------------
2 files changed, 37 insertions(+), 43 deletions(-)
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 015eece..a6f3395 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -880,11 +880,11 @@ callishPrimOpSupported dflags op
| otherwise ->
Right (genericIntQuotRemOp (wordWidth dflags))
- Int8QuotRemOp | (ncg && x86ish)
+ Int8QuotRemOp | ncg && (x86ish || ppc)
-> Left (MO_S_QuotRem W8)
| otherwise -> Right (genericIntQuotRemOp W8)
- Int16QuotRemOp | (ncg && x86ish)
+ Int16QuotRemOp | ncg && (x86ish || ppc)
-> Left (MO_S_QuotRem W16)
| otherwise -> Right (genericIntQuotRemOp W16)
@@ -894,54 +894,45 @@ callishPrimOpSupported dflags op
| otherwise ->
Right (genericWordQuotRemOp (wordWidth dflags))
- WordQuotRem2Op | (ncg && (x86ish
- || ppc))
+ WordQuotRem2Op | (ncg && (x86ish || ppc))
|| llvm -> Left (MO_U_QuotRem2 (wordWidth dflags))
| otherwise -> Right (genericWordQuotRem2Op dflags)
- Word8QuotRemOp | (ncg && x86ish)
+ Word8QuotRemOp | ncg && (x86ish || ppc)
-> Left (MO_U_QuotRem W8)
| otherwise -> Right (genericWordQuotRemOp W8)
- Word16QuotRemOp| (ncg && x86ish)
+ Word16QuotRemOp| ncg && (x86ish || ppc)
-> Left (MO_U_QuotRem W16)
| otherwise -> Right (genericWordQuotRemOp W16)
- WordAdd2Op | (ncg && (x86ish
- || ppc))
+ WordAdd2Op | (ncg && (x86ish || ppc))
|| llvm -> Left (MO_Add2 (wordWidth dflags))
| otherwise -> Right genericWordAdd2Op
- WordAddCOp | (ncg && (x86ish
- || ppc))
+ WordAddCOp | (ncg && (x86ish || ppc))
|| llvm -> Left (MO_AddWordC (wordWidth dflags))
| otherwise -> Right genericWordAddCOp
- WordSubCOp | (ncg && (x86ish
- || ppc))
+ WordSubCOp | (ncg && (x86ish || ppc))
|| llvm -> Left (MO_SubWordC (wordWidth dflags))
| otherwise -> Right genericWordSubCOp
- IntAddCOp | (ncg && (x86ish
- || ppc))
+ IntAddCOp | (ncg && (x86ish || ppc))
|| llvm -> Left (MO_AddIntC (wordWidth dflags))
| otherwise -> Right genericIntAddCOp
- IntSubCOp | (ncg && (x86ish
- || ppc))
+ IntSubCOp | (ncg && (x86ish || ppc))
|| llvm -> Left (MO_SubIntC (wordWidth dflags))
| otherwise -> Right genericIntSubCOp
- WordMul2Op | ncg && (x86ish
- || ppc)
+ WordMul2Op | ncg && (x86ish || ppc)
|| llvm -> Left (MO_U_Mul2 (wordWidth dflags))
| otherwise -> Right genericWordMul2Op
- FloatFabsOp | (ncg && x86ish
- || ppc)
+ FloatFabsOp | (ncg && x86ish || ppc)
|| llvm -> Left MO_F32_Fabs
| otherwise -> Right $ genericFabsOp W32
- DoubleFabsOp | (ncg && x86ish
- || ppc)
+ DoubleFabsOp | (ncg && x86ish || ppc)
|| llvm -> Left MO_F64_Fabs
| otherwise -> Right $ genericFabsOp W64
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 70e4b05..a716765 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -617,8 +617,8 @@ getRegister' _ (CmmMachOp mop [x, y]) -- dyadic PrimOps
MO_S_Quot rep -> divCode rep True x y
MO_U_Quot rep -> divCode rep False x y
- MO_S_Rem rep -> remainderCode rep True x y
- MO_U_Rem rep -> remainderCode rep False x y
+ MO_S_Rem rep -> remainder rep True x y
+ MO_U_Rem rep -> remainder rep False x y
MO_And rep -> case y of
(CmmLit (CmmInt imm _)) | imm == -8 || imm == -4
@@ -642,6 +642,14 @@ getRegister' _ (CmmMachOp mop [x, y]) -- dyadic PrimOps
triv_float :: Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register
triv_float width instr = trivialCodeNoImm (floatFormat width) instr x y
+ remainder :: Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
+ remainder rep sgn x y = do
+ let fmt = intFormat rep
+ tmp <- getNewRegNat fmt
+ code <- remainderCode rep sgn tmp x y
+ return (Any fmt code)
+
+
getRegister' _ (CmmLit (CmmInt i rep))
| Just imm <- makeImmediate rep True i
= let
@@ -1300,14 +1308,8 @@ genCCall target dest_regs argsAndHints
where divOp1 platform signed width [res_q, res_r] [arg_x, arg_y]
= do let reg_q = getRegisterReg platform (CmmLocal res_q)
reg_r = getRegisterReg platform (CmmLocal res_r)
- fmt = intFormat width
- (x_reg, x_code) <- getSomeReg arg_x
- (y_reg, y_code) <- getSomeReg arg_y
- return $ y_code `appOL` x_code
- `appOL` toOL [ DIV fmt signed reg_q x_reg y_reg
- , MULL fmt reg_r reg_q (RIReg y_reg)
- , SUBF reg_r reg_r x_reg
- ]
+ remainderCode width signed reg_q arg_x arg_y
+ <*> pure reg_r
divOp1 _ _ _ _ _
= panic "genCCall: Wrong number of arguments for divOp1"
@@ -2271,19 +2273,20 @@ trivialUCode rep instr x = do
-- it the hard way.
-- The "sgn" parameter is the signedness for the division instruction
-remainderCode :: Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
-remainderCode rep sgn x y = do
+remainderCode :: Width -> Bool -> Reg -> CmmExpr -> CmmExpr
+ -> NatM (Reg -> InstrBlock)
+remainderCode rep sgn reg_q arg_x arg_y = do
let op_len = max W32 rep
- ins_fmt = intFormat op_len
+ fmt = intFormat op_len
extend = if sgn then extendSExpr else extendUExpr
- (src1, code1) <- getSomeReg (extend rep op_len x)
- (src2, code2) <- getSomeReg (extend rep op_len y)
- let code dst = code1 `appOL` code2 `appOL` toOL [
- DIV ins_fmt sgn dst src1 src2,
- MULL ins_fmt dst dst (RIReg src2),
- SUBF dst dst src1
- ]
- return (Any (intFormat rep) code)
+ (x_reg, x_code) <- getSomeReg (extend rep op_len arg_x)
+ (y_reg, y_code) <- getSomeReg (extend rep op_len arg_y)
+ return $ \reg_r -> y_code `appOL` x_code
+ `appOL` toOL [ DIV fmt sgn reg_q x_reg y_reg
+ , MULL fmt reg_r reg_q (RIReg y_reg)
+ , SUBF reg_r reg_r x_reg
+ ]
+
coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
coerceInt2FP fromRep toRep x = do
More information about the ghc-commits
mailing list