compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs

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