Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
aa1d7d35
Commit
aa1d7d35
authored
Dec 20, 2012
by
PHO
Browse files
Move AsmCodeGen.makeFarBranches to PPC.Instr (
#709
)
Its implementation is totally specific to PPC.
parent
7d6fece2
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/nativeGen/AsmCodeGen.lhs
View file @
aa1d7d35
...
...
@@ -27,7 +27,6 @@ import qualified SPARC.ShortcutJump
import qualified SPARC.CodeGen.Expand
import qualified PPC.CodeGen
import qualified PPC.Cond
import qualified PPC.Regs
import qualified PPC.RegInfo
import qualified PPC.Instr
...
...
@@ -210,7 +209,7 @@ ppcNcgImpl dflags
,ncg_x86fp_kludge = id
,ncgAllocMoreStack = PPC.Instr.allocMoreStack platform
,ncgExpandTop = id
,ncgMakeFarBranches = makeFarBranches
,ncgMakeFarBranches =
PPC.Instr.
makeFarBranches
}
where platform = targetPlatform dflags
...
...
@@ -733,42 +732,6 @@ reorder id accum (b@(block,id',out) : rest)
| otherwise = reorder id (b:accum) rest
-- -----------------------------------------------------------------------------
-- Making far branches
-- Conditional branches on PowerPC are limited to +-32KB; if our Procs get too
-- big, we have to work around this limitation.
makeFarBranches
:: [NatBasicBlock PPC.Instr.Instr]
-> [NatBasicBlock PPC.Instr.Instr]
makeFarBranches blocks
| last blockAddresses < nearLimit = blocks
| otherwise = zipWith handleBlock blockAddresses blocks
where
blockAddresses = scanl (+) 0 $ map blockLen blocks
blockLen (BasicBlock _ instrs) = length instrs
handleBlock addr (BasicBlock id instrs)
= BasicBlock id (zipWith makeFar [addr..] instrs)
makeFar _ (PPC.Instr.BCC PPC.Cond.ALWAYS tgt) = PPC.Instr.BCC PPC.Cond.ALWAYS tgt
makeFar addr (PPC.Instr.BCC cond tgt)
| abs (addr - targetAddr) >= nearLimit
= PPC.Instr.BCCFAR cond tgt
| otherwise
= PPC.Instr.BCC cond tgt
where Just targetAddr = lookupUFM blockAddressMap tgt
makeFar _ other = other
nearLimit = 7000 -- 8192 instructions are allowed; let's keep some
-- distance, as we have a few pseudo-insns that are
-- pretty-printed as multiple instructions,
-- and it's just not worth the effort to calculate
-- things exactly
blockAddressMap = listToUFM $ zip (map blockId blocks) blockAddresses
-- -----------------------------------------------------------------------------
-- Generate jump tables
...
...
compiler/nativeGen/PPC/Instr.hs
View file @
aa1d7d35
...
...
@@ -14,7 +14,8 @@ module PPC.Instr (
RI
(
..
),
Instr
(
..
),
maxSpillSlots
,
allocMoreStack
allocMoreStack
,
makeFarBranches
)
where
...
...
@@ -36,6 +37,7 @@ import CLabel
import
Outputable
import
Platform
import
FastBool
import
UniqFM
(
listToUFM
,
lookupUFM
)
import
UniqSupply
--------------------------------------------------------------------------------
...
...
@@ -505,3 +507,39 @@ ppc_mkJumpInstr id
ppc_takeRegRegMoveInstr
::
Instr
->
Maybe
(
Reg
,
Reg
)
ppc_takeRegRegMoveInstr
(
MR
dst
src
)
=
Just
(
src
,
dst
)
ppc_takeRegRegMoveInstr
_
=
Nothing
-- -----------------------------------------------------------------------------
-- Making far branches
-- Conditional branches on PowerPC are limited to +-32KB; if our Procs get too
-- big, we have to work around this limitation.
makeFarBranches
::
[
NatBasicBlock
Instr
]
->
[
NatBasicBlock
Instr
]
makeFarBranches
blocks
|
last
blockAddresses
<
nearLimit
=
blocks
|
otherwise
=
zipWith
handleBlock
blockAddresses
blocks
where
blockAddresses
=
scanl
(
+
)
0
$
map
blockLen
blocks
blockLen
(
BasicBlock
_
instrs
)
=
length
instrs
handleBlock
addr
(
BasicBlock
id
instrs
)
=
BasicBlock
id
(
zipWith
makeFar
[
addr
..
]
instrs
)
makeFar
_
(
BCC
ALWAYS
tgt
)
=
BCC
ALWAYS
tgt
makeFar
addr
(
BCC
cond
tgt
)
|
abs
(
addr
-
targetAddr
)
>=
nearLimit
=
BCCFAR
cond
tgt
|
otherwise
=
BCC
cond
tgt
where
Just
targetAddr
=
lookupUFM
blockAddressMap
tgt
makeFar
_
other
=
other
nearLimit
=
7000
-- 8192 instructions are allowed; let's keep some
-- distance, as we have a few pseudo-insns that are
-- pretty-printed as multiple instructions,
-- and it's just not worth the effort to calculate
-- things exactly
blockAddressMap
=
listToUFM
$
zip
(
map
blockId
blocks
)
blockAddresses
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment