summaryrefslogtreecommitdiff
path: root/compiler/nativeGen/PPC
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/nativeGen/PPC')
-rw-r--r--compiler/nativeGen/PPC/CodeGen.hs37
-rw-r--r--compiler/nativeGen/PPC/Instr.hs10
-rw-r--r--compiler/nativeGen/PPC/Ppr.hs2
-rw-r--r--compiler/nativeGen/PPC/Regs.hs1
4 files changed, 24 insertions, 26 deletions
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 29b9a54d49..c96baddca1 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -15,6 +15,7 @@
module PPC.CodeGen (
cmmTopCodeGen,
+ generateJumpTableForInstr,
InstrBlock
)
@@ -798,7 +799,7 @@ genJump (CmmLit (CmmLabel lbl))
genJump tree
= do
(target,code) <- getSomeReg tree
- return (code `snocOL` MTCTR target `snocOL` BCTR [])
+ return (code `snocOL` MTCTR target `snocOL` BCTR [] Nothing)
-- -----------------------------------------------------------------------------
@@ -1126,22 +1127,12 @@ genSwitch expr ids
dflags <- getDynFlagsNat
dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
(tableReg,t_code) <- getSomeReg $ dynRef
- let
- jumpTable = map jumpTableEntryRel ids
-
- jumpTableEntryRel Nothing
- = CmmStaticLit (CmmInt 0 wordWidth)
- jumpTableEntryRel (Just blockid)
- = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
- where blockLabel = mkAsmTempLabel (getUnique blockid)
-
- code = e_code `appOL` t_code `appOL` toOL [
- LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
+ let code = e_code `appOL` t_code `appOL` toOL [
SLW tmp reg (RIImm (ImmInt 2)),
LD II32 tmp (AddrRegReg tableReg tmp),
ADD tmp tmp (RIReg tableReg),
MTCTR tmp,
- BCTR [ id | Just id <- ids ]
+ BCTR ids (Just lbl)
]
return code
| otherwise
@@ -1149,19 +1140,27 @@ genSwitch expr ids
(reg,e_code) <- getSomeReg expr
tmp <- getNewRegNat II32
lbl <- getNewLabelNat
- let
- jumpTable = map jumpTableEntry ids
-
- code = e_code `appOL` toOL [
- LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
+ let code = e_code `appOL` toOL [
SLW tmp reg (RIImm (ImmInt 2)),
ADDIS tmp tmp (HA (ImmCLbl lbl)),
LD II32 tmp (AddrRegImm tmp (LO (ImmCLbl lbl))),
MTCTR tmp,
- BCTR [ id | Just id <- ids ]
+ BCTR ids (Just lbl)
]
return code
+generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop Instr)
+generateJumpTableForInstr (BCTR ids (Just lbl)) =
+ let jumpTable
+ | opt_PIC = map jumpTableEntryRel ids
+ | otherwise = map jumpTableEntry ids
+ where jumpTableEntryRel Nothing
+ = CmmStaticLit (CmmInt 0 wordWidth)
+ jumpTableEntryRel (Just blockid)
+ = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
+ where blockLabel = mkAsmTempLabel (getUnique blockid)
+ in Just (CmmData ReadOnlyData (CmmDataLabel lbl : jumpTable))
+generateJumpTableForInstr _ = Nothing
-- -----------------------------------------------------------------------------
-- 'condIntReg' and 'condFltReg': condition codes into registers
diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index 6aeccd3a87..0288f1bf02 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -104,7 +104,7 @@ data Instr
| JMP CLabel -- same as branch,
-- but with CLabel instead of block ID
| MTCTR Reg
- | BCTR [BlockId] -- with list of local destinations
+ | BCTR [Maybe BlockId] (Maybe CLabel) -- with list of local destinations, and jump table location if necessary
| BL CLabel [Reg] -- with list of argument regs
| BCTRL [Reg]
@@ -184,7 +184,7 @@ ppc_regUsageOfInstr instr
BCC _ _ -> noUsage
BCCFAR _ _ -> noUsage
MTCTR reg -> usage ([reg],[])
- BCTR _ -> noUsage
+ BCTR _ _ -> noUsage
BL _ params -> usage (params, callClobberedRegs)
BCTRL params -> usage (params, callClobberedRegs)
ADD reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
@@ -257,7 +257,7 @@ ppc_patchRegsOfInstr instr env
BCC cond lbl -> BCC cond lbl
BCCFAR cond lbl -> BCCFAR cond lbl
MTCTR reg -> MTCTR (env reg)
- BCTR targets -> BCTR targets
+ BCTR targets lbl -> BCTR targets lbl
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)
@@ -326,7 +326,7 @@ ppc_jumpDestsOfInstr insn
= case insn of
BCC _ id -> [id]
BCCFAR _ id -> [id]
- BCTR targets -> targets
+ BCTR targets _ -> [id | Just id <- targets]
_ -> []
@@ -338,7 +338,7 @@ ppc_patchJumpInstr insn patchF
= case insn of
BCC cc id -> BCC cc (patchF id)
BCCFAR cc id -> BCCFAR cc (patchF id)
- BCTR _ -> error "Cannot patch BCTR"
+ BCTR ids lbl -> BCTR (map (fmap patchF) ids) lbl
_ -> insn
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index 9fb86c013e..44a6a7ce46 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -545,7 +545,7 @@ pprInstr (MTCTR reg) = hcat [
char '\t',
pprReg reg
]
-pprInstr (BCTR _) = hcat [
+pprInstr (BCTR _ _) = hcat [
char '\t',
ptext (sLit "bctr")
]
diff --git a/compiler/nativeGen/PPC/Regs.hs b/compiler/nativeGen/PPC/Regs.hs
index 73e0c2023e..7a2a84b68c 100644
--- a/compiler/nativeGen/PPC/Regs.hs
+++ b/compiler/nativeGen/PPC/Regs.hs
@@ -209,7 +209,6 @@ spRel n = AddrRegImm sp (ImmInt (n * wORD_SIZE))
-- argRegs is the set of regs which are read for an n-argument call to C.
-- For archs which pass all args on the stack (x86), is empty.
-- Sparc passes up to the first 6 args in regs.
--- Dunno about Alpha.
argRegs :: RegNo -> [Reg]
argRegs 0 = []
argRegs 1 = map regSingle [3]
View Lorry Controller Status