SpillClean.hs 16.7 KB
Newer Older
Ian Lynagh's avatar
Ian Lynagh committed
1
-- | Clean out unneeded spill\/reload instrs
2
--
3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
-- * 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
22
--	This also works if the reloads in B1\/B2 were spills instead, because
23 24
--	spilling %r1 to a slot makes that slot have the same value as %r1.
--
Ian Lynagh's avatar
Ian Lynagh committed
25 26 27 28 29 30 31
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

32
module RegAlloc.Graph.SpillClean (
33 34 35 36
	cleanSpills
)
where

37
import RegAlloc.Liveness
38 39
import Instruction
import Reg
40

41
import BlockId
42
import OldCmm
43
import UniqSet
44
import UniqFM
45
import Unique
46
import State
47
import Outputable
48
import Platform
49

50 51 52 53 54 55 56
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

57 58 59 60
--
type Slot = Int


Ian Lynagh's avatar
Ian Lynagh committed
61
-- | Clean out unneeded spill\/reloads from this top level thing.
62 63
cleanSpills
    :: Instruction instr
Simon Peyton Jones's avatar
Simon Peyton Jones committed
64
    => Platform -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
65

66 67
cleanSpills platform cmm
    = evalState (cleanSpin platform 0 cmm) initCleanS
68 69

-- | do one pass of cleaning
70 71 72 73
cleanSpin
    :: Instruction instr
    => Platform
    -> Int
Simon Peyton Jones's avatar
Simon Peyton Jones committed
74 75
    -> LiveCmmDecl statics instr
    -> CleanM (LiveCmmDecl statics instr)
76 77

{-
78
cleanSpin _ spinCount code
79 80 81 82 83 84 85 86 87 88
 = do	jumpValid	<- gets sJumpValid
	pprTrace "cleanSpin"
	 	(  int spinCount
		$$ text "--- code"
		$$ ppr code
		$$ text "--- joins"
		$$ ppr jumpValid)
	 $ cleanSpin' spinCount code
-}

89
cleanSpin platform spinCount code
90
 = do
Ian Lynagh's avatar
Ian Lynagh committed
91
 	-- init count of cleaned spills\/reloads
92 93
	modify $ \s -> s
		{ sCleanedSpillsAcc	= 0
94 95
		, sCleanedReloadsAcc	= 0
		, sReloadedBy		= emptyUFM }
96

97
 	code_forward	<- mapBlockTopM (cleanBlockForward platform) code
98 99
	code_backward	<- cleanTopBackward code_forward
	
100 101 102 103 104
	-- 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
105
	-- remember how many spills\/reloads we cleaned in this pass
106 107 108 109 110 111 112 113 114 115 116 117
	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
118
	   else cleanSpin platform (spinCount + 1) code_backward
119 120 121


-- | Clean one basic block
122
cleanBlockForward
123 124 125
    :: Instruction instr
    => Platform
    -> LiveBasicBlock instr
126
    -> CleanM (LiveBasicBlock instr)
127

128
cleanBlockForward platform (BasicBlock blockId instrs)
129 130 131 132
 = do
 	-- see if we have a valid association for the entry to this block
 	jumpValid	<- gets sJumpValid
 	let assoc	= case lookupUFM jumpValid blockId of
133 134 135
				Just assoc	-> assoc
				Nothing		-> emptyAssoc

136
 	instrs_reload	<- cleanForward platform blockId assoc [] instrs
137 138 139
	return	$ BasicBlock blockId instrs_reload


140 141 142

-- | Clean out unneeded reload instructions.
--	Walking forwards across the code
143 144
--	  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.
145
--
146
cleanForward
147 148 149 150 151 152 153 154 155
    :: 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 []
156 157
	= return acc

158 159 160
-- 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
--
161
cleanForward platform blockId assoc acc (li1 : li2 : instrs)
162

163 164
	| LiveInstr (SPILL  reg1  slot1) _	<- li1
	, LiveInstr (RELOAD slot2 reg2)  _	<- li2
165 166 167
	, slot1 == slot2
	= do
		modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
168 169
		cleanForward platform blockId assoc acc
			(li1 : LiveInstr (mkRegRegMoveInstr platform reg1 reg2) Nothing : instrs)
170 171


172
cleanForward platform blockId assoc acc (li@(LiveInstr i1 _) : instrs)
173
	| Just (r1, r2)	<- takeRegRegMoveInstr i1
174 175 176 177
	= 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
178
		then cleanForward platform blockId assoc acc instrs
179 180 181 182 183 184 185

		-- 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

186
			cleanForward platform blockId assoc' (li : acc) instrs
187 188


189
cleanForward platform blockId assoc acc (li : instrs)
190

191
	-- update association due to the spill
192
	| LiveInstr (SPILL reg slot) _	<- li
193 194
	= let	assoc'	= addAssoc (SReg reg)  (SSlot slot)
			$ delAssoc (SSlot slot)
195
			$ assoc
196
	  in	cleanForward platform blockId assoc' (li : acc) instrs
197

198
	-- clean a reload instr
199
	| LiveInstr (RELOAD{}) _	<- li
200
	= do	(assoc', mli)	<- cleanReload platform blockId assoc li
201
		case mli of
202 203
		 Nothing	-> cleanForward platform blockId assoc' acc 		instrs
		 Just li'	-> cleanForward platform blockId assoc' (li' : acc)	instrs
204

205
	-- remember the association over a jump
206
	| LiveInstr instr _ 	<- li
207
	, targets		<- jumpDestsOfInstr instr
208 209
	, not $ null targets
	= do	mapM_ (accJumpValid assoc) targets
210
		cleanForward platform blockId assoc (li : acc) instrs
211

212
	-- writing to a reg changes its value.
213
	| LiveInstr instr _	<- li
214
	, RU _ written		<- regUsageOfInstr platform instr
215
	= let assoc'	= foldr delAssoc assoc (map SReg $ nub written)
216
	  in  cleanForward platform blockId assoc' (li : acc) instrs
217

218

219 220 221

-- | Try and rewrite a reload instruction to something more pleasing
--
222 223 224 225 226 227 228
cleanReload
    :: Instruction instr
    => Platform
    -> BlockId
    -> Assoc Store
    -> LiveInstr instr
    -> CleanM (Assoc Store, Maybe (LiveInstr instr))
229

230
cleanReload platform blockId assoc li@(LiveInstr (RELOAD slot reg) _)
231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246

	-- 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

247
		return	(assoc', Just $ LiveInstr (mkRegRegMoveInstr platform reg2 reg) Nothing)
248 249 250

	-- gotta keep this instr
	| otherwise
251 252
	= do	-- update the association
		let assoc'	= addAssoc (SReg reg)  (SSlot slot)	-- doing the reload makes reg and slot the same value
253 254 255
				$ delAssoc (SReg reg)			-- reg value changes on reload
				$ assoc

256 257 258
		-- remember that this block reloads from this slot
		accBlockReloadsSlot blockId slot

259 260
	    	return	(assoc', Just li)

261
cleanReload _ _ _ _
262
	= panic "RegSpillClean.cleanReload: unhandled instr"
263 264 265


-- | Clean out unneeded spill instructions.
266
--
267 268
--	 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.
269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291
--
--	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.
--
292 293 294 295
-- TODO: generate noReloads from liveSlotsOnEntry
-- 
cleanTopBackward
	:: Instruction instr
Simon Peyton Jones's avatar
Simon Peyton Jones committed
296 297
	=> LiveCmmDecl statics instr
	-> CleanM (LiveCmmDecl statics instr)
298 299 300 301 302 303

cleanTopBackward cmm
 = case cmm of
	CmmData{}
	 -> return cmm
	
304
	CmmProc info label live sccs
305 306
	 | LiveInfo _ _ _ liveSlotsOnEntry <- info
	 -> do	sccs'	<- mapM (mapSCCM (cleanBlockBackward liveSlotsOnEntry)) sccs
307
		return	$ CmmProc info label live sccs' 
308 309 310 311 312 313 314 315 316 317 318 319 320 321


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



322
cleanBackward
323 324 325
	:: Instruction instr
	=> Map BlockId (Set Int)	-- ^ Slots live on entry to each block
	-> UniqSet Int 			-- ^ slots that have been spilled, but not reloaded from
326 327 328
	-> [LiveInstr instr]		-- ^ acc
	-> [LiveInstr instr]		-- ^ instrs to clean (in forwards order)
	-> CleanM [LiveInstr instr]	-- ^ cleaned instrs  (in backwards order)
329

330

331
cleanBackward liveSlotsOnEntry noReloads acc lis
332
 = do	reloadedBy	<- gets sReloadedBy
333
 	cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc lis
334

Ian Lynagh's avatar
Ian Lynagh committed
335 336 337 338 339 340 341
cleanBackward' :: Instruction instr
               => Map BlockId (Set Int)
               -> UniqFM [BlockId]
               -> UniqSet Int
               -> [LiveInstr instr]
               -> [LiveInstr instr]
               -> State CleanS [LiveInstr instr]
342
cleanBackward' _ _ _      acc []
343
	= return  acc
344

345
cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc (li : instrs)
346 347

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

353
	| LiveInstr (SPILL _ slot) _	<- li
354
	= if elementOfUniqSet slot noReloads
355

356 357 358
	   -- 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 }
359
	   	cleanBackward liveSlotsOnEntry noReloads acc instrs
360 361

	   else do
362 363
		-- this slot is being spilled to, but we haven't seen any reloads yet.
		let noReloads'	= addOneToUniqSet noReloads slot
364
	   	cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
365 366

	-- if we reload from a slot then it's no longer unused
367
	| LiveInstr (RELOAD slot _) _	<- li
368
	, noReloads'		<- delOneFromUniqSet noReloads slot
369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387
	= 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
388

389
	-- some other instruction
390
	| otherwise
391
	= cleanBackward liveSlotsOnEntry noReloads (li : acc) instrs
392

393 394 395

-- collateJoinPoints:
--
396
-- | combine the associations from all the inward control flow edges.
397 398 399 400 401 402 403
--
collateJoinPoints :: CleanM ()
collateJoinPoints
 = modify $ \s -> s
 	{ sJumpValid	= mapUFM intersects (sJumpValidAcc s)
	, sJumpValidAcc	= emptyUFM }

404
intersects :: [Assoc Store]	-> Assoc Store
405 406 407 408
intersects []		= emptyAssoc
intersects assocs	= foldl1' intersectAssoc assocs


409 410 411 412 413 414 415 416 417 418
-- | 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

419 420 421 422 423 424

---------------
type CleanM = State CleanS
data CleanS
	= CleanS
	{ -- regs which are valid at the start of each block.
425
	  sJumpValid		:: UniqFM (Assoc Store)
426 427 428 429

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

432 433 434 435 436
	  -- 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
437
	  -- spills\/reloads cleaned each pass (latest at front)
438 439
	, sCleanedCount		:: [(Int, Int)]

Ian Lynagh's avatar
Ian Lynagh committed
440
	  -- spills\/reloads that have been cleaned in this pass so far.
441 442 443
	, sCleanedSpillsAcc	:: Int
	, sCleanedReloadsAcc	:: Int }

Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
444
initCleanS :: CleanS
445 446 447 448 449
initCleanS
	= CleanS
	{ sJumpValid		= emptyUFM
	, sJumpValidAcc		= emptyUFM

450 451
	, sReloadedBy		= emptyUFM

452 453 454 455 456 457
	, sCleanedCount		= []

	, sCleanedSpillsAcc	= 0
	, sCleanedReloadsAcc	= 0 }


458 459 460
-- | Remember the associations before a jump
accJumpValid :: Assoc Store -> BlockId -> CleanM ()
accJumpValid assocs target
461 462 463 464 465 466 467 468 469 470 471 472 473 474 475
 = 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] }

476 477 478 479 480 481 482 483

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

484 485 486 487 488 489 490
-- | Check if this is a reg store
isStoreReg :: Store -> Bool
isStoreReg ss
 = case ss of
 	SSlot _	-> False
	SReg  _	-> True

491 492 493 494
-- spill cleaning is only done once all virtuals have been allocated to realRegs
--
instance Uniquable Store where
    getUnique (SReg  r)
495
	| RegReal (RealRegSingle i)	<- r
496
	= mkRegSingleUnique i
497

498
	| RegReal (RealRegPair r1 r2)	<- r
499
	= mkRegPairUnique (r1 * 65535 + r2)
500

501 502 503
	| otherwise
	= error "RegSpillClean.getUnique: found virtual reg during spill clean, only real regs expected."

504
    getUnique (SSlot i)	= mkRegSubUnique i    -- [SLPJ] I hope "SubUnique" is ok
505 506 507 508

instance Outputable Store where
	ppr (SSlot i)	= text "slot" <> int i
	ppr (SReg  r)	= ppr r
509 510 511


--------------
512 513 514
-- Association graphs.
--	In the spill cleaner, two store locations are associated if they are known
--	to hold the same value.
515
--
516
type Assoc a	= UniqFM (UniqSet a)
517 518

-- | an empty association
519 520 521 522 523 524 525
emptyAssoc :: Assoc a
emptyAssoc	= emptyUFM


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

527 528 529 530
addAssoc a b m
 = let	m1	= addToUFM_C unionUniqSets m  a (unitUniqSet b)
 	m2	= addToUFM_C unionUniqSets m1 b (unitUniqSet a)
   in	m2
531 532


533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553
-- | 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
554 555 556


-- | check if these two things are associated
557 558 559 560 561
elemAssoc :: (Outputable a, Uniquable a)
	  => a -> a -> Assoc a -> Bool

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

563 564 565
-- | find the refl. trans. closure of the association from this point
closeAssoc :: (Outputable a, Uniquable a)
	=> a -> Assoc a -> UniqSet a
566

567 568 569 570 571
closeAssoc a assoc
 = 	closeAssoc' assoc emptyUniqSet (unitUniqSet a)
 where
	closeAssoc' assoc visited toVisit
	 = case uniqSetToList toVisit of
572

573 574
		-- nothing else to visit, we're done
	 	[]	-> visited
575

576
		(x:_)
577

578 579 580
		 -- we've already seen this node
		 |  elementOfUniqSet x visited
		 -> closeAssoc' assoc visited (delOneFromUniqSet toVisit x)
581

582 583 584 585 586 587 588
		 -- 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
589

590 591 592
		   in closeAssoc' assoc
			(addOneToUniqSet visited x)
			(unionUniqSets   toVisit neighbors)
593

594
-- | intersect
595
intersectAssoc
596 597
	:: Uniquable a
	=> Assoc a -> Assoc a -> Assoc a
598

599 600
intersectAssoc a b
 	= intersectUFM_C (intersectUniqSets) a b
601