2 -- | Handles joining of a jump instruction to its targets.
4 -- The first time we encounter a jump to a particular basic block, we
5 -- record the assignment of temporaries. The next time we encounter a
6 -- jump to the same block, we compare our current assignment to the
7 -- stored one. They might be different if spilling has occrred in one
8 -- branch; so some fixup code will be required to match up the assignments.
10 module RegAlloc.Linear.JoinToTargets (
16 import RegAlloc.Linear.State
17 import RegAlloc.Linear.Base
18 import RegAlloc.Linear.FreeRegs
19 import RegAlloc.Liveness
24 import OldCmm hiding (RegSet)
32 -- | For a jump instruction at the end of a block, generate fixup code so its
33 -- vregs are in the correct regs for its destination.
36 :: (FR freeRegs, Instruction instr)
37 => BlockMap RegSet -- ^ maps the unique of the blockid to the set of vregs
38 -- that are known to be live on the entry to each block.
40 -> BlockId -- ^ id of the current block
41 -> instr -- ^ branch instr on the end of the source block.
43 -> RegM freeRegs ([NatBasicBlock instr] -- fresh blocks of fixup code.
44 , instr) -- the original branch instruction, but maybe patched to jump
45 -- to a fixup block first.
47 joinToTargets block_live id instr
49 -- we only need to worry about jump instructions.
50 | not $ isJumpishInstr instr
54 = joinToTargets' block_live [] id instr (jumpDestsOfInstr instr)
58 :: (FR freeRegs, Instruction instr)
59 => BlockMap RegSet -- ^ maps the unique of the blockid to the set of vregs
60 -- that are known to be live on the entry to each block.
62 -> [NatBasicBlock instr] -- ^ acc blocks of fixup code.
64 -> BlockId -- ^ id of the current block
65 -> instr -- ^ branch instr on the end of the source block.
67 -> [BlockId] -- ^ branch destinations still to consider.
69 -> RegM freeRegs ( [NatBasicBlock instr]
72 -- no more targets to consider. all done.
73 joinToTargets' _ new_blocks _ instr []
74 = return (new_blocks, instr)
76 -- handle a branch target.
77 joinToTargets' block_live new_blocks block_id instr (dest:dests)
79 -- get the map of where the vregs are stored on entry to each basic block.
80 block_assig <- getBlockAssigR
82 -- get the assignment on entry to the branch instruction.
85 -- adjust the current assignment to remove any vregs that are not live
86 -- on entry to the destination block.
87 let Just live_set = mapLookup dest block_live
88 let still_live uniq _ = uniq `elemUniqSet_Directly` live_set
89 let adjusted_assig = filterUFM_Directly still_live assig
91 -- and free up those registers which are now free.
93 [ r | (reg, loc) <- ufmToList assig
94 , not (elemUniqSet_Directly reg live_set)
95 , r <- regsOfLoc loc ]
97 case mapLookup dest block_assig of
99 -> joinToTargets_first
100 block_live new_blocks block_id instr dest dests
101 block_assig adjusted_assig to_free
104 -> joinToTargets_again
105 block_live new_blocks block_id instr dest dests
106 adjusted_assig dest_assig
109 -- this is the first time we jumped to this block.
110 joinToTargets_first :: (FR freeRegs, Instruction instr)
112 -> [NatBasicBlock instr]
117 -> BlockAssignment freeRegs
120 -> RegM freeRegs ([NatBasicBlock instr], instr)
121 joinToTargets_first block_live new_blocks block_id instr dest dests
122 block_assig src_assig
125 = do -- free up the regs that are not live on entry to this block.
126 freeregs <- getFreeRegsR
127 let freeregs' = foldr frReleaseReg freeregs to_free
129 -- remember the current assignment on entry to this block.
130 setBlockAssigR (mapInsert dest (freeregs', src_assig) block_assig)
132 joinToTargets' block_live new_blocks block_id instr dests
135 -- we've jumped to this block before
136 joinToTargets_again :: (Instruction instr, FR freeRegs)
138 -> [NatBasicBlock instr]
145 -> RegM freeRegs ([NatBasicBlock instr], instr)
147 block_live new_blocks block_id instr dest dests
150 -- the assignments already match, no problem.
151 | ufmToList dest_assig == ufmToList src_assig
152 = joinToTargets' block_live new_blocks block_id instr dests
154 -- assignments don't match, need fixup code
158 -- make a graph of what things need to be moved where.
159 let graph = makeRegMovementGraph src_assig dest_assig
161 -- look for cycles in the graph. This can happen if regs need to be swapped.
162 -- Note that we depend on the fact that this function does a
163 -- bottom up traversal of the tree-like portions of the graph.
168 -- ie move value in R1 to R2 and value in R2 to R3.
170 -- We need to do the R2 -> R3 move before R1 -> R2.
172 let sccs = stronglyConnCompFromEdgedVerticesR graph
176 ("joinToTargets: making fixup code")
177 (vcat [ text " in block: " <> ppr block_id
178 , text " jmp instruction: " <> ppr instr
179 , text " src assignment: " <> ppr src_assig
180 , text " dest assignment: " <> ppr dest_assig
181 , text " movement graph: " <> ppr graph
182 , text " sccs of graph: " <> ppr sccs
187 fixUpInstrs_ <- mapM (handleComponent delta instr) sccs
188 let fixUpInstrs = concat fixUpInstrs_
190 -- make a new basic block containing the fixup code.
191 -- A the end of the current block we will jump to the fixup one,
192 -- then that will jump to our original destination.
193 fixup_block_id <- getUniqueR
194 let block = BasicBlock (mkBlockId fixup_block_id)
195 $ fixUpInstrs ++ mkJumpInstr dest
198 ("joinToTargets: fixup code is:")
203 -- if we didn't need any fixups, then don't include the block
205 [] -> joinToTargets' block_live new_blocks block_id instr dests
207 -- patch the original branch instruction so it goes to our
208 -- fixup block instead.
209 _ -> let instr' = patchJumpInstr instr
210 (\bid -> if bid == dest
211 then mkBlockId fixup_block_id
212 else bid) -- no change!
214 in joinToTargets' block_live (block : new_blocks) block_id instr' dests
217 -- | Construct a graph of register\/spill movements.
219 -- Cyclic components seem to occur only very rarely.
221 -- We cut some corners by not handling memory-to-memory moves.
222 -- This shouldn't happen because every temporary gets its own stack slot.
224 makeRegMovementGraph :: RegMap Loc -> RegMap Loc -> [(Unique, Loc, [Loc])]
225 makeRegMovementGraph adjusted_assig dest_assig
228 = expandNode vreg src
229 $ lookupWithDefaultUFM_Directly
231 (panic "RegAllocLinear.makeRegMovementGraph")
234 in [ node | (vreg, src) <- ufmToList adjusted_assig
235 , node <- mkNodes src vreg ]
238 -- | Expand out the destination, so InBoth destinations turn into
239 -- a combination of InReg and InMem.
241 -- The InBoth handling is a little tricky here. If the destination is
242 -- InBoth, then we must ensure that the value ends up in both locations.
243 -- An InBoth destination must conflict with an InReg or InMem source, so
244 -- we expand an InBoth destination as necessary.
246 -- An InBoth source is slightly different: we only care about the register
247 -- that the source value is in, so that we can move it to the destinations.
251 -> Loc -- ^ source of move
252 -> Loc -- ^ destination of move
255 expandNode vreg loc@(InReg src) (InBoth dst mem)
256 | src == dst = [(vreg, loc, [InMem mem])]
257 | otherwise = [(vreg, loc, [InReg dst, InMem mem])]
259 expandNode vreg loc@(InMem src) (InBoth dst mem)
260 | src == mem = [(vreg, loc, [InReg dst])]
261 | otherwise = [(vreg, loc, [InReg dst, InMem mem])]
263 expandNode _ (InBoth _ src) (InMem dst)
264 | src == dst = [] -- guaranteed to be true
266 expandNode _ (InBoth src _) (InReg dst)
269 expandNode vreg (InBoth src _) dst
270 = expandNode vreg (InReg src) dst
272 expandNode vreg src dst
274 | otherwise = [(vreg, src, [dst])]
277 -- | Generate fixup code for a particular component in the move graph
278 -- This component tells us what values need to be moved to what
279 -- destinations. We have eliminated any possibility of single-node
280 -- cycles in expandNode above.
284 => Int -> instr -> SCC (Unique, Loc, [Loc]) -> RegM freeRegs [instr]
286 -- If the graph is acyclic then we won't get the swapping problem below.
287 -- In this case we can just do the moves directly, and avoid having to
288 -- go via a spill slot.
290 handleComponent delta _ (AcyclicSCC (vreg, src, dsts))
291 = mapM (makeMove delta vreg src) dsts
294 -- Handle some cyclic moves.
295 -- This can happen if we have two regs that need to be swapped.
297 -- vreg source loc dest loc
298 -- (vreg1, InReg r1, [InReg r2])
299 -- (vreg2, InReg r2, [InReg r1])
301 -- To avoid needing temp register, we just spill all the source regs, then
302 -- reaload them into their destination regs.
304 -- Note that we can not have cycles that involve memory locations as
305 -- sources as single destination because memory locations (stack slots)
306 -- are allocated exclusively for a virtual register and therefore can not
309 handleComponent delta instr
310 (CyclicSCC ( (vreg, InReg sreg, (InReg dreg: _)) : rest))
311 -- dest list may have more than one element, if the reg is also InMem.
313 -- spill the source into its slot
315 <- spillR (RegReal sreg) vreg
317 -- reload into destination reg
318 instrLoad <- loadR (RegReal dreg) slot
320 remainingFixUps <- mapM (handleComponent delta instr)
321 (stronglyConnCompFromEdgedVerticesR rest)
323 -- make sure to do all the reloads after all the spills,
324 -- so we don't end up clobbering the source values.
325 return ([instrSpill] ++ concat remainingFixUps ++ [instrLoad])
327 handleComponent _ _ (CyclicSCC _)
328 = panic "Register Allocator: handleComponent cyclic"
331 -- | Move a vreg between these two locations.
335 => Int -- ^ current C stack delta.
336 -> Unique -- ^ unique of the vreg that we're moving.
337 -> Loc -- ^ source location.
338 -> Loc -- ^ destination location.
339 -> RegM freeRegs instr -- ^ move instruction.
341 makeMove _ vreg (InReg src) (InReg dst)
342 = do recordSpill (SpillJoinRR vreg)
343 return $ mkRegRegMoveInstr (RegReal src) (RegReal dst)
345 makeMove delta vreg (InMem src) (InReg dst)
346 = do recordSpill (SpillJoinRM vreg)
347 return $ mkLoadInstr (RegReal dst) delta src
349 makeMove delta vreg (InReg src) (InMem dst)
350 = do recordSpill (SpillJoinRM vreg)
351 return $ mkSpillInstr (RegReal src) delta dst
353 -- we don't handle memory to memory moves.
354 -- they shouldn't happen because we don't share stack slots between vregs.
355 makeMove _ vreg src dst
356 = panic $ "makeMove " ++ show vreg ++ " (" ++ show src ++ ") ("
358 ++ " we don't handle mem->mem moves."