Spill.hs 6.37 KB
Newer Older
1

Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
2
{-# OPTIONS -fno-warn-missing-signatures #-}
3

4
module RegAlloc.Graph.Spill (
5
	regSpill,
6
	SpillStats(..),
7
	accSpillSL
8 9 10 11
)

where

12
import RegAlloc.Liveness
13 14
import Instruction
import Reg
15 16
import Cmm

17
import State
18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35
import Unique
import UniqFM
import UniqSet
import UniqSupply
import Outputable

import Data.List


-- | Spill all these virtual regs to memory
--	TODO: 	see if we can split some of the live ranges instead of just globally
--		spilling the virtual reg.
--
--	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.
--
regSpill
36 37
	:: Instruction instr
	=> [LiveCmmTop instr]		-- ^ the code
38
	-> UniqSet Int			-- ^ available stack slots
39
	-> UniqSet VirtualReg		-- ^ the regs to spill
40
	-> UniqSM
41
		([LiveCmmTop instr]	-- code will spill instructions
42 43
		, UniqSet Int		-- left over slots
		, SpillStats )		-- stats about what happened during spilling
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63

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
64 65
		let (code', state')	=
			runState (mapM (mapBlockTopM (regSpill_block regSlotMap)) code)
66 67 68
				 (initSpillS us)

		return	( code'
69 70
			, minusUniqSet slotsFree (mkUniqSet slots)
			, makeSpillStats state')
71 72 73 74 75 76


regSpill_block regSlotMap (BasicBlock i instrs)
 = do	instrss'	<- mapM (regSpill_instr regSlotMap) instrs
 	return	$ BasicBlock i (concat instrss')

77 78 79 80 81 82

regSpill_instr
	:: Instruction instr
	=> UniqFM Int 
	-> LiveInstr instr -> SpillM [LiveInstr instr]

83
regSpill_instr _ li@(LiveInstr _ Nothing)
84 85 86
 = do	return [li]

regSpill_instr regSlotMap
87
	(LiveInstr instr (Just _))
88 89
 = do
	-- work out which regs are read and written in this instr
90
	let RU rlRead rlWritten	= regUsageOfInstr instr
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

	-- 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
117
	let instrs'	=  prefixes
118
			++ [LiveInstr instr3 Nothing]
119
			++ postfixes
120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135

	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
136
	= do 	(instr', nReg)	<- patchInstr reg instr
137

138
		modify $ \s -> s
139
			{ stateSpillSL 	= addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
140

141
	 	return	( instr'
142
			, ( [LiveInstr (RELOAD slot nReg) Nothing]
143
			  , []) )
144 145 146

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

147

148 149
spillWrite regSlotMap instr reg
	| Just slot	<- lookupUFM regSlotMap reg
150
	= do 	(instr', nReg)	<- patchInstr reg instr
151

152
		modify $ \s -> s
153
			{ stateSpillSL 	= addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
154

155 156
	 	return	( instr'
			, ( []
157
			  , [LiveInstr (SPILL nReg slot) Nothing]))
158 159 160

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

161

162 163
spillModify regSlotMap instr reg
	| Just slot	<- lookupUFM regSlotMap reg
164
	= do	(instr', nReg)	<- patchInstr reg instr
165

166
		modify $ \s -> s
167
			{ stateSpillSL 	= addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
168

169
		return	( instr'
170 171
			, ( [LiveInstr (RELOAD slot nReg) Nothing]
			  , [LiveInstr (SPILL nReg slot) Nothing]))
172 173 174 175

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


176

177
-- | rewrite uses of this virtual reg in an instr to use a different virtual reg
178 179 180 181
patchInstr 
	:: Instruction instr
	=> Reg -> instr -> SpillM (instr, Reg)

182 183
patchInstr reg instr
 = do	nUnique		<- newUnique
184 185 186
 	let nReg	= case reg of 
				RegVirtual vr 	-> RegVirtual (renameVirtualReg nUnique vr)
				RegReal{}	-> panic "RegAlloc.Graph.Spill.patchIntr: not patching real reg"
187 188 189
	let instr'	= patchReg1 reg nReg instr
	return		(instr', nReg)

190 191 192 193
patchReg1 
	:: Instruction instr
	=> Reg -> Reg -> instr -> instr

194 195 196 197
patchReg1 old new instr
 = let	patchF r
		| r == old	= new
		| otherwise	= r
198
   in	patchRegsOfInstr instr patchF
199 200


201
------------------------------------------------------
202 203 204 205
-- Spiller monad

data SpillS
	= SpillS
206
	{ stateUS	:: UniqSupply
207
	, stateSpillSL	:: UniqFM (Reg, Int, Int) } -- ^ spilled reg vs number of times vreg was loaded, stored
208 209 210

initSpillS uniqueSupply
	= SpillS
211
	{ stateUS	= uniqueSupply
212
	, stateSpillSL	= emptyUFM }
213

214
type SpillM a	= State SpillS a
215 216 217

newUnique :: SpillM Unique
newUnique
218 219 220 221 222 223 224
 = do	us	<- gets stateUS
 	case splitUniqSupply us of
	 (us1, us2)
	  -> do let uniq = uniqFromSupply us1
	  	modify $ \s -> s { stateUS = us2 }
		return uniq

Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
225
accSpillSL (r1, s1, l1) (_, s2, l2)
226
	= (r1, s1 + s2, l1 + l2)
227 228 229 230 231 232 233


----------------------------------------------------
-- Spiller stats

data SpillStats
	= SpillStats
234
	{ spillStoreLoad	:: UniqFM (Reg, Int, Int) }
235 236 237 238

makeSpillStats :: SpillS -> SpillStats
makeSpillStats s
	= SpillStats
239
	{ spillStoreLoad	= stateSpillSL s }
240

241
instance Outputable SpillStats where
242 243 244
 ppr stats
 	= (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
			$ eltsUFM (spillStoreLoad stats))
245