projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Merge in new code generator branch.
[ghc-hetmet.git]
/
compiler
/
nativeGen
/
RegAlloc
/
Graph
/
SpillCost.hs
diff --git
a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index
ff3f76a
..
330a410
100644
(file)
--- a/
compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/
compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@
-23,17
+23,16
@@
import Reg
import GraphBase
import GraphBase
-
import BlockId
import BlockId
-import Cmm
+import OldCmm
import UniqFM
import UniqSet
import UniqFM
import UniqSet
+import Digraph (flattenSCCs)
import Outputable
import State
import Data.List (nub, minimumBy)
import Data.Maybe
import Outputable
import State
import Data.List (nub, minimumBy)
import Data.Maybe
-import Control.Monad
type SpillCostRecord
= ( VirtualReg -- register name
type SpillCostRecord
= ( VirtualReg -- register name
@@
-72,21
+71,16
@@
slurpSpillCostInfo cmm
= execState (countCmm cmm) zeroSpillCostInfo
where
countCmm CmmData{} = return ()
= execState (countCmm cmm) zeroSpillCostInfo
where
countCmm CmmData{} = return ()
- countCmm (CmmProc info _ _ (ListGraph blocks))
- = mapM_ (countComp info) blocks
-
- countComp info (BasicBlock _ blocks)
- = mapM_ (countBlock info) blocks
+ countCmm (CmmProc info _ sccs)
+ = mapM_ (countBlock info)
+ $ flattenSCCs sccs
-- lookup the regs that are live on entry to this block in
-- the info table from the CmmProc
countBlock info (BasicBlock blockId instrs)
-- lookup the regs that are live on entry to this block in
-- the info table from the CmmProc
countBlock info (BasicBlock blockId instrs)
- | LiveInfo _ _ blockLive <- info
- , Just rsLiveEntry <- lookupBlockEnv blockLive blockId
-
- , rsLiveEntry_virt <- mapUniqSet (\(RegVirtual vr) -> vr)
- $ filterUniqSet isVirtualReg rsLiveEntry
-
+ | LiveInfo _ _ (Just blockLive) _ <- info
+ , Just rsLiveEntry <- mapLookup blockId blockLive
+ , rsLiveEntry_virt <- takeVirtuals rsLiveEntry
= countLIs rsLiveEntry_virt instrs
| otherwise
= countLIs rsLiveEntry_virt instrs
| otherwise
@@
-96,13
+90,7
@@
slurpSpillCostInfo cmm
= return ()
-- skip over comment and delta pseudo instrs
= return ()
-- skip over comment and delta pseudo instrs
- countLIs rsLive (SPILL{} : lis)
- = countLIs rsLive lis
-
- countLIs rsLive (RELOAD{} : lis)
- = countLIs rsLive lis
-
- countLIs rsLive (Instr instr Nothing : lis)
+ countLIs rsLive (LiveInstr instr Nothing : lis)
| isMetaInstr instr
= countLIs rsLive lis
| isMetaInstr instr
= countLIs rsLive lis
@@
-110,7
+98,7
@@
slurpSpillCostInfo cmm
= pprPanic "RegSpillCost.slurpSpillCostInfo"
(text "no liveness information on instruction " <> ppr instr)
= pprPanic "RegSpillCost.slurpSpillCostInfo"
(text "no liveness information on instruction " <> ppr instr)
- countLIs rsLiveEntry (Instr instr (Just live) : lis)
+ countLIs rsLiveEntry (LiveInstr instr (Just live) : lis)
= do
-- increment the lifetime counts for regs live on entry to this instr
mapM_ incLifetime $ uniqSetToList rsLiveEntry
= do
-- increment the lifetime counts for regs live on entry to this instr
mapM_ incLifetime $ uniqSetToList rsLiveEntry
@@
-121,10
+109,6
@@
slurpSpillCostInfo cmm
mapM_ incDefs $ catMaybes $ map takeVirtualReg $ nub written
-- compute liveness for entry to next instruction.
mapM_ incDefs $ catMaybes $ map takeVirtualReg $ nub written
-- compute liveness for entry to next instruction.
- let takeVirtuals set
- = mapUniqSet (\(RegVirtual vr) -> vr)
- $ filterUniqSet isVirtualReg set
-
let liveDieRead_virt = takeVirtuals (liveDieRead live)
let liveDieWrite_virt = takeVirtuals (liveDieWrite live)
let liveBorn_virt = takeVirtuals (liveBorn live)
let liveDieRead_virt = takeVirtuals (liveDieRead live)
let liveDieWrite_virt = takeVirtuals (liveDieWrite live)
let liveBorn_virt = takeVirtuals (liveBorn live)
@@
-143,6
+127,13
@@
slurpSpillCostInfo cmm
incLifetime reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, 0, 1)
incLifetime reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, 0, 1)
+takeVirtuals :: UniqSet Reg -> UniqSet VirtualReg
+takeVirtuals set = mapUniqSet get_virtual
+ $ filterUniqSet isVirtualReg set
+ where
+ get_virtual (RegVirtual vr) = vr
+ get_virtual _ = panic "getVirt"
+
-- | Choose a node to spill from this graph
chooseSpill
-- | Choose a node to spill from this graph
chooseSpill