summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/nativeGen/PPC/CodeGen.hs40
-rw-r--r--compiler/nativeGen/PPC/Instr.hs35
-rw-r--r--compiler/nativeGen/PPC/Ppr.hs4
-rw-r--r--compiler/nativeGen/PPC/Regs.hs12
4 files changed, 49 insertions, 42 deletions
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 516a49aee3..c640ba115f 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -180,10 +180,16 @@ stmtToInstrs stmt = do
return (b1 `appOL` b2)
CmmSwitch arg ids -> do dflags <- getDynFlags
genSwitch dflags arg ids
- CmmCall { cml_target = arg } -> genJump arg
+ CmmCall { cml_target = arg
+ , cml_args_regs = gregs } -> do
+ dflags <- getDynFlags
+ genJump arg (jumpRegs dflags gregs)
_ ->
panic "stmtToInstrs: statement should have been cps'd away"
+jumpRegs :: DynFlags -> [GlobalReg] -> [Reg]
+jumpRegs dflags gregs = [ RegReal r | Just r <- map (globalRegMaybe platform) gregs ]
+ where platform = targetPlatform dflags
--------------------------------------------------------------------------------
-- | 'InstrBlock's are the insn sequences generated by the insn selectors.
@@ -1042,19 +1048,19 @@ assignReg_FltCode = assignReg_IntCode
-genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
+genJump :: CmmExpr{-the branch target-} -> [Reg] -> NatM InstrBlock
-genJump (CmmLit (CmmLabel lbl))
- = return (unitOL $ JMP lbl)
+genJump (CmmLit (CmmLabel lbl)) regs
+ = return (unitOL $ JMP lbl regs)
-genJump tree
+genJump tree gregs
= do
dflags <- getDynFlags
- genJump' tree (platformToGCP (targetPlatform dflags))
+ genJump' tree (platformToGCP (targetPlatform dflags)) gregs
-genJump' :: CmmExpr -> GenCCallPlatform -> NatM InstrBlock
+genJump' :: CmmExpr -> GenCCallPlatform -> [Reg] -> NatM InstrBlock
-genJump' tree (GCP64ELF 1)
+genJump' tree (GCP64ELF 1) regs
= do
(target,code) <- getSomeReg tree
return (code
@@ -1062,20 +1068,20 @@ genJump' tree (GCP64ELF 1)
`snocOL` LD II64 toc (AddrRegImm target (ImmInt 8))
`snocOL` MTCTR r11
`snocOL` LD II64 r11 (AddrRegImm target (ImmInt 16))
- `snocOL` BCTR [] Nothing)
+ `snocOL` BCTR [] Nothing regs)
-genJump' tree (GCP64ELF 2)
+genJump' tree (GCP64ELF 2) regs
= do
(target,code) <- getSomeReg tree
return (code
`snocOL` MR r12 target
`snocOL` MTCTR r12
- `snocOL` BCTR [] Nothing)
+ `snocOL` BCTR [] Nothing regs)
-genJump' tree _
+genJump' tree _ regs
= do
(target,code) <- getSomeReg tree
- return (code `snocOL` MTCTR target `snocOL` BCTR [] Nothing)
+ return (code `snocOL` MTCTR target `snocOL` BCTR [] Nothing regs)
-- -----------------------------------------------------------------------------
-- Unconditional branches
@@ -2044,7 +2050,7 @@ genSwitch dflags expr targets
SL fmt tmp reg (RIImm (ImmInt sha)),
LD fmt tmp (AddrRegReg tableReg tmp),
MTCTR tmp,
- BCTR ids (Just lbl)
+ BCTR ids (Just lbl) []
]
return code
@@ -2062,7 +2068,7 @@ genSwitch dflags expr targets
LD fmt tmp (AddrRegReg tableReg tmp),
ADD tmp tmp (RIReg tableReg),
MTCTR tmp,
- BCTR ids (Just lbl)
+ BCTR ids (Just lbl) []
]
return code
| otherwise
@@ -2077,14 +2083,14 @@ genSwitch dflags expr targets
ADDIS tmp tmp (HA (ImmCLbl lbl)),
LD fmt tmp (AddrRegImm tmp (LO (ImmCLbl lbl))),
MTCTR tmp,
- BCTR ids (Just lbl)
+ BCTR ids (Just lbl) []
]
return code
where (offset, ids) = switchTargetsToTable targets
generateJumpTableForInstr :: DynFlags -> Instr
-> Maybe (NatCmmDecl CmmStatics Instr)
-generateJumpTableForInstr dflags (BCTR ids (Just lbl)) =
+generateJumpTableForInstr dflags (BCTR ids (Just lbl) _) =
let jumpTable
| (positionIndependent dflags)
|| (not $ target32Bit $ targetPlatform dflags)
diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index e618e189b8..79cc7aeefb 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -151,12 +151,12 @@ allocMoreStack platform slots (CmmProc info lbl live (ListGraph code)) = do
-- "labeled-goto" we use JMP, and for "computed-goto" we
-- use MTCTR followed by BCTR. See 'PPC.CodeGen.genJump'.
= case insn of
- JMP _ -> dealloc ++ (insn : r)
- BCTR [] Nothing -> dealloc ++ (insn : r)
- BCTR ids label -> BCTR (map (fmap retarget) ids) label : r
- BCCFAR cond b p -> BCCFAR cond (retarget b) p : r
- BCC cond b p -> BCC cond (retarget b) p : r
- _ -> insn : r
+ JMP _ _ -> dealloc ++ (insn : r)
+ BCTR [] Nothing _ -> dealloc ++ (insn : r)
+ BCTR ids label rs -> BCTR (map (fmap retarget) ids) label rs : r
+ BCCFAR cond b p -> BCCFAR cond (retarget b) p : r
+ BCC cond b p -> BCC cond (retarget b) p : r
+ _ -> insn : r
-- BL and BCTRL are call-like instructions rather than
-- jumps, and are used only for C calls.
@@ -223,10 +223,13 @@ data Instr
-- Just True: branch likely taken
-- Just False: branch likely not taken
-- Nothing: no hint
- | JMP CLabel -- same as branch,
+ | JMP CLabel [Reg] -- same as branch,
-- but with CLabel instead of block ID
+ -- and live global registers
| MTCTR Reg
- | BCTR [Maybe BlockId] (Maybe CLabel) -- with list of local destinations, and jump table location if necessary
+ | BCTR [Maybe BlockId] (Maybe CLabel) [Reg]
+ -- with list of local destinations, and
+ -- jump table location if necessary
| BL CLabel [Reg] -- with list of argument regs
| BCTRL [Reg]
@@ -324,8 +327,9 @@ ppc_regUsageOfInstr platform instr
CMPL _ reg ri -> usage (reg : regRI ri,[])
BCC _ _ _ -> noUsage
BCCFAR _ _ _ -> noUsage
+ JMP _ regs -> usage (regs, [])
MTCTR reg -> usage ([reg],[])
- BCTR _ _ -> noUsage
+ BCTR _ _ regs -> usage (regs, [])
BL _ params -> usage (params, callClobberedRegs platform)
BCTRL params -> usage (params, callClobberedRegs platform)
@@ -416,8 +420,9 @@ ppc_patchRegsOfInstr instr env
CMPL fmt reg ri -> CMPL fmt (env reg) (fixRI ri)
BCC cond lbl p -> BCC cond lbl p
BCCFAR cond lbl p -> BCCFAR cond lbl p
+ JMP l regs -> JMP l regs -- global regs will not be remapped
MTCTR reg -> MTCTR (env reg)
- BCTR targets lbl -> BCTR targets lbl
+ BCTR targets lbl rs -> BCTR targets lbl rs
BL imm argRegs -> BL imm argRegs -- argument regs
BCTRL argRegs -> BCTRL argRegs -- cannot be remapped
ADD reg1 reg2 ri -> ADD (env reg1) (env reg2) (fixRI ri)
@@ -506,10 +511,10 @@ ppc_isJumpishInstr instr
ppc_jumpDestsOfInstr :: Instr -> [BlockId]
ppc_jumpDestsOfInstr insn
= case insn of
- BCC _ id _ -> [id]
- BCCFAR _ id _ -> [id]
- BCTR targets _ -> [id | Just id <- targets]
- _ -> []
+ BCC _ id _ -> [id]
+ BCCFAR _ id _ -> [id]
+ BCTR targets _ _ -> [id | Just id <- targets]
+ _ -> []
-- | Change the destination of this jump instruction.
@@ -520,7 +525,7 @@ ppc_patchJumpInstr insn patchF
= case insn of
BCC cc id p -> BCC cc (patchF id) p
BCCFAR cc id p -> BCCFAR cc (patchF id) p
- BCTR ids lbl -> BCTR (map (fmap patchF) ids) lbl
+ BCTR ids lbl rs -> BCTR (map (fmap patchF) ids) lbl rs
_ -> insn
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index c4eb0811bd..23525ffb5a 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -548,7 +548,7 @@ pprInstr (BCCFAR cond blockid prediction) = vcat [
Just True -> char '-'
Just False -> char '+'
-pprInstr (JMP lbl)
+pprInstr (JMP lbl _)
-- We never jump to ForeignLabels; if we ever do, c.f. handling for "BL"
| isForeignLabel lbl = panic "PPC.Ppr.pprInstr: JMP to ForeignLabel"
| otherwise =
@@ -565,7 +565,7 @@ pprInstr (MTCTR reg) = hcat [
char '\t',
pprReg reg
]
-pprInstr (BCTR _ _) = hcat [
+pprInstr (BCTR _ _ _) = hcat [
char '\t',
text "bctr"
]
diff --git a/compiler/nativeGen/PPC/Regs.hs b/compiler/nativeGen/PPC/Regs.hs
index f0b9914270..7b16f217d9 100644
--- a/compiler/nativeGen/PPC/Regs.hs
+++ b/compiler/nativeGen/PPC/Regs.hs
@@ -37,9 +37,9 @@ module PPC.Regs (
fits16Bits,
makeImmediate,
fReg,
- r0, sp, toc, r3, r4, r11, r12, r27, r28, r30,
+ r0, sp, toc, r3, r4, r11, r12, r30,
tmpReg,
- f1, f20, f21,
+ f1,
allocatableRegs
@@ -306,7 +306,7 @@ point registers.
fReg :: Int -> RegNo
fReg x = (32 + x)
-r0, sp, toc, r3, r4, r11, r12, r27, r28, r30, f1, f20, f21 :: Reg
+r0, sp, toc, r3, r4, r11, r12, r30, f1 :: Reg
r0 = regSingle 0
sp = regSingle 1
toc = regSingle 2
@@ -314,12 +314,8 @@ r3 = regSingle 3
r4 = regSingle 4
r11 = regSingle 11
r12 = regSingle 12
-r27 = regSingle 27
-r28 = regSingle 28
r30 = regSingle 30
f1 = regSingle $ fReg 1
-f20 = regSingle $ fReg 20
-f21 = regSingle $ fReg 21
-- allocatableRegs is allMachRegNos with the fixed-use regs removed.
-- i.e., these are the regs for which we are prepared to allow the
@@ -335,4 +331,4 @@ tmpReg platform =
case platformArch platform of
ArchPPC -> regSingle 13
ArchPPC_64 _ -> regSingle 30
- _ -> panic "PPC.Regs.tmpReg: unknowm arch"
+ _ -> panic "PPC.Regs.tmpReg: unknown arch"
View Lorry Controller Status