PageRenderTime 20ms CodeModel.GetById 9ms app.highlight 7ms RepoModel.GetById 1ms app.codeStats 1ms

/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs

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