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 UniqFM
import UniqSet
import Outputable
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
countBlock info (BasicBlock blockId instrs)
| LiveInfo _ _ blockLive <- info
, Just rsLiveEntry <- lookupBlockEnv blockLive blockId
- = countLIs rsLiveEntry instrs
+
+ , rsLiveEntry_virt <- mapUniqSet (\(RegVirtual vr) -> vr)
+ $ filterUniqSet isVirtualReg 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 (SPILL{} : lis)
+ = countLIs rsLive lis
+
+ countLIs rsLive (RELOAD{} : lis)
= countLIs rsLive lis
- | DELTA{} <- instr
+ countLIs rsLive (Instr instr Nothing : lis)
+ | isMetaInstr instr
= countLIs rsLive lis
| otherwise
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 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 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
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) ]
+
+