RegSpillClean.hs 11.7 KB
Newer Older
1 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 23 24
-- * 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_)
--
--	This also works if the reloads in B1/B2 were spills instead, because
--	spilling %r1 to a slot makes that slot have the same value as %r1.
--
25

26 27 28 29 30 31 32 33 34 35 36 37
module RegSpillClean (
	cleanSpills
)
where

import RegLiveness
import RegAllocInfo
import MachRegs
import MachInstrs
import Cmm

import UniqSet
38
import UniqFM
39
import Unique
40
import State
41
import Outputable
42
import Util
43 44

import Data.Maybe
45
import Data.List        ( nub )
46 47 48 49

-- | Clean out unneeded spill/reloads from this top level thing.
cleanSpills :: LiveCmmTop -> LiveCmmTop
cleanSpills cmm
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
	= evalState (cleanSpin 0 cmm) initCleanS

-- | do one pass of cleaning
cleanSpin :: Int -> LiveCmmTop -> CleanM LiveCmmTop

{-
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
 	-- init count of cleaned spills/reloads
	modify $ \s -> s
		{ sCleanedSpillsAcc	= 0
		, sCleanedReloadsAcc	= 0 }

 	code'	<- mapBlockTopM cleanBlock code

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

	-- remember how many spills/reloads we cleaned in this pass
	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
	   else cleanSpin (spinCount + 1) code'


-- | Clean one basic block
cleanBlock :: LiveBasicBlock -> CleanM LiveBasicBlock
cleanBlock (BasicBlock id instrs)
 = do	jumpValid	<- gets sJumpValid
 	let assoc	= case lookupUFM jumpValid id of
				Just assoc	-> assoc
				Nothing		-> emptyAssoc

105
 	instrs_reload	<- cleanFwd    assoc        [] instrs
106 107
 	instrs_spill	<- cleanSpill  emptyUniqSet [] instrs_reload
	return	$ BasicBlock id instrs_spill
108 109 110 111


-- | Clean out unneeded reload instructions.
--	Walking forwards across the code
112 113
--	  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.
114
--
115
cleanFwd
116
	:: Assoc Store	 	-- ^ two store locations are associated if they have the same value
117 118
	-> [LiveInstr]		-- ^ acc
	-> [LiveInstr] 		-- ^ instrs to clean (in backwards order)
119 120
	-> CleanM [LiveInstr]	-- ^ cleaned instrs  (in forward   order)

121
cleanFwd _ acc []
122 123
	= return acc

124 125 126
-- 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
--
127
cleanFwd assoc acc (Instr i1 live1 : Instr i2 _ : instrs)
128 129 130 131 132 133

	| SPILL  reg1  slot1	<- i1
	, RELOAD slot2 reg2	<- i2
	, slot1 == slot2
	= do
		modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
134
		cleanFwd assoc acc
135 136 137
			(Instr i1 live1 : Instr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs)


138
cleanFwd assoc acc (li@(Instr i1 _) : instrs)
139 140 141 142 143
	| Just (r1, r2)	<- isRegRegMove i1
	= 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
144
		then cleanFwd assoc acc instrs
145 146 147 148 149 150 151

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

152
			cleanFwd assoc' (li : acc) instrs
153 154


155
cleanFwd assoc acc (li@(Instr instr _) : instrs)
156 157

	| SPILL reg slot	<- instr
158 159
	= let	assoc'	= addAssoc (SReg reg)  (SSlot slot)	-- doing the spill makes reg and slot the same value
			$ delAssoc (SSlot slot) 		-- slot value changes on spill
160
			$ assoc
161
	  in	cleanFwd assoc' (li : acc) instrs
162

163 164 165 166 167 168
	-- clean a reload instr
	| RELOAD{}		<- instr
	= do	(assoc', mli)	<- cleanReload assoc li
		case mli of
			Nothing		-> cleanFwd assoc' acc 		instrs
			Just li'	-> cleanFwd assoc' (li' : acc)	instrs
169

170
	-- remember the association over a jump
Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
171
	| targets	<- jumpDests instr []
172 173
	, not $ null targets
	= do	mapM_ (accJumpValid assoc) targets
174
		cleanFwd assoc (li : acc) instrs
175

176
	-- writing to a reg changes its value.
Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
177
	| RU _ written	<- regUsage instr
178
	= let assoc'	= foldr delAssoc assoc (map SReg $ nub written)
179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214
	  in  cleanFwd assoc' (li : acc) instrs


-- | Try and rewrite a reload instruction to something more pleasing
--
cleanReload :: Assoc Store -> LiveInstr -> CleanM (Assoc Store, Maybe LiveInstr)
cleanReload assoc li@(Instr (RELOAD slot reg) _)

	-- 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
	--	update the association
	| otherwise
	= do	let assoc'	= addAssoc (SReg reg)  (SSlot slot)	-- doing the reload makes reg and slot the same value
				$ delAssoc (SReg reg)			-- reg value changes on reload
				$ assoc

	    	return	(assoc', Just li)

cleanReload _ _
	= panic "RegSpillClean.cleanReload: unhandled instr"
215 216 217 218 219 220 221 222


-- | Clean out unneeded spill instructions.
--	Walking backwards across the code.
--	 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.

cleanSpill
223
	:: UniqSet Int 		-- ^ slots that have been spilled, but not reloaded from
224 225
	-> [LiveInstr]		-- ^ acc
	-> [LiveInstr]		-- ^ instrs to clean (in forwards order)
226 227
	-> CleanM [LiveInstr]	-- ^ cleaned instrs  (in backwards order)

Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
228
cleanSpill _      acc []
229
	= return  acc
230

Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
231 232
cleanSpill unused acc (li@(Instr instr _) : instrs)
	| SPILL _ slot	<- instr
233 234
	= if elementOfUniqSet slot unused

235 236 237 238 239 240 241 242 243 244 245
	   -- 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 }
	   	cleanSpill unused acc instrs

	   else do
		-- slots start off unused
		let unused'	= addOneToUniqSet unused slot
	   	cleanSpill unused' (li : acc) instrs

	-- if we reload from a slot then it's no longer unused
Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
246
	| RELOAD slot _		<- instr
247 248 249
	, unused'		<- delOneFromUniqSet unused slot
	= cleanSpill unused' (li : acc) instrs

250
	-- some other instruction
251 252 253
	| otherwise
	= cleanSpill unused (li : acc) instrs

254 255 256

-- collateJoinPoints:
--
257
-- | combine the associations from all the inward control flow edges.
258 259 260 261 262 263 264
--
collateJoinPoints :: CleanM ()
collateJoinPoints
 = modify $ \s -> s
 	{ sJumpValid	= mapUFM intersects (sJumpValidAcc s)
	, sJumpValidAcc	= emptyUFM }

265
intersects :: [Assoc Store]	-> Assoc Store
266 267 268 269
intersects []		= emptyAssoc
intersects assocs	= foldl1' intersectAssoc assocs


270 271 272 273 274 275 276 277 278 279
-- | 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

280 281 282 283 284 285

---------------
type CleanM = State CleanS
data CleanS
	= CleanS
	{ -- regs which are valid at the start of each block.
286
	  sJumpValid		:: UniqFM (Assoc Store)
287 288 289 290

 	  -- collecting up what regs were valid across each jump.
	  --	in the next pass we can collate these and write the results
	  --	to sJumpValid.
291
	, sJumpValidAcc		:: UniqFM [Assoc Store]
292 293 294 295 296 297 298 299

	  -- spills/reloads cleaned each pass (latest at front)
	, sCleanedCount		:: [(Int, Int)]

	  -- spills/reloads that have been cleaned in this pass so far.
	, sCleanedSpillsAcc	:: Int
	, sCleanedReloadsAcc	:: Int }

Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
300
initCleanS :: CleanS
301 302 303 304 305 306 307 308 309 310 311
initCleanS
	= CleanS
	{ sJumpValid		= emptyUFM
	, sJumpValidAcc		= emptyUFM

	, sCleanedCount		= []

	, sCleanedSpillsAcc	= 0
	, sCleanedReloadsAcc	= 0 }


312 313 314
-- | Remember the associations before a jump
accJumpValid :: Assoc Store -> BlockId -> CleanM ()
accJumpValid assocs target
315 316 317 318
 	= modify $ \s -> s {
		sJumpValidAcc = addToUFM_C (++)
					(sJumpValidAcc s)
					target
319 320 321 322 323 324 325 326 327
					[assocs] }

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

328 329 330 331 332 333 334
-- | Check if this is a reg store
isStoreReg :: Store -> Bool
isStoreReg ss
 = case ss of
 	SSlot _	-> False
	SReg  _	-> True

335 336 337 338 339 340 341 342 343 344 345 346 347 348 349
-- spill cleaning is only done once all virtuals have been allocated to realRegs
--
instance Uniquable Store where
    getUnique (SReg  r)
	| RealReg i	<- r
	= mkUnique 'R' i

	| 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
350 351 352


--------------
353 354 355
-- Association graphs.
--	In the spill cleaner, two store locations are associated if they are known
--	to hold the same value.
356
--
357
type Assoc a	= UniqFM (UniqSet a)
358 359

-- | an empty association
360 361 362 363 364 365 366
emptyAssoc :: Assoc a
emptyAssoc	= emptyUFM


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

368 369 370 371
addAssoc a b m
 = let	m1	= addToUFM_C unionUniqSets m  a (unitUniqSet b)
 	m2	= addToUFM_C unionUniqSets m1 b (unitUniqSet a)
   in	m2
372 373


374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394
-- | 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
395 396 397


-- | check if these two things are associated
398 399 400 401 402
elemAssoc :: (Outputable a, Uniquable a)
	  => a -> a -> Assoc a -> Bool

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

404 405 406
-- | find the refl. trans. closure of the association from this point
closeAssoc :: (Outputable a, Uniquable a)
	=> a -> Assoc a -> UniqSet a
407

408 409 410 411 412
closeAssoc a assoc
 = 	closeAssoc' assoc emptyUniqSet (unitUniqSet a)
 where
	closeAssoc' assoc visited toVisit
	 = case uniqSetToList toVisit of
413

414 415
		-- nothing else to visit, we're done
	 	[]	-> visited
416

417
		(x:_)
418

419 420 421
		 -- we've already seen this node
		 |  elementOfUniqSet x visited
		 -> closeAssoc' assoc visited (delOneFromUniqSet toVisit x)
422

423 424 425 426 427 428 429
		 -- 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
430

431 432 433
		   in closeAssoc' assoc
			(addOneToUniqSet visited x)
			(unionUniqSets   toVisit neighbors)
434

435
-- | intersect
436
intersectAssoc
437 438
	:: Uniquable a
	=> Assoc a -> Assoc a -> Assoc a
439

440 441
intersectAssoc a b
 	= intersectUFM_C (intersectUniqSets) a b
442