Spill.hs 9.44 KB
Newer Older
Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
1
{-# OPTIONS -fno-warn-missing-signatures #-}
2

3 4 5
-- | When there aren't enough registers to hold all the vregs we have to spill some of those
--   vregs to slots on the stack. This module is used modify the code to use those slots.
--
6
module RegAlloc.Graph.Spill (
7
	regSpill,
8
	SpillStats(..),
9
	accSpillSL
10 11
)
where
12
import RegAlloc.Liveness
13 14
import Instruction
import Reg
15 16
import Cmm	hiding (RegSet)
import BlockId
17

18
import State
19 20 21 22 23 24 25
import Unique
import UniqFM
import UniqSet
import UniqSupply
import Outputable

import Data.List
26 27 28 29 30
import Data.Maybe
import Data.Map			(Map)
import Data.Set			(Set)
import qualified Data.Map	as Map
import qualified Data.Set	as Set
31 32


33 34 35 36
-- | Spill all these virtual regs to stack slots.
-- 
--   TODO: See if we can split some of the live ranges instead of just globally
--         spilling the virtual reg. This might make the spill cleaner's job easier.
37
--
38 39 40
--   TODO: On CISCy x86 and x86_64 we don't nessesarally have to add a mov instruction
--         when making spills. If an instr is using a spilled virtual we may be able to
--         address the spill slot directly.
41 42
--
regSpill
43 44
	:: Instruction instr
	=> [LiveCmmTop instr]		-- ^ the code
45
	-> UniqSet Int			-- ^ available stack slots
46
	-> UniqSet VirtualReg		-- ^ the regs to spill
47
	-> UniqSM
48
		([LiveCmmTop instr]	-- code with SPILL and RELOAD meta instructions added.
49 50
		, UniqSet Int		-- left over slots
		, SpillStats )		-- stats about what happened during spilling
51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70

regSpill code slotsFree regs

	-- not enough slots to spill these regs
	| sizeUniqSet slotsFree < sizeUniqSet regs
	= pprPanic "regSpill: out of spill slots!"
		(  text "   regs to spill = " <> ppr (sizeUniqSet regs)
		$$ text "   slots left    = " <> ppr (sizeUniqSet slotsFree))

	| otherwise
	= do
		-- allocate a slot for each of the spilled regs
		let slots	= take (sizeUniqSet regs) $ uniqSetToList slotsFree
		let regSlotMap	= listToUFM
				$ zip (uniqSetToList regs) slots

		-- grab the unique supply from the monad
		us	<- getUs

		-- run the spiller on all the blocks
71
		let (code', state')	=
72
			runState (mapM (regSpill_top regSlotMap) code)
73 74 75
				 (initSpillS us)

		return	( code'
76 77
			, minusUniqSet slotsFree (mkUniqSet slots)
			, makeSpillStats state')
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 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
-- | Spill some registers to stack slots in a top-level thing.
regSpill_top 
	:: Instruction instr
	=> RegMap Int 			-- ^ map of vregs to slots they're being spilled to.
	-> LiveCmmTop instr		-- ^ the top level thing.
	-> SpillM (LiveCmmTop instr)
	
regSpill_top regSlotMap cmm
 = case cmm of
	CmmData{}				
	 -> return cmm

	CmmProc info label params sccs
	 |  LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
	 -> do	
		-- We should only passed Cmms with the liveness maps filled in,  but we'll
		-- create empty ones if they're not there just in case.
		let liveVRegsOnEntry	= fromMaybe emptyBlockEnv mLiveVRegsOnEntry
		
		-- The liveVRegsOnEntry contains the set of vregs that are live on entry to
		-- each basic block. If we spill one of those vregs we remove it from that
		-- set and add the corresponding slot number to the liveSlotsOnEntry set.
		-- The spill cleaner needs this information to erase unneeded spill and 
		-- reload instructions after we've done a successful allocation.
		let liveSlotsOnEntry' :: Map BlockId (Set Int)
		    liveSlotsOnEntry'
			= foldBlockEnv patchLiveSlot liveSlotsOnEntry liveVRegsOnEntry

		let info'
			= LiveInfo static firstId
				(Just liveVRegsOnEntry)
				liveSlotsOnEntry'
					
		-- Apply the spiller to all the basic blocks in the CmmProc.
		sccs'		<- mapM (mapSCCM (regSpill_block regSlotMap)) sccs

		return	$ CmmProc info' label params sccs'

 where	-- | Given a BlockId and the set of registers live in it, 
	--   if registers in this block are being spilled to stack slots, 
	--   then record the fact that these slots are now live in those blocks
	--   in the given slotmap.
	patchLiveSlot :: BlockId -> RegSet -> Map BlockId (Set Int) -> Map BlockId (Set Int)
	patchLiveSlot blockId regsLive slotMap
	 = let	curSlotsLive	= fromMaybe Set.empty
				$ Map.lookup blockId slotMap

		moreSlotsLive	= Set.fromList
				$ catMaybes 
				$ map (lookupUFM regSlotMap)
				$ uniqSetToList regsLive
		
	  	slotMap'	= Map.insert blockId (Set.union curSlotsLive moreSlotsLive) slotMap

	   in	slotMap'



-- | Spill some registers to stack slots in a basic block.
regSpill_block
	:: Instruction instr
	=> UniqFM Int		-- ^ map of vregs to slots they're being spilled to.
	-> LiveBasicBlock instr	
	-> SpillM (LiveBasicBlock instr)
	
145 146 147 148
regSpill_block regSlotMap (BasicBlock i instrs)
 = do	instrss'	<- mapM (regSpill_instr regSlotMap) instrs
 	return	$ BasicBlock i (concat instrss')

149

150 151 152
-- | Spill some registers to stack slots in a single instruction.  If the instruction
--   uses registers that need to be spilled, then it is prefixed (or postfixed) with
--   the appropriate RELOAD or SPILL meta instructions.
153 154
regSpill_instr
	:: Instruction instr
155 156 157
	=> UniqFM Int 		-- ^ map of vregs to slots they're being spilled to.
	-> LiveInstr instr
	-> SpillM [LiveInstr instr]
158

159
regSpill_instr _ li@(LiveInstr _ Nothing)
160 161 162
 = do	return [li]

regSpill_instr regSlotMap
163
	(LiveInstr instr (Just _))
164 165
 = do
	-- work out which regs are read and written in this instr
166
	let RU rlRead rlWritten	= regUsageOfInstr instr
167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192

	-- sometimes a register is listed as being read more than once,
	--	nub this so we don't end up inserting two lots of spill code.
	let rsRead_		= nub rlRead
	let rsWritten_		= nub rlWritten

	-- if a reg is modified, it appears in both lists, want to undo this..
	let rsRead		= rsRead_    \\ rsWritten_
	let rsWritten		= rsWritten_ \\ rsRead_
	let rsModify		= intersect rsRead_ rsWritten_

	-- work out if any of the regs being used are currently being spilled.
	let rsSpillRead		= filter (\r -> elemUFM r regSlotMap) rsRead
	let rsSpillWritten	= filter (\r -> elemUFM r regSlotMap) rsWritten
	let rsSpillModify	= filter (\r -> elemUFM r regSlotMap) rsModify

	-- rewrite the instr and work out spill code.
	(instr1, prepost1)	<- mapAccumLM (spillRead   regSlotMap) instr  rsSpillRead
	(instr2, prepost2)	<- mapAccumLM (spillWrite  regSlotMap) instr1 rsSpillWritten
	(instr3, prepost3)	<- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify

	let (mPrefixes, mPostfixes)	= unzip (prepost1 ++ prepost2 ++ prepost3)
	let prefixes			= concat mPrefixes
	let postfixes			= concat mPostfixes

	-- final code
193
	let instrs'	=  prefixes
194
			++ [LiveInstr instr3 Nothing]
195
			++ postfixes
196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211

	return
{-		$ pprTrace "* regSpill_instr spill"
			(  text "instr  = " <> ppr instr
			$$ text "read   = " <> ppr rsSpillRead
			$$ text "write  = " <> ppr rsSpillWritten
			$$ text "mod    = " <> ppr rsSpillModify
			$$ text "-- out"
			$$ (vcat $ map ppr instrs')
			$$ text " ")
-}
		$ instrs'


spillRead regSlotMap instr reg
	| Just slot	<- lookupUFM regSlotMap reg
212
	= do 	(instr', nReg)	<- patchInstr reg instr
213

214
		modify $ \s -> s
215
			{ stateSpillSL 	= addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
216

217
	 	return	( instr'
218
			, ( [LiveInstr (RELOAD slot nReg) Nothing]
219
			  , []) )
220 221 222

	| otherwise	= panic "RegSpill.spillRead: no slot defined for spilled reg"

223

224 225
spillWrite regSlotMap instr reg
	| Just slot	<- lookupUFM regSlotMap reg
226
	= do 	(instr', nReg)	<- patchInstr reg instr
227

228
		modify $ \s -> s
229
			{ stateSpillSL 	= addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
230

231 232
	 	return	( instr'
			, ( []
233
			  , [LiveInstr (SPILL nReg slot) Nothing]))
234 235 236

	| otherwise	= panic "RegSpill.spillWrite: no slot defined for spilled reg"

237

238 239
spillModify regSlotMap instr reg
	| Just slot	<- lookupUFM regSlotMap reg
240
	= do	(instr', nReg)	<- patchInstr reg instr
241

242
		modify $ \s -> s
243
			{ stateSpillSL 	= addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
244

245
		return	( instr'
246 247
			, ( [LiveInstr (RELOAD slot nReg) Nothing]
			  , [LiveInstr (SPILL nReg slot) Nothing]))
248 249 250 251

	| otherwise	= panic "RegSpill.spillModify: no slot defined for spilled reg"


252

253
-- | Rewrite uses of this virtual reg in an instr to use a different virtual reg
254 255 256 257
patchInstr 
	:: Instruction instr
	=> Reg -> instr -> SpillM (instr, Reg)

258 259
patchInstr reg instr
 = do	nUnique		<- newUnique
260 261 262
 	let nReg	= case reg of 
				RegVirtual vr 	-> RegVirtual (renameVirtualReg nUnique vr)
				RegReal{}	-> panic "RegAlloc.Graph.Spill.patchIntr: not patching real reg"
263 264 265
	let instr'	= patchReg1 reg nReg instr
	return		(instr', nReg)

266 267 268 269
patchReg1 
	:: Instruction instr
	=> Reg -> Reg -> instr -> instr

270 271 272 273
patchReg1 old new instr
 = let	patchF r
		| r == old	= new
		| otherwise	= r
274
   in	patchRegsOfInstr instr patchF
275 276


277
-- Spiller monad --------------------------------------------------------------
278 279
data SpillS
	= SpillS
280 281 282 283 284
	{ -- | unique supply for generating fresh vregs.
	  stateUS	:: UniqSupply
	
	  -- | spilled vreg vs the number of times it was loaded, stored 
	, stateSpillSL	:: UniqFM (Reg, Int, Int) }
285 286 287

initSpillS uniqueSupply
	= SpillS
288
	{ stateUS	= uniqueSupply
289
	, stateSpillSL	= emptyUFM }
290

291
type SpillM a	= State SpillS a
292 293 294

newUnique :: SpillM Unique
newUnique
Ian Lynagh's avatar
Ian Lynagh committed
295 296 297 298 299 300
 = do   us      <- gets stateUS
        case splitUniqSupply us of
         (us1, us2)
          -> do let uniq = uniqFromSupply us1
                modify $ \s -> s { stateUS = us2 }
                return uniq
301

Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
302
accSpillSL (r1, s1, l1) (_, s2, l2)
303
	= (r1, s1 + s2, l1 + l2)
304 305


306
-- Spiller stats --------------------------------------------------------------
307 308
data SpillStats
	= SpillStats
309
	{ spillStoreLoad	:: UniqFM (Reg, Int, Int) }
310 311 312 313

makeSpillStats :: SpillS -> SpillStats
makeSpillStats s
	= SpillStats
314
	{ spillStoreLoad	= stateSpillSL s }
315

316
instance Outputable SpillStats where
317 318 319
 ppr stats
 	= (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
			$ eltsUFM (spillStoreLoad stats))
320