- type RegSet = UniqSet Reg
- type RegMap a = UniqFM a
- emptyRegMap :: UniqFM a
- type BlockMap a = BlockEnv a
- emptyBlockMap :: BlockEnv a
- type LiveCmmTop instr = GenCmmTop CmmStatic LiveInfo [SCC (LiveBasicBlock instr)]
- data InstrSR instr
- data LiveInstr instr = LiveInstr (InstrSR instr) (Maybe Liveness)
- data Liveness = Liveness {}
- data LiveInfo = LiveInfo [CmmStatic] (Maybe BlockId) (Maybe (BlockMap RegSet)) (Map BlockId (Set Int))
- type LiveBasicBlock instr = GenBasicBlock (LiveInstr instr)
- mapBlockTop :: (LiveBasicBlock instr -> LiveBasicBlock instr) -> LiveCmmTop instr -> LiveCmmTop instr
- mapBlockTopM :: Monad m => (LiveBasicBlock instr -> m (LiveBasicBlock instr)) -> LiveCmmTop instr -> m (LiveCmmTop instr)
- mapSCCM :: Monad m => (a -> m b) -> SCC a -> m (SCC b)
- mapGenBlockTop :: (GenBasicBlock i -> GenBasicBlock i) -> GenCmmTop d h (ListGraph i) -> GenCmmTop d h (ListGraph i)
- mapGenBlockTopM :: Monad m => (GenBasicBlock i -> m (GenBasicBlock i)) -> GenCmmTop d h (ListGraph i) -> m (GenCmmTop d h (ListGraph i))
- stripLive :: (Outputable instr, Instruction instr) => LiveCmmTop instr -> NatCmmTop instr
- stripLiveBlock :: Instruction instr => LiveBasicBlock instr -> NatBasicBlock instr
- slurpConflicts :: Instruction instr => LiveCmmTop instr -> (Bag (UniqSet Reg), Bag (Reg, Reg))
- slurpReloadCoalesce :: forall instr. Instruction instr => LiveCmmTop instr -> Bag (Reg, Reg)
- eraseDeltasLive :: Instruction instr => LiveCmmTop instr -> LiveCmmTop instr
- patchEraseLive :: Instruction instr => (Reg -> Reg) -> LiveCmmTop instr -> LiveCmmTop instr
- patchRegsLiveInstr :: Instruction instr => (Reg -> Reg) -> LiveInstr instr -> LiveInstr instr
- reverseBlocksInTops :: LiveCmmTop instr -> LiveCmmTop instr
- regLiveness :: (Outputable instr, Instruction instr) => LiveCmmTop instr -> UniqSM (LiveCmmTop instr)
- natCmmTopToLive :: Instruction instr => NatCmmTop instr -> LiveCmmTop instr
Documentation
emptyRegMap :: UniqFM aSource
type LiveCmmTop instr = GenCmmTop CmmStatic LiveInfo [SCC (LiveBasicBlock instr)]Source
A top level thing which carries liveness information.
The register allocator also wants to use SPILL/RELOAD meta instructions, so we'll keep those here.
Instr instr | A real machine instruction |
SPILL Reg Int | spill this reg to a stack slot |
RELOAD Int Reg | reload this reg from a stack slot |
Outputable instr => Outputable (InstrSR instr) | |
Instruction instr => Instruction (InstrSR instr) |
An instruction with liveness information.
Outputable instr => Outputable (LiveInstr instr) |
Liveness information. The regs which die are ones which are no longer live in the *next* instruction in this sequence. (NB. if the instruction is a jump, these registers might still be live at the jump target(s) - you have to check the liveness at the destination block to find out).
Liveness | registers that died because they were clobbered by something. |
|
Stash regs live on entry to each basic block in the info part of the cmm code.
type LiveBasicBlock instr = GenBasicBlock (LiveInstr instr)Source
A basic block with liveness information.
mapBlockTop :: (LiveBasicBlock instr -> LiveBasicBlock instr) -> LiveCmmTop instr -> LiveCmmTop instrSource
map a function across all the basic blocks in this code
mapBlockTopM :: Monad m => (LiveBasicBlock instr -> m (LiveBasicBlock instr)) -> LiveCmmTop instr -> m (LiveCmmTop instr)Source
map a function across all the basic blocks in this code (monadic version)
mapGenBlockTop :: (GenBasicBlock i -> GenBasicBlock i) -> GenCmmTop d h (ListGraph i) -> GenCmmTop d h (ListGraph i)Source
mapGenBlockTopM :: Monad m => (GenBasicBlock i -> m (GenBasicBlock i)) -> GenCmmTop d h (ListGraph i) -> m (GenCmmTop d h (ListGraph i))Source
map a function across all the basic blocks in this code (monadic version)
stripLive :: (Outputable instr, Instruction instr) => LiveCmmTop instr -> NatCmmTop instrSource
Strip away liveness information, yielding NatCmmTop
stripLiveBlock :: Instruction instr => LiveBasicBlock instr -> NatBasicBlock instrSource
Strip away liveness information from a basic block, and make real spill instructions out of SPILL, RELOAD pseudos along the way.
slurpConflicts :: Instruction instr => LiveCmmTop instr -> (Bag (UniqSet Reg), Bag (Reg, Reg))Source
Slurp out the list of register conflicts and reg-reg moves from this top level thing. Slurping of conflicts and moves is wrapped up together so we don't have to make two passes over the same code when we want to build the graph.
slurpReloadCoalesce :: forall instr. Instruction instr => LiveCmmTop instr -> Bag (Reg, Reg)Source
For spill/reloads
SPILL v1, slot1 ... RELOAD slot1, v2
If we can arrange that v1 and v2 are allocated to the same hreg it's more likely the spill/reload instrs can be cleaned and replaced by a nop reg-reg move.
eraseDeltasLive :: Instruction instr => LiveCmmTop instr -> LiveCmmTop instrSource
Erase Delta instructions.
patchEraseLive :: Instruction instr => (Reg -> Reg) -> LiveCmmTop instr -> LiveCmmTop instrSource
Patch the registers in this code according to this register mapping. also erase reg -> reg moves when the reg is the same. also erase reg -> reg moves when the destination dies in this instr.
patchRegsLiveInstr :: Instruction instr => (Reg -> Reg) -> LiveInstr instr -> LiveInstr instrSource
Patch registers in this LiveInstr, including the liveness information.
reverseBlocksInTops :: LiveCmmTop instr -> LiveCmmTop instrSource
If we've compute liveness info for this code already we have to reverse the SCCs in each top to get them back to the right order so we can do it again.
regLiveness :: (Outputable instr, Instruction instr) => LiveCmmTop instr -> UniqSM (LiveCmmTop instr)Source
natCmmTopToLive :: Instruction instr => NatCmmTop instr -> LiveCmmTop instrSource
Convert a NatCmmTop to a LiveCmmTop, with empty liveness information