Commit 730301c6 authored by Ian Lynagh's avatar Ian Lynagh

Remove more defaultTargetPlatform uses

parent 5c718b15
......@@ -245,7 +245,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
dumpIfSet_dyn dflags
Opt_D_dump_asm_conflicts "Register conflict graph"
$ Color.dotGraph
targetRegDotColor
(targetRegDotColor platform)
(Color.trivColorable platform
(targetVirtualRegSqueeze platform)
(targetRealRegSqueeze platform))
......@@ -386,7 +386,7 @@ cmmNativeGen dflags ncgImpl us cmm count
-- the regs usable for allocation
let (alloc_regs :: UniqFM (UniqSet RealReg))
= foldr (\r -> plusUFM_C unionUniqSets
$ unitUFM (targetClassOfRealReg r) (unitUniqSet r))
$ unitUFM (targetClassOfRealReg platform r) (unitUniqSet r))
emptyUFM
$ allocatableRegs ncgImpl
......
......@@ -14,6 +14,7 @@ import Reg
import BlockId
import OldCmm
import Platform
-- | Holds a list of source and destination registers used by a
-- particular instruction.
......@@ -103,7 +104,8 @@ class Instruction instr where
-- | An instruction to spill a register into a spill slot.
mkSpillInstr
:: Reg -- ^ the reg to spill
:: Platform
-> Reg -- ^ the reg to spill
-> Int -- ^ the current stack delta
-> Int -- ^ spill slot to use
-> instr
......@@ -111,7 +113,8 @@ class Instruction instr where
-- | An instruction to reload a register from a spill slot.
mkLoadInstr
:: Reg -- ^ the reg to reload.
:: Platform
-> Reg -- ^ the reg to reload.
-> Int -- ^ the current stack delta
-> Int -- ^ the spill slot to use
-> instr
......@@ -137,7 +140,8 @@ class Instruction instr where
-- | Copy the value in a register to another one.
-- Must work for all register classes.
mkRegRegMoveInstr
:: Reg -- ^ source register
:: Platform
-> Reg -- ^ source register
-> Reg -- ^ destination register
-> instr
......
......@@ -130,18 +130,20 @@ getNewLabelNat
getNewRegNat :: Size -> NatM Reg
getNewRegNat rep
= do u <- getUniqueNat
return (RegVirtual $ targetMkVirtualReg u rep)
getNewRegNat rep
= do u <- getUniqueNat
dflags <- getDynFlagsNat
return (RegVirtual $ targetMkVirtualReg (targetPlatform dflags) u rep)
getNewRegPairNat :: Size -> NatM (Reg,Reg)
getNewRegPairNat rep
= do u <- getUniqueNat
let vLo = targetMkVirtualReg u rep
let lo = RegVirtual $ targetMkVirtualReg u rep
let hi = RegVirtual $ getHiVirtualRegFromLo vLo
return (lo, hi)
getNewRegPairNat rep
= do u <- getUniqueNat
dflags <- getDynFlagsNat
let vLo = targetMkVirtualReg (targetPlatform dflags) u rep
let lo = RegVirtual $ targetMkVirtualReg (targetPlatform dflags) u rep
let hi = RegVirtual $ getHiVirtualRegFromLo vLo
return (lo, hi)
getPicBaseMaybeNat :: NatM (Maybe Reg)
......
......@@ -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
......
......@@ -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"
......
......@@ -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
......
......@@ -165,7 +165,7 @@ regAlloc_spin
let code_patched = map (patchRegsFromGraph platform graph_colored_lint) code_coalesced
-- clean out unneeded SPILL/RELOADs
let code_spillclean = map cleanSpills code_patched
let code_spillclean = map (cleanSpills platform) code_patched
-- strip off liveness information,
-- and rewrite SPILL/RELOAD pseudos into real instructions along the way
......
......@@ -39,6 +39,7 @@ import UniqFM
import Unique
import State
import Outputable
import Platform
import Data.List
import Data.Maybe
......@@ -52,22 +53,23 @@ type Slot = Int
-- | Clean out unneeded spill\/reloads from this top level thing.
cleanSpills
:: Instruction instr
=> LiveCmmTop statics instr -> LiveCmmTop statics instr
cleanSpills
:: Instruction instr
=> Platform -> LiveCmmTop statics instr -> LiveCmmTop statics instr
cleanSpills cmm
= evalState (cleanSpin 0 cmm) initCleanS
cleanSpills platform cmm
= evalState (cleanSpin platform 0 cmm) initCleanS
-- | do one pass of cleaning
cleanSpin
:: Instruction instr
=> Int
-> LiveCmmTop statics instr
-> CleanM (LiveCmmTop statics instr)
cleanSpin
:: Instruction instr
=> Platform
-> Int
-> LiveCmmTop statics instr
-> CleanM (LiveCmmTop statics instr)
{-
cleanSpin spinCount code
cleanSpin _ spinCount code
= do jumpValid <- gets sJumpValid
pprTrace "cleanSpin"
( int spinCount
......@@ -78,7 +80,7 @@ cleanSpin spinCount code
$ cleanSpin' spinCount code
-}
cleanSpin spinCount code
cleanSpin platform spinCount code
= do
-- init count of cleaned spills\/reloads
modify $ \s -> s
......@@ -86,7 +88,7 @@ cleanSpin spinCount code
, sCleanedReloadsAcc = 0
, sReloadedBy = emptyUFM }
code_forward <- mapBlockTopM cleanBlockForward code
code_forward <- mapBlockTopM (cleanBlockForward platform) code
code_backward <- cleanTopBackward code_forward
-- During the cleaning of each block we collected information about what regs
......@@ -107,16 +109,17 @@ cleanSpin spinCount code
then return code
-- otherwise go around again
else cleanSpin (spinCount + 1) code_backward
else cleanSpin platform (spinCount + 1) code_backward