Spill.hs 6.05 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
import RegAllocInfo
14 15
import Regs
import Instrs
16 17
import Cmm

18
import State
19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
import Unique
import UniqFM
import UniqSet
import UniqSupply
import Outputable

import Data.List
import Data.Maybe


-- | 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
	:: [LiveCmmTop]			-- ^ the code
	-> UniqSet Int			-- ^ available stack slots
	-> UniqSet Reg			-- ^ the regs to spill
	-> UniqSM
42 43 44
		([LiveCmmTop]		-- code will spill instructions
		, UniqSet Int		-- left over slots
		, SpillStats )		-- stats about what happened during spilling
45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64

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

		return	( code'
70 71
			, minusUniqSet slotsFree (mkUniqSet slots)
			, makeSpillStats state')
72 73 74 75 76 77 78 79 80 81


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

regSpill_instr _	li@(Instr _ Nothing)
 = do	return [li]

regSpill_instr regSlotMap
Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
82
	(Instr instr (Just _))
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
 = do
	-- work out which regs are read and written in this instr
	let RU rlRead rlWritten	= regUsage instr

	-- 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
	let instrs'	=  map (\i -> Instr i Nothing) prefixes
			++ [ Instr instr3 Nothing ]
			++ map (\i -> Instr i Nothing) postfixes

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

133
		modify $ \s -> s
134
			{ stateSpillSL 	= addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
135

136 137 138
	 	return	( instr'
			, ( [RELOAD slot nReg]
			  , []) )
139 140 141 142 143

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

spillWrite regSlotMap instr reg
	| Just slot	<- lookupUFM regSlotMap reg
144
	= do 	(instr', nReg)	<- patchInstr reg instr
145

146
		modify $ \s -> s
147
			{ stateSpillSL 	= addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
148

149 150 151
	 	return	( instr'
			, ( []
			  , [SPILL nReg slot]))
152 153 154 155 156

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

spillModify regSlotMap instr reg
	| Just slot	<- lookupUFM regSlotMap reg
157
	= do	(instr', nReg)	<- patchInstr reg instr
158

159
		modify $ \s -> s
160
			{ stateSpillSL 	= addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
161

162 163 164
		return	( instr'
			, ( [RELOAD slot nReg]
			  , [SPILL nReg slot]))
165 166 167 168

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


169

170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185
-- | rewrite uses of this virtual reg in an instr to use a different virtual reg
patchInstr :: Reg -> Instr -> SpillM (Instr, Reg)
patchInstr reg instr
 = do	nUnique		<- newUnique
 	let nReg	= renameVirtualReg nUnique reg
	let instr'	= patchReg1 reg nReg instr
	return		(instr', nReg)

patchReg1 :: Reg -> Reg -> Instr -> Instr
patchReg1 old new instr
 = let	patchF r
		| r == old	= new
		| otherwise	= r
   in	patchRegs instr patchF


186
------------------------------------------------------
187 188 189 190
-- Spiller monad

data SpillS
	= SpillS
191
	{ stateUS	:: UniqSupply
192
	, stateSpillSL	:: UniqFM (Reg, Int, Int) } -- ^ spilled reg vs number of times vreg was loaded, stored
193 194 195

initSpillS uniqueSupply
	= SpillS
196
	{ stateUS	= uniqueSupply
197
	, stateSpillSL	= emptyUFM }
198

199
type SpillM a	= State SpillS a
200 201 202

newUnique :: SpillM Unique
newUnique
203 204 205 206 207 208 209
 = 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
210
accSpillSL (r1, s1, l1) (_, s2, l2)
211
	= (r1, s1 + s2, l1 + l2)
212 213 214 215 216 217 218


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

data SpillStats
	= SpillStats
219
	{ spillStoreLoad	:: UniqFM (Reg, Int, Int) }
220 221 222 223

makeSpillStats :: SpillS -> SpillStats
makeSpillStats s
	= SpillStats
224
	{ spillStoreLoad	= stateSpillSL s }
225

226
instance Outputable SpillStats where
227 228 229
 ppr stats
 	= (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
			$ eltsUFM (spillStoreLoad stats))
230