186ff3f622cae9532eed943387bc11e52aae3cd1
[ghc.git] / compiler / nativeGen / RegAlloc / Linear / JoinToTargets.hs
1
2 -- | Handles joining of a jump instruction to its targets.
3
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 occurred in one
8 -- branch; so some fixup code will be required to match up the assignments.
9 --
10 module RegAlloc.Linear.JoinToTargets (joinToTargets) where
11
12 import RegAlloc.Linear.State
13 import RegAlloc.Linear.Base
14 import RegAlloc.Linear.FreeRegs
15 import RegAlloc.Liveness
16 import Instruction
17 import Reg
18
19 import BlockId
20 import Hoopl
21 import Digraph
22 import DynFlags
23 import Outputable
24 import Unique
25 import UniqFM
26 import UniqSet
27
28 import Data.Foldable (foldl')
29
30 -- | For a jump instruction at the end of a block, generate fixup code so its
31 -- vregs are in the correct regs for its destination.
32 --
33 joinToTargets
34 :: (FR freeRegs, Instruction instr)
35 => BlockMap RegSet -- ^ maps the unique of the blockid to the set of vregs
36 -- that are known to be live on the entry to each block.
37
38 -> BlockId -- ^ id of the current block
39 -> instr -- ^ branch instr on the end of the source block.
40
41 -> RegM freeRegs ([NatBasicBlock instr] -- fresh blocks of fixup code.
42 , instr) -- the original branch
43 -- instruction, but maybe
44 -- patched to jump
45 -- to a fixup block first.
46
47 joinToTargets block_live id instr
48
49 -- we only need to worry about jump instructions.
50 | not $ isJumpishInstr instr
51 = return ([], instr)
52
53 | otherwise
54 = joinToTargets' block_live [] id instr (jumpDestsOfInstr instr)
55
56 -----
57 joinToTargets'
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.
61
62 -> [NatBasicBlock instr] -- ^ acc blocks of fixup code.
63
64 -> BlockId -- ^ id of the current block
65 -> instr -- ^ branch instr on the end of the source block.
66
67 -> [BlockId] -- ^ branch destinations still to consider.
68
69 -> RegM freeRegs ([NatBasicBlock instr], instr)
70
71 -- no more targets to consider. all done.
72 joinToTargets' _ new_blocks _ instr []
73 = return (new_blocks, instr)
74
75 -- handle a branch target.
76 joinToTargets' block_live new_blocks block_id instr (dest:dests)
77 = do
78 -- get the map of where the vregs are stored on entry to each basic block.
79 block_assig <- getBlockAssigR
80
81 -- get the assignment on entry to the branch instruction.
82 assig <- getAssigR
83
84 -- adjust the current assignment to remove any vregs that are not live
85 -- on entry to the destination block.
86 let Just live_set = mapLookup dest block_live
87 let still_live uniq _ = uniq `elemUniqSet_Directly` live_set
88 let adjusted_assig = filterUFM_Directly still_live assig
89
90 -- and free up those registers which are now free.
91 let to_free =
92 [ r | (reg, loc) <- nonDetUFMToList assig
93 -- This is non-deterministic but we do not
94 -- currently support deterministic code-generation.
95 -- See Note [Unique Determinism and code generation]
96 , not (elemUniqSet_Directly reg live_set)
97 , r <- regsOfLoc loc ]
98
99 case mapLookup dest block_assig of
100 Nothing
101 -> joinToTargets_first
102 block_live new_blocks block_id instr dest dests
103 block_assig adjusted_assig to_free
104
105 Just (_, dest_assig)
106 -> joinToTargets_again
107 block_live new_blocks block_id instr dest dests
108 adjusted_assig dest_assig
109
110
111 -- this is the first time we jumped to this block.
112 joinToTargets_first :: (FR freeRegs, Instruction instr)
113 => BlockMap RegSet
114 -> [NatBasicBlock instr]
115 -> BlockId
116 -> instr
117 -> BlockId
118 -> [BlockId]
119 -> BlockAssignment freeRegs
120 -> RegMap Loc
121 -> [RealReg]
122 -> RegM freeRegs ([NatBasicBlock instr], instr)
123 joinToTargets_first block_live new_blocks block_id instr dest dests
124 block_assig src_assig
125 to_free
126
127 = do dflags <- getDynFlags
128 let platform = targetPlatform dflags
129
130 -- free up the regs that are not live on entry to this block.
131 freeregs <- getFreeRegsR
132 let freeregs' = foldl' (flip $ frReleaseReg platform) freeregs to_free
133
134 -- remember the current assignment on entry to this block.
135 setBlockAssigR (mapInsert dest (freeregs', src_assig) block_assig)
136
137 joinToTargets' block_live new_blocks block_id instr dests
138
139
140 -- we've jumped to this block before
141 joinToTargets_again :: (Instruction instr, FR freeRegs)
142 => BlockMap RegSet
143 -> [NatBasicBlock instr]
144 -> BlockId
145 -> instr
146 -> BlockId
147 -> [BlockId]
148 -> UniqFM Loc
149 -> UniqFM Loc
150 -> RegM freeRegs ([NatBasicBlock instr], instr)
151 joinToTargets_again
152 block_live new_blocks block_id instr dest dests
153 src_assig dest_assig
154
155 -- the assignments already match, no problem.
156 | nonDetUFMToList dest_assig == nonDetUFMToList src_assig
157 -- This is non-deterministic but we do not
158 -- currently support deterministic code-generation.
159 -- See Note [Unique Determinism and code generation]
160 = joinToTargets' block_live new_blocks block_id instr dests
161
162 -- assignments don't match, need fixup code
163 | otherwise
164 = do
165
166 -- make a graph of what things need to be moved where.
167 let graph = makeRegMovementGraph src_assig dest_assig
168
169 -- look for cycles in the graph. This can happen if regs need to be swapped.
170 -- Note that we depend on the fact that this function does a
171 -- bottom up traversal of the tree-like portions of the graph.
172 --
173 -- eg, if we have
174 -- R1 -> R2 -> R3
175 --
176 -- ie move value in R1 to R2 and value in R2 to R3.
177 --
178 -- We need to do the R2 -> R3 move before R1 -> R2.
179 --
180 let sccs = stronglyConnCompFromEdgedVerticesOrdR graph
181
182 {- -- debugging
183 pprTrace
184 ("joinToTargets: making fixup code")
185 (vcat [ text " in block: " <> ppr block_id
186 , text " jmp instruction: " <> ppr instr
187 , text " src assignment: " <> ppr src_assig
188 , text " dest assignment: " <> ppr dest_assig
189 , text " movement graph: " <> ppr graph
190 , text " sccs of graph: " <> ppr sccs
191 , text ""])
192 (return ())
193 -}
194 delta <- getDeltaR
195 fixUpInstrs_ <- mapM (handleComponent delta instr) sccs
196 let fixUpInstrs = concat fixUpInstrs_
197
198 -- make a new basic block containing the fixup code.
199 -- A the end of the current block we will jump to the fixup one,
200 -- then that will jump to our original destination.
201 fixup_block_id <- getUniqueR
202 let block = BasicBlock (mkBlockId fixup_block_id)
203 $ fixUpInstrs ++ mkJumpInstr dest
204
205 {- pprTrace
206 ("joinToTargets: fixup code is:")
207 (vcat [ ppr block
208 , text ""])
209 (return ())
210 -}
211 -- if we didn't need any fixups, then don't include the block
212 case fixUpInstrs of
213 [] -> joinToTargets' block_live new_blocks block_id instr dests
214
215 -- patch the original branch instruction so it goes to our
216 -- fixup block instead.
217 _ -> let instr' = patchJumpInstr instr
218 (\bid -> if bid == dest
219 then mkBlockId fixup_block_id
220 else bid) -- no change!
221
222 in joinToTargets' block_live (block : new_blocks) block_id instr' dests
223
224
225 -- | Construct a graph of register\/spill movements.
226 --
227 -- Cyclic components seem to occur only very rarely.
228 --
229 -- We cut some corners by not handling memory-to-memory moves.
230 -- This shouldn't happen because every temporary gets its own stack slot.
231 --
232 makeRegMovementGraph :: RegMap Loc -> RegMap Loc -> [(Unique, Loc, [Loc])]
233 makeRegMovementGraph adjusted_assig dest_assig
234 = [ node | (vreg, src) <- nonDetUFMToList adjusted_assig
235 -- This is non-deterministic but we do not
236 -- currently support deterministic code-generation.
237 -- See Note [Unique Determinism and code generation]
238 -- source reg might not be needed at the dest:
239 , Just loc <- [lookupUFM_Directly dest_assig vreg]
240 , node <- expandNode vreg src loc ]
241
242
243 -- | Expand out the destination, so InBoth destinations turn into
244 -- a combination of InReg and InMem.
245
246 -- The InBoth handling is a little tricky here. If the destination is
247 -- InBoth, then we must ensure that the value ends up in both locations.
248 -- An InBoth destination must conflict with an InReg or InMem source, so
249 -- we expand an InBoth destination as necessary.
250 --
251 -- An InBoth source is slightly different: we only care about the register
252 -- that the source value is in, so that we can move it to the destinations.
253 --
254 expandNode
255 :: a
256 -> Loc -- ^ source of move
257 -> Loc -- ^ destination of move
258 -> [(a, Loc, [Loc])]
259
260 expandNode vreg loc@(InReg src) (InBoth dst mem)
261 | src == dst = [(vreg, loc, [InMem mem])]
262 | otherwise = [(vreg, loc, [InReg dst, InMem mem])]
263
264 expandNode vreg loc@(InMem src) (InBoth dst mem)
265 | src == mem = [(vreg, loc, [InReg dst])]
266 | otherwise = [(vreg, loc, [InReg dst, InMem mem])]
267
268 expandNode _ (InBoth _ src) (InMem dst)
269 | src == dst = [] -- guaranteed to be true
270
271 expandNode _ (InBoth src _) (InReg dst)
272 | src == dst = []
273
274 expandNode vreg (InBoth src _) dst
275 = expandNode vreg (InReg src) dst
276
277 expandNode vreg src dst
278 | src == dst = []
279 | otherwise = [(vreg, src, [dst])]
280
281
282 -- | Generate fixup code for a particular component in the move graph
283 -- This component tells us what values need to be moved to what
284 -- destinations. We have eliminated any possibility of single-node
285 -- cycles in expandNode above.
286 --
287 handleComponent
288 :: Instruction instr
289 => Int -> instr -> SCC (Unique, Loc, [Loc])
290 -> RegM freeRegs [instr]
291
292 -- If the graph is acyclic then we won't get the swapping problem below.
293 -- In this case we can just do the moves directly, and avoid having to
294 -- go via a spill slot.
295 --
296 handleComponent delta _ (AcyclicSCC (vreg, src, dsts))
297 = mapM (makeMove delta vreg src) dsts
298
299
300 -- Handle some cyclic moves.
301 -- This can happen if we have two regs that need to be swapped.
302 -- eg:
303 -- vreg source loc dest loc
304 -- (vreg1, InReg r1, [InReg r2])
305 -- (vreg2, InReg r2, [InReg r1])
306 --
307 -- To avoid needing temp register, we just spill all the source regs, then
308 -- reaload them into their destination regs.
309 --
310 -- Note that we can not have cycles that involve memory locations as
311 -- sources as single destination because memory locations (stack slots)
312 -- are allocated exclusively for a virtual register and therefore can not
313 -- require a fixup.
314 --
315 handleComponent delta instr
316 (CyclicSCC ((vreg, InReg sreg, (InReg dreg: _)) : rest))
317 -- dest list may have more than one element, if the reg is also InMem.
318 = do
319 -- spill the source into its slot
320 (instrSpill, slot)
321 <- spillR (RegReal sreg) vreg
322
323 -- reload into destination reg
324 instrLoad <- loadR (RegReal dreg) slot
325
326 remainingFixUps <- mapM (handleComponent delta instr)
327 (stronglyConnCompFromEdgedVerticesOrdR rest)
328
329 -- make sure to do all the reloads after all the spills,
330 -- so we don't end up clobbering the source values.
331 return ([instrSpill] ++ concat remainingFixUps ++ [instrLoad])
332
333 handleComponent _ _ (CyclicSCC _)
334 = panic "Register Allocator: handleComponent cyclic"
335
336
337 -- | Move a vreg between these two locations.
338 --
339 makeMove
340 :: Instruction instr
341 => Int -- ^ current C stack delta.
342 -> Unique -- ^ unique of the vreg that we're moving.
343 -> Loc -- ^ source location.
344 -> Loc -- ^ destination location.
345 -> RegM freeRegs instr -- ^ move instruction.
346
347 makeMove delta vreg src dst
348 = do dflags <- getDynFlags
349 let platform = targetPlatform dflags
350
351 case (src, dst) of
352 (InReg s, InReg d) ->
353 do recordSpill (SpillJoinRR vreg)
354 return $ mkRegRegMoveInstr platform (RegReal s) (RegReal d)
355 (InMem s, InReg d) ->
356 do recordSpill (SpillJoinRM vreg)
357 return $ mkLoadInstr dflags (RegReal d) delta s
358 (InReg s, InMem d) ->
359 do recordSpill (SpillJoinRM vreg)
360 return $ mkSpillInstr dflags (RegReal s) delta d
361 _ ->
362 -- we don't handle memory to memory moves.
363 -- they shouldn't happen because we don't share
364 -- stack slots between vregs.
365 panic ("makeMove " ++ show vreg ++ " (" ++ show src ++ ") ("
366 ++ show dst ++ ")"
367 ++ " we don't handle mem->mem moves.")
368