diff options
Diffstat (limited to 'compiler/nativeGen/PPC')
| -rw-r--r-- | compiler/nativeGen/PPC/CodeGen.hs | 5 | ||||
| -rw-r--r-- | compiler/nativeGen/PPC/Instr.hs | 47 | ||||
| -rw-r--r-- | compiler/nativeGen/PPC/Ppr.hs | 140 |
3 files changed, 98 insertions, 94 deletions
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 71373ee21d..4560266884 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -404,11 +404,12 @@ getRegister' dflags (CmmMachOp (MO_SS_Conv W64 W32) [x]) ChildCode64 code rlo <- iselExpr64 x return $ Fixed II32 rlo code -getRegister' _ (CmmLoad mem pk) +getRegister' dflags (CmmLoad mem pk) | not (isWord64 pk) = do + let platform = targetPlatform dflags Amode addr addr_code <- getAmode mem - let code dst = ASSERT((targetClassOfReg dst == RcDouble) == isFloatType pk) + let code dst = ASSERT((targetClassOfReg platform dst == RcDouble) == isFloatType pk) addr_code `snocOL` LD size dst addr return (Any size code) where size = cmmTypeSize pk diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs index d13d6afca6..ffe5408033 100644 --- a/compiler/nativeGen/PPC/Instr.hs +++ b/compiler/nativeGen/PPC/Instr.hs @@ -32,6 +32,7 @@ import OldCmm import FastString import CLabel import Outputable +import Platform import FastBool -------------------------------------------------------------------------------- @@ -43,18 +44,18 @@ archWordSize = II32 -- | Instruction instance for powerpc instance Instruction Instr where - regUsageOfInstr = ppc_regUsageOfInstr - patchRegsOfInstr = ppc_patchRegsOfInstr - isJumpishInstr = ppc_isJumpishInstr - jumpDestsOfInstr = ppc_jumpDestsOfInstr - patchJumpInstr = ppc_patchJumpInstr - mkSpillInstr = ppc_mkSpillInstr - mkLoadInstr = ppc_mkLoadInstr - takeDeltaInstr = ppc_takeDeltaInstr - isMetaInstr = ppc_isMetaInstr - mkRegRegMoveInstr = ppc_mkRegRegMoveInstr - takeRegRegMoveInstr = ppc_takeRegRegMoveInstr - mkJumpInstr = ppc_mkJumpInstr + regUsageOfInstr = ppc_regUsageOfInstr + patchRegsOfInstr = ppc_patchRegsOfInstr + isJumpishInstr = ppc_isJumpishInstr + jumpDestsOfInstr = ppc_jumpDestsOfInstr + patchJumpInstr = ppc_patchJumpInstr + mkSpillInstr = ppc_mkSpillInstr + mkLoadInstr = ppc_mkLoadInstr + takeDeltaInstr = ppc_takeDeltaInstr + isMetaInstr = ppc_isMetaInstr + mkRegRegMoveInstr _ = ppc_mkRegRegMoveInstr + takeRegRegMoveInstr = ppc_takeRegRegMoveInstr + mkJumpInstr = ppc_mkJumpInstr -- ----------------------------------------------------------------------------- @@ -346,15 +347,16 @@ ppc_patchJumpInstr insn patchF -- | An instruction to spill a register into a spill slot. ppc_mkSpillInstr - :: Reg -- register to spill - -> Int -- current stack delta - -> Int -- spill slot to use + :: Platform + -> Reg -- register to spill + -> Int -- current stack delta + -> Int -- spill slot to use -> Instr -ppc_mkSpillInstr reg delta slot +ppc_mkSpillInstr platform reg delta slot = let off = spillSlotToOffset slot in - let sz = case targetClassOfReg reg of + let sz = case targetClassOfReg platform reg of RcInteger -> II32 RcDouble -> FF64 _ -> panic "PPC.Instr.mkSpillInstr: no match" @@ -362,15 +364,16 @@ ppc_mkSpillInstr reg delta slot ppc_mkLoadInstr - :: Reg -- register to load - -> Int -- current stack delta - -> Int -- spill slot to use + :: Platform + -> Reg -- register to load + -> Int -- current stack delta + -> Int -- spill slot to use -> Instr -ppc_mkLoadInstr reg delta slot +ppc_mkLoadInstr platform reg delta slot = let off = spillSlotToOffset slot in - let sz = case targetClassOfReg reg of + let sz = case targetClassOfReg platform reg of RcInteger -> II32 RcDouble -> FF64 _ -> panic "PPC.Instr.mkLoadInstr: no match" diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs index de8db68e65..54056c9e4d 100644 --- a/compiler/nativeGen/PPC/Ppr.hs +++ b/compiler/nativeGen/PPC/Ppr.hs @@ -58,12 +58,12 @@ pprNatCmmTop _ (CmmData section dats) = pprNatCmmTop _ (CmmProc Nothing lbl (ListGraph [])) = pprLabel lbl -- special case for code without an info table: -pprNatCmmTop _ (CmmProc Nothing lbl (ListGraph blocks)) = +pprNatCmmTop platform (CmmProc Nothing lbl (ListGraph blocks)) = pprSectionHeader Text $$ pprLabel lbl $$ -- blocks guaranteed not null, so label needed - vcat (map pprBasicBlock blocks) + vcat (map (pprBasicBlock platform) blocks) -pprNatCmmTop _ (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) = +pprNatCmmTop platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) = pprSectionHeader Text $$ ( #if HAVE_SUBSECTIONS_VIA_SYMBOLS @@ -73,7 +73,7 @@ pprNatCmmTop _ (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blo vcat (map pprData info) $$ pprLabel info_lbl ) $$ - vcat (map pprBasicBlock blocks) + vcat (map (pprBasicBlock platform) blocks) -- above: Even the first block gets a label, because with branch-chain -- elimination, it might be the target of a goto. #if HAVE_SUBSECTIONS_VIA_SYMBOLS @@ -90,10 +90,10 @@ pprNatCmmTop _ (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blo #endif -pprBasicBlock :: NatBasicBlock Instr -> Doc -pprBasicBlock (BasicBlock blockid instrs) = +pprBasicBlock :: Platform -> NatBasicBlock Instr -> Doc +pprBasicBlock platform (BasicBlock blockid instrs) = pprLabel (mkAsmTempLabel (getUnique blockid)) $$ - vcat (map pprInstr instrs) + vcat (map (pprInstr platform) instrs) @@ -143,7 +143,7 @@ pprASCII str -- pprInstr: print an 'Instr' instance PlatformOutputable Instr where - pprPlatform _ instr = Outputable.docToSDoc $ pprInstr instr + pprPlatform platform instr = Outputable.docToSDoc $ pprInstr platform instr pprReg :: Reg -> Doc @@ -337,26 +337,26 @@ pprDataItem lit = panic "PPC.Ppr.pprDataItem: no match" -pprInstr :: Instr -> Doc +pprInstr :: Platform -> Instr -> Doc -pprInstr (COMMENT _) = empty -- nuke 'em +pprInstr _ (COMMENT _) = empty -- nuke 'em {- -pprInstr (COMMENT s) +pprInstr _ (COMMENT s) IF_OS_linux( ((<>) (ptext (sLit "# ")) (ftext s)), ((<>) (ptext (sLit "; ")) (ftext s))) -} -pprInstr (DELTA d) - = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d))) +pprInstr platform (DELTA d) + = pprInstr platform (COMMENT (mkFastString ("\tdelta = " ++ show d))) -pprInstr (NEWBLOCK _) +pprInstr _ (NEWBLOCK _) = panic "PprMach.pprInstr: NEWBLOCK" -pprInstr (LDATA _ _) +pprInstr _ (LDATA _ _) = panic "PprMach.pprInstr: LDATA" {- -pprInstr (SPILL reg slot) +pprInstr _ (SPILL reg slot) = hcat [ ptext (sLit "\tSPILL"), char '\t', @@ -364,7 +364,7 @@ pprInstr (SPILL reg slot) comma, ptext (sLit "SLOT") <> parens (int slot)] -pprInstr (RELOAD slot reg) +pprInstr _ (RELOAD slot reg) = hcat [ ptext (sLit "\tRELOAD"), char '\t', @@ -373,7 +373,7 @@ pprInstr (RELOAD slot reg) pprReg reg] -} -pprInstr (LD sz reg addr) = hcat [ +pprInstr _ (LD sz reg addr) = hcat [ char '\t', ptext (sLit "l"), ptext (case sz of @@ -391,7 +391,7 @@ pprInstr (LD sz reg addr) = hcat [ ptext (sLit ", "), pprAddr addr ] -pprInstr (LA sz reg addr) = hcat [ +pprInstr _ (LA sz reg addr) = hcat [ char '\t', ptext (sLit "l"), ptext (case sz of @@ -409,7 +409,7 @@ pprInstr (LA sz reg addr) = hcat [ ptext (sLit ", "), pprAddr addr ] -pprInstr (ST sz reg addr) = hcat [ +pprInstr _ (ST sz reg addr) = hcat [ char '\t', ptext (sLit "st"), pprSize sz, @@ -420,7 +420,7 @@ pprInstr (ST sz reg addr) = hcat [ ptext (sLit ", "), pprAddr addr ] -pprInstr (STU sz reg addr) = hcat [ +pprInstr _ (STU sz reg addr) = hcat [ char '\t', ptext (sLit "st"), pprSize sz, @@ -431,7 +431,7 @@ pprInstr (STU sz reg addr) = hcat [ ptext (sLit ", "), pprAddr addr ] -pprInstr (LIS reg imm) = hcat [ +pprInstr _ (LIS reg imm) = hcat [ char '\t', ptext (sLit "lis"), char '\t', @@ -439,7 +439,7 @@ pprInstr (LIS reg imm) = hcat [ ptext (sLit ", "), pprImm imm ] -pprInstr (LI reg imm) = hcat [ +pprInstr _ (LI reg imm) = hcat [ char '\t', ptext (sLit "li"), char '\t', @@ -447,11 +447,11 @@ pprInstr (LI reg imm) = hcat [ ptext (sLit ", "), pprImm imm ] -pprInstr (MR reg1 reg2) +pprInstr platform (MR reg1 reg2) | reg1 == reg2 = empty | otherwise = hcat [ char '\t', - case targetClassOfReg reg1 of + case targetClassOfReg platform reg1 of RcInteger -> ptext (sLit "mr") _ -> ptext (sLit "fmr"), char '\t', @@ -459,7 +459,7 @@ pprInstr (MR reg1 reg2) ptext (sLit ", "), pprReg reg2 ] -pprInstr (CMP sz reg ri) = hcat [ +pprInstr _ (CMP sz reg ri) = hcat [ char '\t', op, char '\t', @@ -475,7 +475,7 @@ pprInstr (CMP sz reg ri) = hcat [ RIReg _ -> empty RIImm _ -> char 'i' ] -pprInstr (CMPL sz reg ri) = hcat [ +pprInstr _ (CMPL sz reg ri) = hcat [ char '\t', op, char '\t', @@ -491,7 +491,7 @@ pprInstr (CMPL sz reg ri) = hcat [ RIReg _ -> empty RIImm _ -> char 'i' ] -pprInstr (BCC cond blockid) = hcat [ +pprInstr _ (BCC cond blockid) = hcat [ char '\t', ptext (sLit "b"), pprCond cond, @@ -500,7 +500,7 @@ pprInstr (BCC cond blockid) = hcat [ ] where lbl = mkAsmTempLabel (getUnique blockid) -pprInstr (BCCFAR cond blockid) = vcat [ +pprInstr _ (BCCFAR cond blockid) = vcat [ hcat [ ptext (sLit "\tb"), pprCond (condNegate cond), @@ -513,33 +513,33 @@ pprInstr (BCCFAR cond blockid) = vcat [ ] where lbl = mkAsmTempLabel (getUnique blockid) -pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel +pprInstr _ (JMP lbl) = hcat [ -- an alias for b that takes a CLabel char '\t', ptext (sLit "b"), char '\t', pprCLabel_asm lbl ] -pprInstr (MTCTR reg) = hcat [ +pprInstr _ (MTCTR reg) = hcat [ char '\t', ptext (sLit "mtctr"), char '\t', pprReg reg ] -pprInstr (BCTR _ _) = hcat [ +pprInstr _ (BCTR _ _) = hcat [ char '\t', ptext (sLit "bctr") ] -pprInstr (BL lbl _) = hcat [ +pprInstr _ (BL lbl _) = hcat [ ptext (sLit "\tbl\t"), pprCLabel_asm lbl ] -pprInstr (BCTRL _) = hcat [ +pprInstr _ (BCTRL _) = hcat [ char '\t', ptext (sLit "bctrl") ] -pprInstr (ADD reg1 reg2 ri) = pprLogic (sLit "add") reg1 reg2 ri -pprInstr (ADDIS reg1 reg2 imm) = hcat [ +pprInstr _ (ADD reg1 reg2 ri) = pprLogic (sLit "add") reg1 reg2 ri +pprInstr _ (ADDIS reg1 reg2 imm) = hcat [ char '\t', ptext (sLit "addis"), char '\t', @@ -550,15 +550,15 @@ pprInstr (ADDIS reg1 reg2 imm) = hcat [ pprImm imm ] -pprInstr (ADDC reg1 reg2 reg3) = pprLogic (sLit "addc") reg1 reg2 (RIReg reg3) -pprInstr (ADDE reg1 reg2 reg3) = pprLogic (sLit "adde") reg1 reg2 (RIReg reg3) -pprInstr (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3) -pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mullw") reg1 reg2 ri -pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic (sLit "mull") reg1 reg2 ri -pprInstr (DIVW reg1 reg2 reg3) = pprLogic (sLit "divw") reg1 reg2 (RIReg reg3) -pprInstr (DIVWU reg1 reg2 reg3) = pprLogic (sLit "divwu") reg1 reg2 (RIReg reg3) +pprInstr _ (ADDC reg1 reg2 reg3) = pprLogic (sLit "addc") reg1 reg2 (RIReg reg3) +pprInstr _ (ADDE reg1 reg2 reg3) = pprLogic (sLit "adde") reg1 reg2 (RIReg reg3) +pprInstr _ (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3) +pprInstr _ (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mullw") reg1 reg2 ri +pprInstr _ (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic (sLit "mull") reg1 reg2 ri +pprInstr _ (DIVW reg1 reg2 reg3) = pprLogic (sLit "divw") reg1 reg2 (RIReg reg3) +pprInstr _ (DIVWU reg1 reg2 reg3) = pprLogic (sLit "divwu") reg1 reg2 (RIReg reg3) -pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [ +pprInstr _ (MULLW_MayOflo reg1 reg2 reg3) = vcat [ hcat [ ptext (sLit "\tmullwo\t"), pprReg reg1, ptext (sLit ", "), pprReg reg2, ptext (sLit ", "), pprReg reg3 ], @@ -570,7 +570,7 @@ pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [ -- for some reason, "andi" doesn't exist. -- we'll use "andi." instead. -pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [ +pprInstr _ (AND reg1 reg2 (RIImm imm)) = hcat [ char '\t', ptext (sLit "andi."), char '\t', @@ -580,12 +580,12 @@ pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [ ptext (sLit ", "), pprImm imm ] -pprInstr (AND reg1 reg2 ri) = pprLogic (sLit "and") reg1 reg2 ri +pprInstr _ (AND reg1 reg2 ri) = pprLogic (sLit "and") reg1 reg2 ri -pprInstr (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri -pprInstr (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri +pprInstr _ (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri +pprInstr _ (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri -pprInstr (XORIS reg1 reg2 imm) = hcat [ +pprInstr _ (XORIS reg1 reg2 imm) = hcat [ char '\t', ptext (sLit "xoris"), char '\t', @@ -596,7 +596,7 @@ pprInstr (XORIS reg1 reg2 imm) = hcat [ pprImm imm ] -pprInstr (EXTS sz reg1 reg2) = hcat [ +pprInstr _ (EXTS sz reg1 reg2) = hcat [ char '\t', ptext (sLit "exts"), pprSize sz, @@ -606,13 +606,13 @@ pprInstr (EXTS sz reg1 reg2) = hcat [ pprReg reg2 ] -pprInstr (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2 -pprInstr (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2 +pprInstr _ (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2 +pprInstr _ (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2 -pprInstr (SLW reg1 reg2 ri) = pprLogic (sLit "slw") reg1 reg2 (limitShiftRI ri) -pprInstr (SRW reg1 reg2 ri) = pprLogic (sLit "srw") reg1 reg2 (limitShiftRI ri) -pprInstr (SRAW reg1 reg2 ri) = pprLogic (sLit "sraw") reg1 reg2 (limitShiftRI ri) -pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [ +pprInstr _ (SLW reg1 reg2 ri) = pprLogic (sLit "slw") reg1 reg2 (limitShiftRI ri) +pprInstr _ (SRW reg1 reg2 ri) = pprLogic (sLit "srw") reg1 reg2 (limitShiftRI ri) +pprInstr _ (SRAW reg1 reg2 ri) = pprLogic (sLit "sraw") reg1 reg2 (limitShiftRI ri) +pprInstr _ (RLWINM reg1 reg2 sh mb me) = hcat [ ptext (sLit "\trlwinm\t"), pprReg reg1, ptext (sLit ", "), @@ -625,13 +625,13 @@ pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [ int me ] -pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF (sLit "fadd") sz reg1 reg2 reg3 -pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF (sLit "fsub") sz reg1 reg2 reg3 -pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF (sLit "fmul") sz reg1 reg2 reg3 -pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") sz reg1 reg2 reg3 -pprInstr (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2 +pprInstr _ (FADD sz reg1 reg2 reg3) = pprBinaryF (sLit "fadd") sz reg1 reg2 reg3 +pprInstr _ (FSUB sz reg1 reg2 reg3) = pprBinaryF (sLit "fsub") sz reg1 reg2 reg3 +pprInstr _ (FMUL sz reg1 reg2 reg3) = pprBinaryF (sLit "fmul") sz reg1 reg2 reg3 +pprInstr _ (FDIV sz reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") sz reg1 reg2 reg3 +pprInstr _ (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2 -pprInstr (FCMP reg1 reg2) = hcat [ +pprInstr _ (FCMP reg1 reg2) = hcat [ char '\t', ptext (sLit "fcmpu\tcr0, "), -- Note: we're using fcmpu, not fcmpo @@ -642,10 +642,10 @@ pprInstr (FCMP reg1 reg2) = hcat [ pprReg reg2 ] -pprInstr (FCTIWZ reg1 reg2) = pprUnary (sLit "fctiwz") reg1 reg2 -pprInstr (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2 +pprInstr _ (FCTIWZ reg1 reg2) = pprUnary (sLit "fctiwz") reg1 reg2 +pprInstr _ (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2 -pprInstr (CRNOR dst src1 src2) = hcat [ +pprInstr _ (CRNOR dst src1 src2) = hcat [ ptext (sLit "\tcrnor\t"), int dst, ptext (sLit ", "), @@ -654,28 +654,28 @@ pprInstr (CRNOR dst src1 src2) = hcat [ int src2 ] -pprInstr (MFCR reg) = hcat [ +pprInstr _ (MFCR reg) = hcat [ char '\t', ptext (sLit "mfcr"), char '\t', pprReg reg ] -pprInstr (MFLR reg) = hcat [ +pprInstr _ (MFLR reg) = hcat [ char '\t', ptext (sLit "mflr"), char '\t', pprReg reg ] -pprInstr (FETCHPC reg) = vcat [ +pprInstr _ (FETCHPC reg) = vcat [ ptext (sLit "\tbcl\t20,31,1f"), hcat [ ptext (sLit "1:\tmflr\t"), pprReg reg ] ] -pprInstr LWSYNC = ptext (sLit "\tlwsync") +pprInstr _ LWSYNC = ptext (sLit "\tlwsync") --- pprInstr _ = panic "pprInstr (ppc)" +-- pprInstr _ _ = panic "pprInstr (ppc)" pprLogic :: LitString -> Reg -> Reg -> RI -> Doc |