SpillClean.hs 16.2 KB
Newer Older
1
{-# OPTIONS -fno-warn-missing-signatures #-}
Ian Lynagh's avatar
Ian Lynagh committed
2
-- | Clean out unneeded spill\/reload instrs
3
--
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-- * Handling of join points
--
--   B1:                          B2:
--    ...                          ...
--       RELOAD SLOT(0), %r1          RELOAD SLOT(0), %r1
--       ... A ...                    ... B ...
--       jump B3                      jump B3
--
--                B3: ... C ...
--                    RELOAD SLOT(0), %r1
--                    ...
--
-- the plan:
--	So long as %r1 hasn't been written to in A, B or C then we don't need the
--	reload in B3.
--
--	What we really care about here is that on the entry to B3, %r1 will always
--	have the same value that is in SLOT(0) (ie, %r1 is _valid_)
--
Ian Lynagh's avatar
Ian Lynagh committed
23
--	This also works if the reloads in B1\/B2 were spills instead, because
24 25
--	spilling %r1 to a slot makes that slot have the same value as %r1.
--
26
module RegAlloc.Graph.SpillClean (
27 28 29 30
	cleanSpills
)
where

31
import RegAlloc.Liveness
32 33
import Instruction
import Reg
34

35
import BlockId
36
import OldCmm
37
import UniqSet
38
import UniqFM
39
import Unique
40
import State
41
import Outputable
42
import Platform
43

44 45 46 47 48 49 50
import Data.List
import Data.Maybe
import Data.Map			(Map)
import Data.Set			(Set)
import qualified Data.Map	as Map
import qualified Data.Set	as Set

51 52 53 54
--
type Slot = Int


Ian Lynagh's avatar
Ian Lynagh committed
55
-- | Clean out unneeded spill\/reloads from this top level thing.
56 57
cleanSpills
    :: Instruction instr
Simon Peyton Jones's avatar
Simon Peyton Jones committed
58
    => Platform -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
59

60 61
cleanSpills platform cmm
    = evalState (cleanSpin platform 0 cmm) initCleanS
62 63

-- | do one pass of cleaning
64 65 66 67
cleanSpin
    :: Instruction instr
    => Platform
    -> Int
Simon Peyton Jones's avatar
Simon Peyton Jones committed
68 69
    -> LiveCmmDecl statics instr
    -> CleanM (LiveCmmDecl statics instr)
70 71

{-
72
cleanSpin _ spinCount code
73 74 75 76 77 78 79 80 81 82
 = do	jumpValid	<- gets sJumpValid
	pprTrace "cleanSpin"
	 	(  int spinCount
		$$ text "--- code"
		$$ ppr code
		$$ text "--- joins"
		$$ ppr jumpValid)
	 $ cleanSpin' spinCount code
-}

83
cleanSpin platform spinCount code
84
 = do
Ian Lynagh's avatar
Ian Lynagh committed
85
 	-- init count of cleaned spills\/reloads
86 87
	modify $ \s -> s
		{ sCleanedSpillsAcc	= 0
88 89
		, sCleanedReloadsAcc	= 0
		, sReloadedBy		= emptyUFM }
90

91
 	code_forward	<- mapBlockTopM (cleanBlockForward platform) code
92 93
	code_backward	<- cleanTopBackward code_forward
	
94 95 96 97 98
	-- During the cleaning of each block we collected information about what regs
	--	were valid across each jump. Based on this, work out whether it will be
	--	safe to erase reloads after join points for the next pass.
	collateJoinPoints

Ian Lynagh's avatar
Ian Lynagh committed
99
	-- remember how many spills\/reloads we cleaned in this pass
100 101 102 103 104 105 106 107 108 109 110 111
	spills		<- gets sCleanedSpillsAcc
	reloads		<- gets sCleanedReloadsAcc
	modify $ \s -> s
		{ sCleanedCount	= (spills, reloads) : sCleanedCount s }

	-- if nothing was cleaned in this pass or the last one
	--	then we're done and it's time to bail out
	cleanedCount	<- gets sCleanedCount
	if take 2 cleanedCount == [(0, 0), (0, 0)]
	   then return code

	-- otherwise go around again
112
	   else cleanSpin platform (spinCount + 1) code_backward
113 114 115


-- | Clean one basic block
116
cleanBlockForward
117 118 119
    :: Instruction instr
    => Platform
    -> LiveBasicBlock instr
120
    -> CleanM (LiveBasicBlock instr)
121

122
cleanBlockForward platform (BasicBlock blockId instrs)
123 124 125 126
 = do
 	-- see if we have a valid association for the entry to this block
 	jumpValid	<- gets sJumpValid
 	let assoc	= case lookupUFM jumpValid blockId of
127 128 129
				Just assoc	-> assoc
				Nothing		-> emptyAssoc

130
 	instrs_reload	<- cleanForward platform blockId assoc [] instrs
131 132 133
	return	$ BasicBlock blockId instrs_reload


134 135 136

-- | Clean out unneeded reload instructions.
--	Walking forwards across the code
137 138
--	  On a reload, if we know a reg already has the same value as a slot
--	  then we don't need to do the reload.
139
--
140
cleanForward
141 142 143 144 145 146 147 148 149
    :: Instruction instr
    => Platform
    -> BlockId                  -- ^ the block that we're currently in
    -> Assoc Store              -- ^ two store locations are associated if they have the same value
    -> [LiveInstr instr]        -- ^ acc
    -> [LiveInstr instr]        -- ^ instrs to clean (in backwards order)
    -> CleanM [LiveInstr instr] -- ^ cleaned instrs  (in forward   order)

cleanForward _ _ _ acc []
150 151
	= return acc

152 153 154
-- write out live range joins via spill slots to just a spill and a reg-reg move
--	hopefully the spill will be also be cleaned in the next pass
--
155
cleanForward platform blockId assoc acc (li1 : li2 : instrs)
156

157 158
	| LiveInstr (SPILL  reg1  slot1) _	<- li1
	, LiveInstr (RELOAD slot2 reg2)  _	<- li2
159 160 161
	, slot1 == slot2
	= do
		modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
162 163
		cleanForward platform blockId assoc acc
			(li1 : LiveInstr (mkRegRegMoveInstr platform reg1 reg2) Nothing : instrs)
164 165


166
cleanForward platform blockId assoc acc (li@(LiveInstr i1 _) : instrs)
167
	| Just (r1, r2)	<- takeRegRegMoveInstr i1
168 169 170 171
	= if r1 == r2
		-- erase any left over nop reg reg moves while we're here
		--	this will also catch any nop moves that the "write out live range joins" case above
		--	happens to add
172
		then cleanForward platform blockId assoc acc instrs
173 174 175 176 177 178 179

		-- if r1 has the same value as some slots and we copy r1 to r2,
		--	then r2 is now associated with those slots instead
		else do	let assoc'	= addAssoc (SReg r1) (SReg r2)
					$ delAssoc (SReg r2)
					$ assoc

180
			cleanForward platform blockId assoc' (li : acc) instrs
181 182


183
cleanForward platform blockId assoc acc (li : instrs)
184

185
	-- update association due to the spill
186
	| LiveInstr (SPILL reg slot) _	<- li
187 188
	= let	assoc'	= addAssoc (SReg reg)  (SSlot slot)
			$ delAssoc (SSlot slot)
189
			$ assoc
190
	  in	cleanForward platform blockId assoc' (li : acc) instrs
191

192
	-- clean a reload instr
193
	| LiveInstr (RELOAD{}) _	<- li
194
	= do	(assoc', mli)	<- cleanReload platform blockId assoc li
195
		case mli of
196 197
		 Nothing	-> cleanForward platform blockId assoc' acc 		instrs
		 Just li'	-> cleanForward platform blockId assoc' (li' : acc)	instrs
198

199
	-- remember the association over a jump
200
	| LiveInstr instr _ 	<- li
201
	, targets		<- jumpDestsOfInstr instr
202 203
	, not $ null targets
	= do	mapM_ (accJumpValid assoc) targets
204
		cleanForward platform blockId assoc (li : acc) instrs
205

206
	-- writing to a reg changes its value.
207
	| LiveInstr instr _	<- li
208
	, RU _ written		<- regUsageOfInstr instr
209
	= let assoc'	= foldr delAssoc assoc (map SReg $ nub written)
210
	  in  cleanForward platform blockId assoc' (li : acc) instrs
211

212

213 214 215

-- | Try and rewrite a reload instruction to something more pleasing
--
216 217 218 219 220 221 222
cleanReload
    :: Instruction instr
    => Platform
    -> BlockId
    -> Assoc Store
    -> LiveInstr instr
    -> CleanM (Assoc Store, Maybe (LiveInstr instr))
223

224
cleanReload platform blockId assoc li@(LiveInstr (RELOAD slot reg) _)
225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240

	-- if the reg we're reloading already has the same value as the slot
	--	then we can erase the instruction outright
	| elemAssoc (SSlot slot) (SReg reg) assoc
	= do 	modify 	$ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
	   	return	(assoc, Nothing)

	-- if we can find another reg with the same value as this slot then
	--	do a move instead of a reload.
	| Just reg2	<- findRegOfSlot assoc slot
	= do	modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }

		let assoc'	= addAssoc (SReg reg) (SReg reg2)
				$ delAssoc (SReg reg)
				$ assoc

241
		return	(assoc', Just $ LiveInstr (mkRegRegMoveInstr platform reg2 reg) Nothing)
242 243 244

	-- gotta keep this instr
	| otherwise
245 246
	= do	-- update the association
		let assoc'	= addAssoc (SReg reg)  (SSlot slot)	-- doing the reload makes reg and slot the same value
247 248 249
				$ delAssoc (SReg reg)			-- reg value changes on reload
				$ assoc

250 251 252
		-- remember that this block reloads from this slot
		accBlockReloadsSlot blockId slot

253 254
	    	return	(assoc', Just li)

255
cleanReload _ _ _ _
256
	= panic "RegSpillClean.cleanReload: unhandled instr"
257 258 259


-- | Clean out unneeded spill instructions.
260
--
261 262
--	 If there were no reloads from a slot between a spill and the last one
--	 then the slot was never read and we don't need the spill.
263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285
--
--	SPILL   r0 -> s1
--	RELOAD  s1 -> r2
--	SPILL   r3 -> s1	<--- don't need this spill
--	SPILL   r4 -> s1
--	RELOAD  s1 -> r5
--
--	Maintain a set of
--		"slots which were spilled to but not reloaded from yet"
--
--	Walking backwards across the code:
--	 a) On a reload from a slot, remove it from the set.
--
--	 a) On a spill from a slot
--		If the slot is in set then we can erase the spill,
--			because it won't be reloaded from until after the next spill.
--
--		otherwise
--			keep the spill and add the slot to the set
--
-- TODO: This is mostly inter-block
--	 we should really be updating the noReloads set as we cross jumps also.
--
286 287 288 289
-- TODO: generate noReloads from liveSlotsOnEntry
-- 
cleanTopBackward
	:: Instruction instr
Simon Peyton Jones's avatar
Simon Peyton Jones committed
290 291
	=> LiveCmmDecl statics instr
	-> CleanM (LiveCmmDecl statics instr)
292 293 294 295 296 297

cleanTopBackward cmm
 = case cmm of
	CmmData{}
	 -> return cmm
	
298
	CmmProc info label sccs
299 300
	 | LiveInfo _ _ _ liveSlotsOnEntry <- info
	 -> do	sccs'	<- mapM (mapSCCM (cleanBlockBackward liveSlotsOnEntry)) sccs
301
		return	$ CmmProc info label sccs' 
302 303 304 305 306 307 308 309 310 311 312 313 314 315


cleanBlockBackward 
	:: Instruction instr
	=> Map BlockId (Set Int)
	-> LiveBasicBlock instr 
	-> CleanM (LiveBasicBlock instr)

cleanBlockBackward liveSlotsOnEntry (BasicBlock blockId instrs)
 = do	instrs_spill	<- cleanBackward liveSlotsOnEntry  emptyUniqSet  [] instrs
	return	$ BasicBlock blockId instrs_spill



316
cleanBackward
317 318 319
	:: Instruction instr
	=> Map BlockId (Set Int)	-- ^ Slots live on entry to each block
	-> UniqSet Int 			-- ^ slots that have been spilled, but not reloaded from
320 321 322
	-> [LiveInstr instr]		-- ^ acc
	-> [LiveInstr instr]		-- ^ instrs to clean (in forwards order)
	-> CleanM [LiveInstr instr]	-- ^ cleaned instrs  (in backwards order)
323

324

325
cleanBackward liveSlotsOnEntry noReloads acc lis
326
 = do	reloadedBy	<- gets sReloadedBy
327
 	cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc lis
328

329
cleanBackward' _ _ _      acc []
330
	= return  acc
331

332
cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc (li : instrs)
333 334

	-- if nothing ever reloads from this slot then we don't need the spill
335
	| LiveInstr (SPILL _ slot) _	<- li
336 337
	, Nothing	<- lookupUFM reloadedBy (SSlot slot)
	= do	modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
338
		cleanBackward liveSlotsOnEntry noReloads acc instrs
339

340
	| LiveInstr (SPILL _ slot) _	<- li
341
	= if elementOfUniqSet slot noReloads
342

343 344 345
	   -- we can erase this spill because the slot won't be read until after the next one
	   then do
		modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
346
	   	cleanBackward liveSlotsOnEntry noReloads acc instrs
347 348

	   else do
349 350
		-- this slot is being spilled to, but we haven't seen any reloads yet.
		let noReloads'	= addOneToUniqSet noReloads slot
351
	   	cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
352 353

	-- if we reload from a slot then it's no longer unused
354
	| LiveInstr (RELOAD slot _) _	<- li
355
	, noReloads'		<- delOneFromUniqSet noReloads slot
356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374
	= cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs

	-- If a slot is live in a jump target then assume it's reloaded there.
	-- TODO: A real dataflow analysis would do a better job here.
	--       If the target block _ever_ used the slot then we assume it always does,
	--       but if those reloads are cleaned the slot liveness map doesn't get updated.
	| LiveInstr instr _ 	<- li
	, targets		<- jumpDestsOfInstr instr
	= do	
		let slotsReloadedByTargets
				= Set.unions
				$ catMaybes
				$ map (flip Map.lookup liveSlotsOnEntry) 
				$ targets
		
		let noReloads'	= foldl' delOneFromUniqSet noReloads 
				$ Set.toList slotsReloadedByTargets
		
		cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
375

376
	-- some other instruction
377
	| otherwise
378
	= cleanBackward liveSlotsOnEntry noReloads (li : acc) instrs
379

380 381 382

-- collateJoinPoints:
--
383
-- | combine the associations from all the inward control flow edges.
384 385 386 387 388 389 390
--
collateJoinPoints :: CleanM ()
collateJoinPoints
 = modify $ \s -> s
 	{ sJumpValid	= mapUFM intersects (sJumpValidAcc s)
	, sJumpValidAcc	= emptyUFM }

391
intersects :: [Assoc Store]	-> Assoc Store
392 393 394 395
intersects []		= emptyAssoc
intersects assocs	= foldl1' intersectAssoc assocs


396 397 398 399 400 401 402 403 404 405
-- | See if we have a reg with the same value as this slot in the association table.
findRegOfSlot :: Assoc Store -> Int -> Maybe Reg
findRegOfSlot assoc slot
	| close			<- closeAssoc (SSlot slot) assoc
	, Just (SReg reg)	<- find isStoreReg $ uniqSetToList close
	= Just reg

	| otherwise
	= Nothing

406 407 408 409 410 411

---------------
type CleanM = State CleanS
data CleanS
	= CleanS
	{ -- regs which are valid at the start of each block.
412
	  sJumpValid		:: UniqFM (Assoc Store)
413 414 415 416

 	  -- collecting up what regs were valid across each jump.
	  --	in the next pass we can collate these and write the results
	  --	to sJumpValid.
417
	, sJumpValidAcc		:: UniqFM [Assoc Store]
418

419 420 421 422 423
	  -- map of (slot -> blocks which reload from this slot)
	  --	used to decide if whether slot spilled to will ever be
	  --	reloaded from on this path.
	, sReloadedBy		:: UniqFM [BlockId]

Ian Lynagh's avatar
Ian Lynagh committed
424
	  -- spills\/reloads cleaned each pass (latest at front)
425 426
	, sCleanedCount		:: [(Int, Int)]

Ian Lynagh's avatar
Ian Lynagh committed
427
	  -- spills\/reloads that have been cleaned in this pass so far.
428 429 430
	, sCleanedSpillsAcc	:: Int
	, sCleanedReloadsAcc	:: Int }

Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
431
initCleanS :: CleanS
432 433 434 435 436
initCleanS
	= CleanS
	{ sJumpValid		= emptyUFM
	, sJumpValidAcc		= emptyUFM

437 438
	, sReloadedBy		= emptyUFM

439 440 441 442 443 444
	, sCleanedCount		= []

	, sCleanedSpillsAcc	= 0
	, sCleanedReloadsAcc	= 0 }


445 446 447
-- | Remember the associations before a jump
accJumpValid :: Assoc Store -> BlockId -> CleanM ()
accJumpValid assocs target
448 449 450 451 452 453 454 455 456 457 458 459 460 461 462
 = modify $ \s -> s {
	sJumpValidAcc = addToUFM_C (++)
				(sJumpValidAcc s)
				target
				[assocs] }


accBlockReloadsSlot :: BlockId -> Slot -> CleanM ()
accBlockReloadsSlot blockId slot
 = modify $ \s -> s {
 	sReloadedBy = addToUFM_C (++)
				(sReloadedBy s)
				(SSlot slot)
				[blockId] }

463 464 465 466 467 468 469 470

--------------
-- A store location can be a stack slot or a register
--
data Store
	= SSlot Int
	| SReg  Reg

471 472 473 474 475 476 477
-- | Check if this is a reg store
isStoreReg :: Store -> Bool
isStoreReg ss
 = case ss of
 	SSlot _	-> False
	SReg  _	-> True

478 479 480 481
-- spill cleaning is only done once all virtuals have been allocated to realRegs
--
instance Uniquable Store where
    getUnique (SReg  r)
482
	| RegReal (RealRegSingle i)	<- r
483
	= mkRegSingleUnique i
484

485
	| RegReal (RealRegPair r1 r2)	<- r
486
	= mkRegPairUnique (r1 * 65535 + r2)
487

488 489 490
	| otherwise
	= error "RegSpillClean.getUnique: found virtual reg during spill clean, only real regs expected."

491
    getUnique (SSlot i)	= mkRegSubUnique i    -- [SLPJ] I hope "SubUnique" is ok
492 493 494 495

instance Outputable Store where
	ppr (SSlot i)	= text "slot" <> int i
	ppr (SReg  r)	= ppr r
496 497 498


--------------
499 500 501
-- Association graphs.
--	In the spill cleaner, two store locations are associated if they are known
--	to hold the same value.
502
--
503
type Assoc a	= UniqFM (UniqSet a)
504 505

-- | an empty association
506 507 508 509 510 511 512
emptyAssoc :: Assoc a
emptyAssoc	= emptyUFM


-- | add an association between these two things
addAssoc :: Uniquable a
	 => a -> a -> Assoc a -> Assoc a
513

514 515 516 517
addAssoc a b m
 = let	m1	= addToUFM_C unionUniqSets m  a (unitUniqSet b)
 	m2	= addToUFM_C unionUniqSets m1 b (unitUniqSet a)
   in	m2
518 519


520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540
-- | delete all associations to a node
delAssoc :: (Outputable a, Uniquable a)
 	 => a -> Assoc a -> Assoc a

delAssoc a m
	| Just aSet	<- lookupUFM  m a
	, m1		<- delFromUFM m a
	= foldUniqSet (\x m -> delAssoc1 x a m) m1 aSet

	| otherwise	= m


-- | delete a single association edge (a -> b)
delAssoc1 :: Uniquable a
	=> a -> a -> Assoc a -> Assoc a

delAssoc1 a b m
	| Just aSet	<- lookupUFM m a
	= addToUFM m a (delOneFromUniqSet aSet b)

	| otherwise	= m
541 542 543


-- | check if these two things are associated
544 545 546 547 548
elemAssoc :: (Outputable a, Uniquable a)
	  => a -> a -> Assoc a -> Bool

elemAssoc a b m
	= elementOfUniqSet b (closeAssoc a m)
549

550 551 552
-- | find the refl. trans. closure of the association from this point
closeAssoc :: (Outputable a, Uniquable a)
	=> a -> Assoc a -> UniqSet a
553

554 555 556 557 558
closeAssoc a assoc
 = 	closeAssoc' assoc emptyUniqSet (unitUniqSet a)
 where
	closeAssoc' assoc visited toVisit
	 = case uniqSetToList toVisit of
559

560 561
		-- nothing else to visit, we're done
	 	[]	-> visited
562

563
		(x:_)
564

565 566 567
		 -- we've already seen this node
		 |  elementOfUniqSet x visited
		 -> closeAssoc' assoc visited (delOneFromUniqSet toVisit x)
568

569 570 571 572 573 574 575
		 -- haven't seen this node before,
		 --	remember to visit all its neighbors
		 |  otherwise
		 -> let neighbors
		 	 = case lookupUFM assoc x of
				Nothing		-> emptyUniqSet
				Just set	-> set
576

577 578 579
		   in closeAssoc' assoc
			(addOneToUniqSet visited x)
			(unionUniqSets   toVisit neighbors)
580

581
-- | intersect
582
intersectAssoc
583 584
	:: Uniquable a
	=> Assoc a -> Assoc a -> Assoc a
585

586 587
intersectAssoc a b
 	= intersectUFM_C (intersectUniqSets) a b
588