where
+import RegAlloc.Liveness
+import Instruction
+import RegClass
+import Reg
+
import GraphBase
-import RegLiveness
-import RegAllocInfo
-import MachInstrs
-import MachRegs
-import BlockId
-import Cmm
+import BlockId
+import OldCmm
import UniqFM
import UniqSet
+import Digraph (flattenSCCs)
import Outputable
import State
import Data.List (nub, minimumBy)
import Data.Maybe
-import Control.Monad
type SpillCostRecord
- = ( Reg -- register name
- , Int -- number of writes to this reg
- , Int -- number of reads from this reg
- , Int) -- number of instrs this reg was live on entry to
+ = ( VirtualReg -- register name
+ , Int -- number of writes to this reg
+ , Int -- number of reads from this reg
+ , Int) -- number of instrs this reg was live on entry to
type SpillCostInfo
= UniqFM SpillCostRecord
-- and the number of instructions it was live on entry to (lifetime)
--
slurpSpillCostInfo
- :: LiveCmmTop
+ :: (Outputable instr, Instruction instr)
+ => LiveCmmTop instr
-> SpillCostInfo
slurpSpillCostInfo cmm
= 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)
- | LiveInfo _ _ blockLive <- info
- , Just rsLiveEntry <- lookupBlockEnv blockLive blockId
- = countLIs rsLiveEntry instrs
+ | LiveInfo _ _ (Just blockLive) _ <- info
+ , Just rsLiveEntry <- mapLookup blockId blockLive
+ , rsLiveEntry_virt <- takeVirtuals rsLiveEntry
+ = countLIs rsLiveEntry_virt instrs
| otherwise
- = error "RegLiveness.slurpSpillCostInfo: bad block"
+ = error "RegAlloc.SpillCost.slurpSpillCostInfo: bad block"
countLIs _ []
= return ()
-- skip over comment and delta pseudo instrs
- countLIs rsLive (Instr instr Nothing : lis)
- | COMMENT{} <- instr
- = countLIs rsLive lis
-
- | DELTA{} <- instr
+ countLIs rsLive (LiveInstr instr Nothing : lis)
+ | isMetaInstr instr
= countLIs rsLive lis
| otherwise
= 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
-- increment counts for what regs were read/written from
- let (RU read written) = regUsage instr
- mapM_ incUses $ filter (not . isRealReg) $ nub read
- mapM_ incDefs $ filter (not . isRealReg) $ nub written
+ let (RU read written) = regUsageOfInstr instr
+ mapM_ incUses $ catMaybes $ map takeVirtualReg $ nub read
+ mapM_ incDefs $ catMaybes $ map takeVirtualReg $ nub written
-- compute liveness for entry to next instruction.
+ let liveDieRead_virt = takeVirtuals (liveDieRead live)
+ let liveDieWrite_virt = takeVirtuals (liveDieWrite live)
+ let liveBorn_virt = takeVirtuals (liveBorn live)
+
let rsLiveAcross
- = rsLiveEntry `minusUniqSet` (liveDieRead live)
+ = rsLiveEntry `minusUniqSet` liveDieRead_virt
let rsLiveNext
- = (rsLiveAcross `unionUniqSets` (liveBorn live))
- `minusUniqSet` (liveDieWrite live)
+ = (rsLiveAcross `unionUniqSets` liveBorn_virt)
+ `minusUniqSet` liveDieWrite_virt
countLIs rsLiveNext lis
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
:: SpillCostInfo
- -> Graph Reg RegClass Reg
- -> Reg
+ -> Graph VirtualReg RegClass RealReg
+ -> VirtualReg
chooseSpill info graph
= let cost = spillCost_length info graph
-- Just spill the longest live range.
spillCost_length
:: SpillCostInfo
- -> Graph Reg RegClass Reg
- -> Reg
+ -> Graph VirtualReg RegClass RealReg
+ -> VirtualReg
-> Float
spillCost_length info _ reg
| lifetime <= 1 = 1/0
| otherwise = 1 / fromIntegral lifetime
where (_, _, _, lifetime)
- = fromMaybe (reg, 0, 0, 0) $ lookupUFM info reg
+ = fromMaybe (reg, 0, 0, 0)
+ $ lookupUFM info reg
-lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM (Reg, Int)
+lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM (VirtualReg, Int)
lifeMapFromSpillCostInfo info
= listToUFM
$ map (\(r, _, _, life) -> (r, (r, life)))
-- | Work out the degree (number of neighbors) of this node which have the same class.
-nodeDegree :: Graph Reg RegClass Reg -> Reg -> Int
-nodeDegree graph reg
+nodeDegree
+ :: (VirtualReg -> RegClass)
+ -> Graph VirtualReg RegClass RealReg
+ -> VirtualReg
+ -> Int
+
+nodeDegree classOfVirtualReg graph reg
| Just node <- lookupUFM (graphMap graph) reg
- , virtConflicts <- length $ filter (\r -> regClass r == regClass reg)
- $ uniqSetToList $ nodeConflicts node
+
+ , virtConflicts <- length
+ $ filter (\r -> classOfVirtualReg r == classOfVirtualReg reg)
+ $ uniqSetToList
+ $ nodeConflicts node
+
= virtConflicts + sizeUniqSet (nodeExclusions node)
| otherwise
-- | Show a spill cost record, including the degree from the graph and final calulated spill cos
-pprSpillCostRecord :: Graph Reg RegClass Reg -> SpillCostRecord -> SDoc
-pprSpillCostRecord graph (reg, uses, defs, life)
+pprSpillCostRecord
+ :: (VirtualReg -> RegClass)
+ -> (Reg -> SDoc)
+ -> Graph VirtualReg RegClass RealReg
+ -> SpillCostRecord
+ -> SDoc
+
+pprSpillCostRecord regClass pprReg graph (reg, uses, defs, life)
= hsep
- [ ppr reg
+ [ pprReg (RegVirtual reg)
, ppr uses
, ppr defs
, ppr life
- , ppr $ nodeDegree graph reg
- , text $ show $ (fromIntegral (uses + defs) / fromIntegral (nodeDegree graph reg) :: Float) ]
+ , ppr $ nodeDegree regClass graph reg
+ , text $ show $ (fromIntegral (uses + defs)
+ / fromIntegral (nodeDegree regClass graph reg) :: Float) ]
+
+
projects / ghc-hetmet.git / blobdiff