SpillClean.hs 14.3 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

27
module RegAlloc.Graph.SpillClean (
28 29 30 31
	cleanSpills
)
where

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

36 37
import BlockId
import Cmm
38
import UniqSet
39
import UniqFM
40
import Unique
41
import State
42
import Outputable
43
import Util
44

45
import Data.List        ( find, nub )
46

47 48 49 50
--
type Slot = Int


Ian Lynagh's avatar
Ian Lynagh committed
51
-- | Clean out unneeded spill\/reloads from this top level thing.
52 53 54 55
cleanSpills 
	:: Instruction instr
	=> LiveCmmTop instr -> LiveCmmTop instr

56
cleanSpills cmm
57 58 59
	= evalState (cleanSpin 0 cmm) initCleanS

-- | do one pass of cleaning
60 61 62 63 64
cleanSpin 
	:: Instruction instr
	=> Int 
	-> LiveCmmTop instr 
	-> CleanM (LiveCmmTop instr)
65 66 67 68 69 70 71 72 73 74 75 76 77 78 79

{-
cleanSpin spinCount code
 = do	jumpValid	<- gets sJumpValid
	pprTrace "cleanSpin"
	 	(  int spinCount
		$$ text "--- code"
		$$ ppr code
		$$ text "--- joins"
		$$ ppr jumpValid)
	 $ cleanSpin' spinCount code
-}

cleanSpin spinCount code
 = do
Ian Lynagh's avatar
Ian Lynagh committed
80
 	-- init count of cleaned spills\/reloads
81 82
	modify $ \s -> s
		{ sCleanedSpillsAcc	= 0
83 84
		, sCleanedReloadsAcc	= 0
		, sReloadedBy		= emptyUFM }
85

86 87
 	code_forward	<- mapBlockTopM cleanBlockForward  code
	code_backward	<- mapBlockTopM cleanBlockBackward code_forward
88 89 90 91 92 93

	-- 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
94
	-- remember how many spills\/reloads we cleaned in this pass
95 96 97 98 99 100 101 102 103 104 105 106
	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
107
	   else cleanSpin (spinCount + 1) code_backward
108 109 110


-- | Clean one basic block
111 112 113 114 115
cleanBlockForward 
	:: Instruction instr
	=> LiveBasicBlock instr 
	-> CleanM (LiveBasicBlock instr)

116 117 118 119 120
cleanBlockForward (BasicBlock blockId instrs)
 = do
 	-- see if we have a valid association for the entry to this block
 	jumpValid	<- gets sJumpValid
 	let assoc	= case lookupUFM jumpValid blockId of
121 122 123
				Just assoc	-> assoc
				Nothing		-> emptyAssoc

124 125 126 127
 	instrs_reload	<- cleanForward    blockId assoc [] instrs
	return	$ BasicBlock blockId instrs_reload


128 129 130 131 132
cleanBlockBackward 
	:: Instruction instr
	=> LiveBasicBlock instr 
	-> CleanM (LiveBasicBlock instr)

133 134 135 136 137
cleanBlockBackward (BasicBlock blockId instrs)
 = do	instrs_spill	<- cleanBackward  emptyUniqSet  [] instrs
	return	$ BasicBlock blockId instrs_spill


138 139 140 141


-- | Clean out unneeded reload instructions.
--	Walking forwards across the code
142 143
--	  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.
144
--
145
cleanForward
146 147 148 149 150 151
	:: Instruction instr
	=> 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)
152

153
cleanForward _ _ acc []
154 155
	= return acc

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

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


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

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

184
			cleanForward blockId assoc' (li : acc) instrs
185 186


187
cleanForward blockId assoc acc (li : instrs)
188

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

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

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

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

216 217 218 219
-- bogus, to stop pattern match warning
cleanForward _ _ _ _ 
	= panic "RegAlloc.Graph.SpillClean.cleanForward: no match"

220 221 222

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

cleanReload blockId assoc li@(RELOAD slot reg)
231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250

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

		return	(assoc', Just $ Instr (mkRegRegMoveInstr reg2 reg) Nothing)

	-- 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 292
--
--	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.
--
cleanBackward
293 294 295 296
	:: UniqSet Int 			-- ^ slots that have been spilled, but not reloaded from
	-> [LiveInstr instr]		-- ^ acc
	-> [LiveInstr instr]		-- ^ instrs to clean (in forwards order)
	-> CleanM [LiveInstr instr]	-- ^ cleaned instrs  (in backwards order)
297

298 299 300 301 302 303

cleanBackward noReloads acc lis
 = do	reloadedBy	<- gets sReloadedBy
 	cleanBackward' reloadedBy noReloads acc lis

cleanBackward' _ _      acc []
304
	= return  acc
305

306
cleanBackward' reloadedBy noReloads acc (li : instrs)
307 308

	-- if nothing ever reloads from this slot then we don't need the spill
309
	| SPILL _ slot	<- li
310 311 312 313
	, Nothing	<- lookupUFM reloadedBy (SSlot slot)
	= do	modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
		cleanBackward noReloads acc instrs

314
	| SPILL _ slot	<- li
315
	= if elementOfUniqSet slot noReloads
316

317 318 319
	   -- 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 }
320
	   	cleanBackward noReloads acc instrs
321 322

	   else do
323 324 325
		-- this slot is being spilled to, but we haven't seen any reloads yet.
		let noReloads'	= addOneToUniqSet noReloads slot
	   	cleanBackward noReloads' (li : acc) instrs
326 327

	-- if we reload from a slot then it's no longer unused
328
	| RELOAD slot _		<- li
329 330
	, noReloads'		<- delOneFromUniqSet noReloads slot
	= cleanBackward noReloads' (li : acc) instrs
331

332
	-- some other instruction
333
	| otherwise
334
	= cleanBackward noReloads (li : acc) instrs
335

336 337 338

-- collateJoinPoints:
--
339
-- | combine the associations from all the inward control flow edges.
340 341 342 343 344 345 346
--
collateJoinPoints :: CleanM ()
collateJoinPoints
 = modify $ \s -> s
 	{ sJumpValid	= mapUFM intersects (sJumpValidAcc s)
	, sJumpValidAcc	= emptyUFM }

347
intersects :: [Assoc Store]	-> Assoc Store
348 349 350 351
intersects []		= emptyAssoc
intersects assocs	= foldl1' intersectAssoc assocs


352 353 354 355 356 357 358 359 360 361
-- | 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

362 363 364 365 366 367

---------------
type CleanM = State CleanS
data CleanS
	= CleanS
	{ -- regs which are valid at the start of each block.
368
	  sJumpValid		:: UniqFM (Assoc Store)
369 370 371 372

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

375 376 377 378 379
	  -- 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
380
	  -- spills\/reloads cleaned each pass (latest at front)
381 382
	, sCleanedCount		:: [(Int, Int)]

Ian Lynagh's avatar
Ian Lynagh committed
383
	  -- spills\/reloads that have been cleaned in this pass so far.
384 385 386
	, sCleanedSpillsAcc	:: Int
	, sCleanedReloadsAcc	:: Int }

Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
387
initCleanS :: CleanS
388 389 390 391 392
initCleanS
	= CleanS
	{ sJumpValid		= emptyUFM
	, sJumpValidAcc		= emptyUFM

393 394
	, sReloadedBy		= emptyUFM

395 396 397 398 399 400
	, sCleanedCount		= []

	, sCleanedSpillsAcc	= 0
	, sCleanedReloadsAcc	= 0 }


401 402 403
-- | Remember the associations before a jump
accJumpValid :: Assoc Store -> BlockId -> CleanM ()
accJumpValid assocs target
404 405 406 407 408 409 410 411 412 413 414 415 416 417 418
 = 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] }

419 420 421 422 423 424 425 426

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

427 428 429 430 431 432 433
-- | Check if this is a reg store
isStoreReg :: Store -> Bool
isStoreReg ss
 = case ss of
 	SSlot _	-> False
	SReg  _	-> True

434 435 436 437
-- spill cleaning is only done once all virtuals have been allocated to realRegs
--
instance Uniquable Store where
    getUnique (SReg  r)
438
	| RegReal (RealRegSingle i)	<- r
439 440
	= mkUnique 'R' i

441 442 443
	| RegReal (RealRegPair r1 r2)	<- r
	= mkUnique 'P' (r1 * 65535 + r2)

444 445 446 447 448 449 450 451
	| otherwise
	= error "RegSpillClean.getUnique: found virtual reg during spill clean, only real regs expected."

    getUnique (SSlot i)			= mkUnique 'S' i

instance Outputable Store where
	ppr (SSlot i)	= text "slot" <> int i
	ppr (SReg  r)	= ppr r
452 453 454


--------------
455 456 457
-- Association graphs.
--	In the spill cleaner, two store locations are associated if they are known
--	to hold the same value.
458
--
459
type Assoc a	= UniqFM (UniqSet a)
460 461

-- | an empty association
462 463 464 465 466 467 468
emptyAssoc :: Assoc a
emptyAssoc	= emptyUFM


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

470 471 472 473
addAssoc a b m
 = let	m1	= addToUFM_C unionUniqSets m  a (unitUniqSet b)
 	m2	= addToUFM_C unionUniqSets m1 b (unitUniqSet a)
   in	m2
474 475


476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496
-- | 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
497 498 499


-- | check if these two things are associated
500 501 502 503 504
elemAssoc :: (Outputable a, Uniquable a)
	  => a -> a -> Assoc a -> Bool

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

506 507 508
-- | find the refl. trans. closure of the association from this point
closeAssoc :: (Outputable a, Uniquable a)
	=> a -> Assoc a -> UniqSet a
509

510 511 512 513 514
closeAssoc a assoc
 = 	closeAssoc' assoc emptyUniqSet (unitUniqSet a)
 where
	closeAssoc' assoc visited toVisit
	 = case uniqSetToList toVisit of
515

516 517
		-- nothing else to visit, we're done
	 	[]	-> visited
518

519
		(x:_)
520

521 522 523
		 -- we've already seen this node
		 |  elementOfUniqSet x visited
		 -> closeAssoc' assoc visited (delOneFromUniqSet toVisit x)
524

525 526 527 528 529 530 531
		 -- 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
532

533 534 535
		   in closeAssoc' assoc
			(addOneToUniqSet visited x)
			(unionUniqSets   toVisit neighbors)
536

537
-- | intersect
538
intersectAssoc
539 540
	:: Uniquable a
	=> Assoc a -> Assoc a -> Assoc a
541

542 543
intersectAssoc a b
 	= intersectUFM_C (intersectUniqSets) a b
544