summaryrefslogtreecommitdiff
path: root/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/nativeGen/RegAlloc/Graph/SpillCost.hs')
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/SpillCost.hs51
1 files changed, 34 insertions, 17 deletions
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index f603b609df..4d5f44a8d3 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -1,4 +1,4 @@
-
+{-# LANGUAGE ScopedTypeVariables #-}
module RegAlloc.Graph.SpillCost (
SpillCostRecord,
plusSpillCostRecord,
@@ -30,9 +30,11 @@ import Digraph (flattenSCCs)
import Outputable
import Platform
import State
+import CFG
import Data.List (nub, minimumBy)
import Data.Maybe
+import Control.Monad (join)
-- | Records the expected cost to spill some regster.
@@ -47,6 +49,10 @@ type SpillCostRecord
type SpillCostInfo
= UniqFM SpillCostRecord
+-- | Block membership in a loop
+type LoopMember = Bool
+
+type SpillCostState = State (UniqFM SpillCostRecord) ()
-- | An empty map of spill costs.
zeroSpillCostInfo :: SpillCostInfo
@@ -71,12 +77,13 @@ plusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2)
-- For each vreg, the number of times it was written to, read from,
-- and the number of instructions it was live on entry to (lifetime)
--
-slurpSpillCostInfo :: (Outputable instr, Instruction instr)
+slurpSpillCostInfo :: forall instr statics. (Outputable instr, Instruction instr)
=> Platform
+ -> Maybe CFG
-> LiveCmmDecl statics instr
-> SpillCostInfo
-slurpSpillCostInfo platform cmm
+slurpSpillCostInfo platform cfg cmm
= execState (countCmm cmm) zeroSpillCostInfo
where
countCmm CmmData{} = return ()
@@ -90,35 +97,36 @@ slurpSpillCostInfo platform cmm
| LiveInfo _ _ (Just blockLive) _ <- info
, Just rsLiveEntry <- mapLookup blockId blockLive
, rsLiveEntry_virt <- takeVirtuals rsLiveEntry
- = countLIs rsLiveEntry_virt instrs
+ = countLIs (loopMember blockId) rsLiveEntry_virt instrs
| otherwise
= error "RegAlloc.SpillCost.slurpSpillCostInfo: bad block"
- countLIs _ []
+ countLIs :: LoopMember -> UniqSet VirtualReg -> [LiveInstr instr] -> SpillCostState
+ countLIs _ _ []
= return ()
-- Skip over comment and delta pseudo instrs.
- countLIs rsLive (LiveInstr instr Nothing : lis)
+ countLIs inLoop rsLive (LiveInstr instr Nothing : lis)
| isMetaInstr instr
- = countLIs rsLive lis
+ = countLIs inLoop rsLive lis
| otherwise
= pprPanic "RegSpillCost.slurpSpillCostInfo"
$ text "no liveness information on instruction " <> ppr instr
- countLIs rsLiveEntry (LiveInstr instr (Just live) : lis)
+ countLIs inLoop rsLiveEntry (LiveInstr instr (Just live) : lis)
= do
-- Increment the lifetime counts for regs live on entry to this instr.
- mapM_ incLifetime $ nonDetEltsUniqSet rsLiveEntry
+ mapM_ (incLifetime (loopCount inLoop)) $ nonDetEltsUniqSet rsLiveEntry
-- This is non-deterministic but we do not
-- currently support deterministic code-generation.
-- See Note [Unique Determinism and code generation]
-- Increment counts for what regs were read/written from.
let (RU read written) = regUsageOfInstr platform instr
- mapM_ incUses $ catMaybes $ map takeVirtualReg $ nub read
- mapM_ incDefs $ catMaybes $ map takeVirtualReg $ nub written
+ mapM_ (incUses (loopCount inLoop)) $ catMaybes $ map takeVirtualReg $ nub read
+ mapM_ (incDefs (loopCount inLoop)) $ catMaybes $ map takeVirtualReg $ nub written
-- Compute liveness for entry to next instruction.
let liveDieRead_virt = takeVirtuals (liveDieRead live)
@@ -132,12 +140,21 @@ slurpSpillCostInfo platform cmm
= (rsLiveAcross `unionUniqSets` liveBorn_virt)
`minusUniqSet` liveDieWrite_virt
- countLIs rsLiveNext lis
-
- incDefs reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 1, 0, 0)
- incUses reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, 1, 0)
- incLifetime reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, 0, 1)
-
+ countLIs inLoop rsLiveNext lis
+
+ loopCount inLoop
+ | inLoop = 10
+ | otherwise = 1
+ incDefs count reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, count, 0, 0)
+ incUses count reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, count, 0)
+ incLifetime count reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, 0, count)
+
+ loopBlocks = CFG.loopMembers <$> cfg
+ loopMember bid
+ | Just isMember <- join (mapLookup bid <$> loopBlocks)
+ = isMember
+ | otherwise
+ = False
-- | Take all the virtual registers from this set.
takeVirtuals :: UniqSet Reg -> UniqSet VirtualReg