2 % (c) The AQUA Project, Glasgow University, 1993-1998
4 \section[AsmRegAlloc]{Register allocator}
7 module AsmRegAlloc ( runRegAllocate, runHairyRegAllocate ) where
9 #include "HsVersions.h"
11 import MachCode ( InstrBlock )
12 import MachMisc ( Instr(..) )
13 import PprMach ( pprUserReg ) -- debugging
17 import FiniteMap ( emptyFM, addListToFM, delListFromFM,
19 import Maybes ( maybeToBool )
20 import Unique ( mkBuiltinUnique )
21 import Util ( mapAccumB )
22 import OrdList ( unitOL, appOL, fromOL, concatOL )
24 import List ( mapAccumL )
27 This is the generic register allocator.
29 First we try something extremely simple. If that fails, we have to do
35 -> ([Instr] -> [[RegNo]])
39 runRegAllocate regs find_reserve_regs instrs
42 Nothing -> tryHairy reserves
45 = error "nativeGen: spilling failed. Try -fvia-C.\n"
47 = case hairyAlloc resv of
48 Just success -> success
49 Nothing -> tryHairy resvs
51 reserves = find_reserve_regs flatInstrs
52 flatInstrs = fromOL instrs
53 simpleAlloc = simpleRegAlloc regs [] emptyFM flatInstrs
54 hairyAlloc resvd = hairyRegAlloc regs resvd flatInstrs
63 runHairyRegAllocate regs reserve_regs instrs
64 = hairyRegAlloc regs reserve_regs flatInstrs
66 flatInstrs = fromOL instrs
69 Here is the simple register allocator. Just dole out registers until
70 we run out, or until one gets clobbered before its last use. Don't
71 do anything fancy with branches. Just pretend that you've got a block
72 of straight-line code and hope for the best. Experience indicates that
73 this approach will suffice for about 96 percent of the code blocks that
78 :: MRegsState -- registers to select from
79 -> [Reg] -- live static registers
80 -> RegAssignment -- mapping of dynamics to statics
84 simpleRegAlloc _ _ _ [] = Just []
86 simpleRegAlloc free live env (instr:instrs)
88 maybeToBool newAlloc &&
90 = Just (instr3 : instrs3)
94 instr3 = patchRegs instr (lookup env2)
96 (srcs, dsts) = case regUsage instr of
97 (RU s d) -> (regSetToList s, regSetToList d)
99 lookup env x = case lookupFM env x of Just y -> y; Nothing -> x
101 deadSrcs = [r | r@(UnmappedReg _ _) <- srcs, lookup env r `not_elem` live]
102 newDsts = [r | r@(UnmappedReg _ _) <- dsts, r `not_elem` keysFM env]
104 newAlloc = foldr allocateNewReg (Just (free, [])) newDsts
105 (free2, new) = case newAlloc of Just x -> x
107 env2 = env `addListToFM` new
109 live2 = map snd new ++ [x | x <- live, x `not_elem` dsts]
111 instrs2 = simpleRegAlloc free2 live2 env2 instrs
112 instrs3 = case instrs2 of Just x -> x
116 -> Maybe (MRegsState, [(Reg, Reg)])
117 -> Maybe (MRegsState, [(Reg, Reg)])
119 allocateNewReg _ Nothing = Nothing
121 allocateNewReg d@(UnmappedReg _ pk) (Just (free, prs))
122 | null choices = Nothing
123 | otherwise = Just (free2, prs2)
125 choices = possibleMRegs pk free
127 free2 = free `useMReg` (case reg of {IBOX(reg2) -> reg2} )
128 prs2 = ((d, MappedReg (case reg of {IBOX(reg2) -> reg2})) : prs)
131 Here is the ``clever'' bit. First go backward (i.e. left), looking for
132 the last use of dynamic registers. Then go forward (i.e. right), filling
133 registers with static placements.
135 hairyRegAlloc takes reserve_regs as the regs to use as spill
136 temporaries. First it tries to allocate using all regs except
137 reserve_regs. If that fails, it inserts spill code and tries again to
138 allocate regs, but this time with the spill temporaries available.
139 Even this might not work if there are insufficient spill temporaries:
140 in the worst case on x86, we'd need 3 of them, for insns like
141 addl (reg1,reg2,4) reg3, since this insn uses all 3 regs as input.
150 hairyRegAlloc regs reserve_regs instrs =
151 case mapAccumB (doRegAlloc reserve_regs)
152 (RH regs' 1 emptyFM) noFuture instrs of
153 (RH _ mloc1 _, _, instrs')
154 -- succeeded w/out using reserves
155 | mloc1 == 1 -> Just instrs'
156 -- failed, and no reserves avail, so pointless to attempt spilling
157 | null reserve_regs -> Nothing
158 -- failed, but we have reserves, so attempt to do spilling
160 -> let instrs_patched = patchMem instrs'
162 case mapAccumB (doRegAlloc []) (RH regs'' mloc1 emptyFM)
163 noFuture instrs_patched of
164 ((RH _ mloc2 _),_,instrs'')
165 -- successfully allocated the patched code
166 | mloc2 == mloc1 -> maybetrace (spillMsg True) (Just instrs'')
167 -- no; we have to give up
168 | otherwise -> maybetrace (spillMsg False) Nothing
171 regs' = regs `useMRegs` reserve_regs
172 regs'' = mkMRegsState reserve_regs
174 noFuture :: RegFuture
175 noFuture = RF emptyRegSet (FL emptyRegSet emptyFM) emptyFM
178 = "nativeGen: spilling "
179 ++ (if success then "succeeded" else "failed ")
181 ++ showSDoc (hsep (map (pprUserReg.toMappedReg)
182 (reverse reserve_regs)))
184 toMappedReg (I# i) = MappedReg i
186 maybetrace msg x = trace msg x
193 Here we patch instructions that reference ``registers'' which are
194 really in memory somewhere (the mapping is under the control of the
195 machine-specific code generator). We place the appropriate load
196 sequences before any instructions that use memory registers as
197 sources, and we place the appropriate spill sequences after any
198 instructions that use memory registers as destinations. The offending
199 instructions are rewritten with new dynamic registers, so we have to
200 run register allocation again after all of this is said and done.
202 On some architectures (x86, currently), we do without a frame-pointer,
203 and instead spill relative to the stack pointer (%esp on x86).
204 Because the stack pointer may move, the patcher needs to keep track of
205 the current stack pointer "delta". That's easy, because all it needs
206 to do is spot the DELTA bogus-insns which will have been inserted by
207 the relevant insn selector precisely so as to notify the spiller of
208 stack-pointer movement. The delta is passed to loadReg and spillReg,
209 since they generate the actual spill code. We expect the final delta
210 to be the same as the starting one (zero), reflecting the fact that
211 changes to the stack pointer should not extend beyond a basic block.
214 patchMem :: [Instr] -> [Instr]
216 = let (final_stack_delta, css) = mapAccumL patchMem' 0 cs
218 if final_stack_delta == 0
220 else pprPanic "patchMem: non-zero final delta"
221 (int final_stack_delta)
223 patchMem' :: Int -> Instr -> (Int, [Instr])
224 patchMem' delta instr
226 | null memSrcs && null memDsts
230 = (delta', loadSrcs ++ [instr'] ++ spillDsts)
232 delta' = case instr of DELTA d -> d ; _ -> delta
234 (RU srcs dsts) = regUsage instr
236 memToDyn (MemoryReg i pk) = UnmappedReg (mkBuiltinUnique i) pk
237 memToDyn other = other
239 memSrcs = [ r | r@(MemoryReg _ _) <- regSetToList srcs]
240 memDsts = [ r | r@(MemoryReg _ _) <- regSetToList dsts]
242 loadSrcs = map load memSrcs
243 spillDsts = map spill memDsts
245 load mem = loadReg delta mem (memToDyn mem)
246 spill mem = spillReg delta' (memToDyn mem) mem
248 instr' = patchRegs instr memToDyn
254 -> RegHistory MRegsState
257 -> (RegHistory MRegsState, RegFuture, Instr)
259 doRegAlloc reserved_regs free_env in_use instr = (free_env', in_use', instr')
261 (free_env', instr') = doRegAlloc' reserved_regs free_env info instr
262 (in_use', info) = getUsage in_use instr
269 -> (RegFuture, RegInfo Instr)
271 getUsage (RF next_in_use future reg_conflicts) instr
272 = (RF in_use' future' reg_conflicts',
273 RI in_use' srcs dsts last_used reg_conflicts')
274 where (RU srcs dsts) = regUsage instr
275 (RL in_use future') = regLiveness instr (RL next_in_use future)
276 live_through = in_use `minusRegSet` dsts
277 last_used = [ r | r <- regSetToList srcs,
278 not (r `elementOfRegSet` (fstFL future)
279 || r `elementOfRegSet` in_use)]
281 in_use' = srcs `unionRegSets` live_through
284 case new_conflicts of
286 _ -> addListToFM reg_conflicts new_conflicts
289 | isEmptyRegSet live_dynamics = []
291 [ (r, merge_conflicts r)
292 | r <- extractMappedRegNos (regSetToList dsts) ]
294 merge_conflicts reg =
295 case lookupFM reg_conflicts reg of
296 Nothing -> live_dynamics
297 Just conflicts -> conflicts `unionRegSets` live_dynamics
300 = mkRegSet [ r | r@(UnmappedReg _ _)
301 <- regSetToList live_through ]
305 -> RegHistory MRegsState
308 -> (RegHistory MRegsState, Instr)
310 doRegAlloc' reserved (RH frs loc env)
311 (RI in_use srcs dsts lastu conflicts) instr =
313 (RH frs'' loc' env'', patchRegs instr dynToStatic)
317 -- free up new registers
319 free = extractMappedRegNos (map dynToStatic lastu)
321 -- (1) free registers that are used last as
322 -- source operands in this instruction
323 frs_not_in_use = frs `useMRegs`
324 (extractMappedRegNos (regSetToList in_use))
325 frs' = (frs_not_in_use `freeMRegs` free) `useMRegs` reserved
327 -- (2) allocate new registers for the destination operands
328 -- allocate registers for new dynamics
330 new_dynamix = [ r | r@(UnmappedReg _ _) <- regSetToList dsts,
331 r `not_elem` keysFM env ]
333 (frs'', loc', new) = foldr allocateNewRegs (frs', loc, []) new_dynamix
335 env' = addListToFM env new
337 env'' = delListFromFM env' lastu
339 dynToStatic :: Reg -> Reg
340 dynToStatic dyn@(UnmappedReg _ _) =
341 case lookupFM env' dyn of
343 Nothing -> trace ("Lost register; possibly a floating point"
344 ++" type error in a _ccall_?") dyn
345 dynToStatic other = other
347 allocateNewRegs :: Reg
348 -> (MRegsState, Int, [(Reg, Reg)])
349 -> (MRegsState, Int, [(Reg, Reg)])
351 allocateNewRegs d@(UnmappedReg _ pk) (fs, mem, lst)
352 = (fs', mem', (d, f) : lst)
355 case acceptable fs of
356 [] -> (fs, MemoryReg mem pk, mem + 1)
357 (IBOX(x2):_) -> (fs `useMReg` x2, MappedReg x2, mem)
359 acceptable regs = filter no_conflict (possibleMRegs pk regs)
362 case lookupFM conflicts reg of
364 Just conflicts -> not (d `elementOfRegSet` conflicts)
367 We keep a local copy of the Prelude function \tr{notElem},
368 so that it can be specialised. (Hack me gently. [WDP 94/11])
371 not_elem x (y:ys) = x /= y && not_elem x ys