projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
NCG: Move the graph allocator into its own dir
[ghc-hetmet.git]
/
compiler
/
nativeGen
/
RegLiveness.hs
diff --git
a/compiler/nativeGen/RegLiveness.hs
b/compiler/nativeGen/RegLiveness.hs
index
50af2eb
..
fc8749c
100644
(file)
--- a/
compiler/nativeGen/RegLiveness.hs
+++ b/
compiler/nativeGen/RegLiveness.hs
@@
-30,6
+30,7
@@
module RegLiveness (
) where
) where
+import BlockId
import MachRegs
import MachInstrs
import PprMach
import MachRegs
import MachInstrs
import PprMach
@@
-57,10
+58,10
@@
type RegMap a = UniqFM a
emptyRegMap :: UniqFM a
emptyRegMap = emptyUFM
emptyRegMap :: UniqFM a
emptyRegMap = emptyUFM
-type BlockMap a = UniqFM a
+type BlockMap a = BlockEnv a
-emptyBlockMap :: UniqFM a
-emptyBlockMap = emptyUFM
+emptyBlockMap :: BlockEnv a
+emptyBlockMap = emptyBlockEnv
-- | A top level thing which carries liveness information.
-- | A top level thing which carries liveness information.
@@
-199,7
+200,7
@@
slurpConflicts live
slurpBlock info rs (BasicBlock blockId instrs)
| LiveInfo _ _ blockLive <- info
slurpBlock info rs (BasicBlock blockId instrs)
| LiveInfo _ _ blockLive <- info
- , Just rsLiveEntry <- lookupUFM blockLive blockId
+ , Just rsLiveEntry <- lookupBlockEnv blockLive blockId
, (conflicts, moves) <- slurpLIs rsLiveEntry rs instrs
= (consBag rsLiveEntry conflicts, moves)
, (conflicts, moves) <- slurpLIs rsLiveEntry rs instrs
= (consBag rsLiveEntry conflicts, moves)
@@
-243,14
+244,14
@@
slurpConflicts live
, moves) lis
, moves) lis
--- | For spill/reloads
+-- | 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
--
-- 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.
+-- the spill\/reload instrs can be cleaned and replaced by a nop reg-reg move.
--
--
slurpReloadCoalesce :: LiveCmmTop -> Bag (Reg, Reg)
--
--
slurpReloadCoalesce :: LiveCmmTop -> Bag (Reg, Reg)
@@
-345,7
+346,8
@@
stripLive live
where stripCmm (CmmData sec ds) = CmmData sec ds
stripCmm (CmmProc (LiveInfo info _ _) label params (ListGraph comps))
where stripCmm (CmmData sec ds) = CmmData sec ds
stripCmm (CmmProc (LiveInfo info _ _) label params (ListGraph comps))
- = CmmProc info label params (ListGraph $ concatMap stripComp comps)
+ = CmmProc info label params
+ (ListGraph $ concatMap stripComp comps)
stripComp (BasicBlock _ blocks) = map stripBlock blocks
stripBlock (BasicBlock i instrs) = BasicBlock i (map stripLI instrs)
stripComp (BasicBlock _ blocks) = map stripBlock blocks
stripBlock (BasicBlock i instrs) = BasicBlock i (map stripLI instrs)
@@
-410,7
+412,7
@@
patchEraseLive patchF cmm
patchCmm (CmmProc info label params (ListGraph comps))
| LiveInfo static id blockMap <- info
= let patchRegSet set = mkUniqSet $ map patchF $ uniqSetToList set
patchCmm (CmmProc info label params (ListGraph comps))
| LiveInfo static id blockMap <- info
= let patchRegSet set = mkUniqSet $ map patchF $ uniqSetToList set
- blockMap' = mapUFM patchRegSet blockMap
+ blockMap' = mapBlockEnv patchRegSet blockMap
info' = LiveInfo static id blockMap'
in CmmProc info' label params $ ListGraph $ map patchComp comps
info' = LiveInfo static id blockMap'
in CmmProc info' label params $ ListGraph $ map patchComp comps
@@
-479,7
+481,7
@@
regLiveness (CmmData i d)
regLiveness (CmmProc info lbl params (ListGraph []))
= returnUs $ CmmProc
regLiveness (CmmProc info lbl params (ListGraph []))
= returnUs $ CmmProc
- (LiveInfo info Nothing emptyUFM)
+ (LiveInfo info Nothing emptyBlockEnv)
lbl params (ListGraph [])
regLiveness (CmmProc info lbl params (ListGraph blocks@(first : _)))
lbl params (ListGraph [])
regLiveness (CmmProc info lbl params (ListGraph blocks@(first : _)))
@@
-495,13
+497,12
@@
regLiveness (CmmProc info lbl params (ListGraph blocks@(first : _)))
-> panic "RegLiveness.regLiveness: no blocks in scc list")
$ ann_sccs
-> panic "RegLiveness.regLiveness: no blocks in scc list")
$ ann_sccs
- in returnUs $ CmmProc
- (LiveInfo info (Just first_id) block_live)
- lbl params (ListGraph liveBlocks)
+ in returnUs $ CmmProc (LiveInfo info (Just first_id) block_live)
+ lbl params (ListGraph liveBlocks)
sccBlocks :: [NatBasicBlock] -> [SCC NatBasicBlock]
sccBlocks :: [NatBasicBlock] -> [SCC NatBasicBlock]
-sccBlocks blocks = stronglyConnComp graph
+sccBlocks blocks = stronglyConnCompFromEdgedVertices graph
where
getOutEdges :: [Instr] -> [BlockId]
getOutEdges instrs = foldl' (\a x -> jumpDests x a) [] instrs
where
getOutEdges :: [Instr] -> [BlockId]
getOutEdges instrs = foldl' (\a x -> jumpDests x a) [] instrs
@@
-568,8
+569,8
@@
livenessSCCs blockmap done
-- BlockMaps for equality.
equalBlockMaps a b
= a' == b'
-- BlockMaps for equality.
equalBlockMaps a b
= a' == b'
- where a' = map f $ ufmToList a
- b' = map f $ ufmToList b
+ where a' = map f $ blockEnvToList a
+ b' = map f $ blockEnvToList b
f (key,elt) = (key, uniqSetToList elt)
f (key,elt) = (key, uniqSetToList elt)
@@
-585,7
+586,7
@@
livenessBlock blockmap (BasicBlock block_id instrs)
= let
(regsLiveOnEntry, instrs1)
= livenessBack emptyUniqSet blockmap [] (reverse instrs)
= let
(regsLiveOnEntry, instrs1)
= livenessBack emptyUniqSet blockmap [] (reverse instrs)
- blockmap' = addToUFM blockmap block_id regsLiveOnEntry
+ blockmap' = extendBlockEnv blockmap block_id regsLiveOnEntry
instrs2 = livenessForward regsLiveOnEntry instrs1
instrs2 = livenessForward regsLiveOnEntry instrs1
@@
-685,9
+686,9
@@
liveness1 liveregs blockmap instr
not_a_branch = null targets
targetLiveRegs target
not_a_branch = null targets
targetLiveRegs target
- = case lookupUFM blockmap target of
+ = case lookupBlockEnv blockmap target of
Just ra -> ra
Just ra -> ra
- Nothing -> emptyBlockMap
+ Nothing -> emptyRegMap
live_from_branch = unionManyUniqSets (map targetLiveRegs targets)
live_from_branch = unionManyUniqSets (map targetLiveRegs targets)