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 -> trace (spillMsg True) (Just instrs'')
167 -- no; we have to give up
168 | otherwise -> trace (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
187 Here we patch instructions that reference ``registers'' which are
188 really in memory somewhere (the mapping is under the control of the
189 machine-specific code generator). We place the appropriate load
190 sequences before any instructions that use memory registers as
191 sources, and we place the appropriate spill sequences after any
192 instructions that use memory registers as destinations. The offending
193 instructions are rewritten with new dynamic registers, so we have to
194 run register allocation again after all of this is said and done.
196 On some architectures (x86, currently), we do without a frame-pointer,
197 and instead spill relative to the stack pointer (%esp on x86).
198 Because the stack pointer may move, the patcher needs to keep track of
199 the current stack pointer "delta". That's easy, because all it needs
200 to do is spot the DELTA bogus-insns which will have been inserted by
201 the relevant insn selector precisely so as to notify the spiller of
202 stack-pointer movement. The delta is passed to loadReg and spillReg,
203 since they generate the actual spill code. We expect the final delta
204 to be the same as the starting one (zero), reflecting the fact that
205 changes to the stack pointer should not extend beyond a basic block.
208 patchMem :: [Instr] -> [Instr]
210 = let (final_stack_delta, css) = mapAccumL patchMem' 0 cs
212 if final_stack_delta == 0
214 else pprPanic "patchMem: non-zero final delta"
215 (int final_stack_delta)
217 patchMem' :: Int -> Instr -> (Int, [Instr])
218 patchMem' delta instr
220 | null memSrcs && null memDsts
224 = (delta', loadSrcs ++ [instr'] ++ spillDsts)
226 delta' = case instr of DELTA d -> d ; _ -> delta
228 (RU srcs dsts) = regUsage instr
230 memToDyn (MemoryReg i pk) = UnmappedReg (mkBuiltinUnique i) pk
231 memToDyn other = other
233 memSrcs = [ r | r@(MemoryReg _ _) <- regSetToList srcs]
234 memDsts = [ r | r@(MemoryReg _ _) <- regSetToList dsts]
236 loadSrcs = map load memSrcs
237 spillDsts = map spill memDsts
239 load mem = loadReg delta mem (memToDyn mem)
240 spill mem = spillReg delta' (memToDyn mem) mem
242 instr' = patchRegs instr memToDyn
248 -> RegHistory MRegsState
251 -> (RegHistory MRegsState, RegFuture, Instr)
253 doRegAlloc reserved_regs free_env in_use instr = (free_env', in_use', instr')
255 (free_env', instr') = doRegAlloc' reserved_regs free_env info instr
256 (in_use', info) = getUsage in_use instr
263 -> (RegFuture, RegInfo Instr)
265 getUsage (RF next_in_use future reg_conflicts) instr
266 = (RF in_use' future' reg_conflicts',
267 RI in_use' srcs dsts last_used reg_conflicts')
268 where (RU srcs dsts) = regUsage instr
269 (RL in_use future') = regLiveness instr (RL next_in_use future)
270 live_through = in_use `minusRegSet` dsts
271 last_used = [ r | r <- regSetToList srcs,
272 not (r `elementOfRegSet` (fstFL future)
273 || r `elementOfRegSet` in_use)]
275 in_use' = srcs `unionRegSets` live_through
278 case new_conflicts of
280 _ -> addListToFM reg_conflicts new_conflicts
283 | isEmptyRegSet live_dynamics = []
285 [ (r, merge_conflicts r)
286 | r <- extractMappedRegNos (regSetToList dsts) ]
288 merge_conflicts reg =
289 case lookupFM reg_conflicts reg of
290 Nothing -> live_dynamics
291 Just conflicts -> conflicts `unionRegSets` live_dynamics
294 = mkRegSet [ r | r@(UnmappedReg _ _)
295 <- regSetToList live_through ]
299 -> RegHistory MRegsState
302 -> (RegHistory MRegsState, Instr)
304 doRegAlloc' reserved (RH frs loc env)
305 (RI in_use srcs dsts lastu conflicts) instr =
307 (RH frs'' loc' env'', patchRegs instr dynToStatic)
311 -- free up new registers
313 free = extractMappedRegNos (map dynToStatic lastu)
315 -- (1) free registers that are used last as
316 -- source operands in this instruction
317 frs_not_in_use = frs `useMRegs`
318 (extractMappedRegNos (regSetToList in_use))
319 frs' = (frs_not_in_use `freeMRegs` free) `useMRegs` reserved
321 -- (2) allocate new registers for the destination operands
322 -- allocate registers for new dynamics
324 new_dynamix = [ r | r@(UnmappedReg _ _) <- regSetToList dsts,
325 r `not_elem` keysFM env ]
327 (frs'', loc', new) = foldr allocateNewRegs (frs', loc, []) new_dynamix
329 env' = addListToFM env new
331 env'' = delListFromFM env' lastu
333 dynToStatic :: Reg -> Reg
334 dynToStatic dyn@(UnmappedReg _ _) =
335 case lookupFM env' dyn of
337 Nothing -> trace ("Lost register; possibly a floating point"
338 ++" type error in a _ccall_?") dyn
339 dynToStatic other = other
341 allocateNewRegs :: Reg
342 -> (MRegsState, Int, [(Reg, Reg)])
343 -> (MRegsState, Int, [(Reg, Reg)])
345 allocateNewRegs d@(UnmappedReg _ pk) (fs, mem, lst)
346 = (fs', mem', (d, f) : lst)
349 case acceptable fs of
350 [] -> (fs, MemoryReg mem pk, mem + 1)
351 (IBOX(x2):_) -> (fs `useMReg` x2, MappedReg x2, mem)
353 acceptable regs = filter no_conflict (possibleMRegs pk regs)
356 case lookupFM conflicts reg of
358 Just conflicts -> not (d `elementOfRegSet` conflicts)
361 We keep a local copy of the Prelude function \tr{notElem},
362 so that it can be specialised. (Hack me gently. [WDP 94/11])
365 not_elem x (y:ys) = x /= y && not_elem x ys