PageRenderTime 18ms CodeModel.GetById 9ms app.highlight 5ms RepoModel.GetById 1ms app.codeStats 0ms

/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs

https://bitbucket.org/carter/ghc
Haskell | 285 lines | 147 code | 56 blank | 82 comment | 2 complexity | 4fdce07e5c43d9e3ac47a4b4045e9ce9 MD5 | raw file
  1
  2{-# OPTIONS -fno-warn-tabs #-}
  3-- The above warning supression flag is a temporary kludge.
  4-- While working on this module you are encouraged to remove it and
  5-- detab the module (please do the detabbing in a separate patch). See
  6--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
  7-- for details
  8
  9module RegAlloc.Graph.SpillCost (
 10	SpillCostRecord,
 11	plusSpillCostRecord,
 12	pprSpillCostRecord,
 13
 14	SpillCostInfo,
 15	zeroSpillCostInfo,
 16	plusSpillCostInfo,
 17
 18	slurpSpillCostInfo,
 19	chooseSpill,
 20
 21	lifeMapFromSpillCostInfo
 22)
 23
 24where
 25
 26import RegAlloc.Liveness
 27import Instruction
 28import RegClass
 29import Reg
 30
 31import GraphBase
 32
 33import BlockId
 34import OldCmm
 35import UniqFM
 36import UniqSet
 37import Digraph		(flattenSCCs)
 38import Outputable
 39import Platform
 40import State
 41
 42import Data.List	(nub, minimumBy)
 43import Data.Maybe
 44
 45type SpillCostRecord
 46 = 	( VirtualReg	-- register name
 47	, Int		-- number of writes to this reg
 48	, Int		-- number of reads from this reg
 49	, Int)		-- number of instrs this reg was live on entry to
 50
 51type SpillCostInfo
 52	= UniqFM SpillCostRecord
 53
 54
 55zeroSpillCostInfo :: SpillCostInfo
 56zeroSpillCostInfo	= emptyUFM
 57
 58-- | Add two spillCostInfos
 59plusSpillCostInfo :: SpillCostInfo -> SpillCostInfo -> SpillCostInfo
 60plusSpillCostInfo sc1 sc2
 61	= plusUFM_C plusSpillCostRecord sc1 sc2
 62
 63plusSpillCostRecord :: SpillCostRecord -> SpillCostRecord -> SpillCostRecord
 64plusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2)
 65	| r1 == r2	= (r1, a1 + a2, b1 + b2, c1 + c2)
 66	| otherwise	= error "RegSpillCost.plusRegInt: regs don't match"
 67
 68
 69-- | Slurp out information used for determining spill costs
 70--	for each vreg, the number of times it was written to, read from,
 71--	and the number of instructions it was live on entry to (lifetime)
 72--
 73slurpSpillCostInfo :: (Outputable instr, Instruction instr)
 74                   => Platform
 75                   -> LiveCmmDecl statics instr
 76                   -> SpillCostInfo
 77
 78slurpSpillCostInfo platform cmm
 79	= execState (countCmm cmm) zeroSpillCostInfo
 80 where
 81	countCmm CmmData{}		= return ()
 82	countCmm (CmmProc info _ sccs)
 83		= mapM_ (countBlock info)
 84		$ flattenSCCs sccs
 85
 86	-- lookup the regs that are live on entry to this block in
 87	--	the info table from the CmmProc
 88 	countBlock info (BasicBlock blockId instrs)
 89		| LiveInfo _ _ (Just blockLive) _ <- info
 90		, Just rsLiveEntry  <- mapLookup blockId blockLive
 91		, rsLiveEntry_virt  <- takeVirtuals rsLiveEntry
 92		= countLIs rsLiveEntry_virt instrs
 93
 94		| otherwise
 95		= error "RegAlloc.SpillCost.slurpSpillCostInfo: bad block"
 96
 97	countLIs _      []
 98		= return ()
 99
100	-- skip over comment and delta pseudo instrs
101	countLIs rsLive (LiveInstr instr Nothing : lis)
102		| isMetaInstr instr
103		= countLIs rsLive lis
104
105		| otherwise
106		= pprPanic "RegSpillCost.slurpSpillCostInfo"
107			(text "no liveness information on instruction " <> ppr instr)
108
109	countLIs rsLiveEntry (LiveInstr instr (Just live) : lis)
110	 = do
111		-- increment the lifetime counts for regs live on entry to this instr
112		mapM_ incLifetime $ uniqSetToList rsLiveEntry
113
114		-- increment counts for what regs were read/written from
115		let (RU read written)	= regUsageOfInstr platform instr
116		mapM_ incUses	$ catMaybes $ map takeVirtualReg $ nub read
117		mapM_ incDefs 	$ catMaybes $ map takeVirtualReg $ nub written
118
119		-- compute liveness for entry to next instruction.
120		let liveDieRead_virt	= takeVirtuals (liveDieRead  live)
121		let liveDieWrite_virt	= takeVirtuals (liveDieWrite live)
122		let liveBorn_virt	= takeVirtuals (liveBorn     live)
123
124	 	let rsLiveAcross
125			= rsLiveEntry `minusUniqSet` liveDieRead_virt
126
127	 	let rsLiveNext
128			= (rsLiveAcross `unionUniqSets` liveBorn_virt)
129				        `minusUniqSet`  liveDieWrite_virt
130
131	 	countLIs rsLiveNext lis
132
133	incDefs     reg = modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 1, 0, 0)
134	incUses	    reg	= modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, 1, 0)
135	incLifetime reg	= modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, 0, 1)
136
137
138takeVirtuals :: UniqSet Reg -> UniqSet VirtualReg
139takeVirtuals set = mapUniqSet get_virtual
140		$ filterUniqSet isVirtualReg set
141  where
142   get_virtual (RegVirtual vr) = vr 
143   get_virtual _ = panic "getVirt" 
144
145-- | Choose a node to spill from this graph
146
147chooseSpill
148	:: SpillCostInfo
149	-> Graph VirtualReg RegClass RealReg
150	-> VirtualReg
151
152chooseSpill info graph
153 = let	cost	= spillCost_length info graph
154 	node	= minimumBy (\n1 n2 -> compare (cost $ nodeId n1) (cost $ nodeId n2))
155		$ eltsUFM $ graphMap graph
156
157   in	nodeId node
158
159
160
161-- | Chaitins spill cost function is:
162--
163--          cost =     sum         loadCost * freq (u)  +    sum        storeCost * freq (d)
164--                  u <- uses (v)                         d <- defs (v)
165--
166--	There are no loops in our code at the momemnt, so we can set the freq's to 1
167--	We divide this by the degree if t
168--
169--
170--  If we don't have live range splitting then Chaitins function performs badly if we have
171--	lots of nested live ranges and very few registers.
172--
173--		 v1 v2 v3
174--	def v1	 .
175--	use v1   .
176--	def v2   .  .
177--	def v3   .  .  .
178--	use v1   .  .  .
179--	use v3   .  .  .
180--	use v2   .  .
181--	use v1   .
182--
183--
184--           defs uses degree   cost
185--	v1:  1     3     3      1.5
186--	v2:  1     2     3      1.0
187--	v3:  1     1     3      0.666
188--
189--  	v3 has the lowest cost, but if we only have 2 hardregs and we insert spill code for v3
190--	then this isn't going to improve the colorability of the graph.
191--
192--  When compiling SHA1, which as very long basic blocks and some vregs with very long live ranges
193--	the allocator seems to try and spill from the inside out and eventually run out of stack slots.
194--
195--  Without live range splitting, its's better to spill from the outside in so set the cost of very
196--	long live ranges to zero
197--
198{-
199spillCost_chaitin
200	:: SpillCostInfo
201	-> Graph Reg RegClass Reg
202	-> Reg
203	-> Float
204
205spillCost_chaitin info graph reg
206	-- Spilling a live range that only lives for 1 instruction isn't going to help
207	--	us at all - and we definately want to avoid trying to re-spill previously
208	--	inserted spill code.
209	| lifetime <= 1		= 1/0
210
211	-- It's unlikely that we'll find a reg for a live range this long
212	--	better to spill it straight up and not risk trying to keep it around
213	--	and have to go through the build/color cycle again.
214	| lifetime > allocatableRegsInClass (regClass reg) * 10
215	= 0
216
217	-- otherwise revert to chaitin's regular cost function.
218	| otherwise	= fromIntegral (uses + defs) / fromIntegral (nodeDegree graph reg)
219	where (_, defs, uses, lifetime)
220		= fromMaybe (reg, 0, 0, 0) $ lookupUFM info reg
221-}
222
223-- Just spill the longest live range.
224spillCost_length
225	:: SpillCostInfo
226	-> Graph VirtualReg RegClass RealReg
227	-> VirtualReg
228	-> Float
229
230spillCost_length info _ reg
231	| lifetime <= 1		= 1/0
232	| otherwise		= 1 / fromIntegral lifetime
233	where (_, _, _, lifetime)
234		= fromMaybe (reg, 0, 0, 0) 
235		$ lookupUFM info reg
236
237
238
239lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM (VirtualReg, Int)
240lifeMapFromSpillCostInfo info
241 	= listToUFM
242	$ map (\(r, _, _, life)	-> (r, (r, life)))
243	$ eltsUFM info
244
245
246-- | Work out the degree (number of neighbors) of this node which have the same class.
247nodeDegree 
248	:: (VirtualReg -> RegClass)
249	-> Graph VirtualReg RegClass RealReg 
250	-> VirtualReg 
251	-> Int
252
253nodeDegree classOfVirtualReg graph reg
254	| Just node	<- lookupUFM (graphMap graph) reg
255
256	, virtConflicts	<- length 	
257			$ filter (\r -> classOfVirtualReg r == classOfVirtualReg reg)
258			$ uniqSetToList 
259			$ nodeConflicts node
260
261	= virtConflicts + sizeUniqSet (nodeExclusions node)
262
263	| otherwise
264	= 0
265
266
267-- | Show a spill cost record, including the degree from the graph and final calulated spill cos
268pprSpillCostRecord 
269	:: (VirtualReg -> RegClass)
270	-> (Reg -> SDoc)
271	-> Graph VirtualReg RegClass RealReg 
272	-> SpillCostRecord 
273	-> SDoc
274
275pprSpillCostRecord regClass pprReg graph (reg, uses, defs, life)
276 	=  hsep
277	[ pprReg (RegVirtual reg)
278	, ppr uses
279	, ppr defs
280	, ppr life
281	, ppr $ nodeDegree regClass graph reg
282	, text $ show $ (fromIntegral (uses + defs) 
283			/ fromIntegral (nodeDegree regClass graph reg) :: Float) ]
284
285