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 Cmm      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 ([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 ( [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       = lookupBlockEnv block_live dest
  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 lookupBlockEnv block_assig dest 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 (extendBlockEnv block_assig dest
 122                                 (freeregs', src_assig))
 123
 124         joinToTargets' block_live new_blocks block_id instr dests
 125
 126
 127 -- we've jumped to this block before
 128 joinToTargets_again
 129         block_live new_blocks block_id instr dest dests
 130         src_assig dest_assig
 131
 132         -- the assignments already match, no problem.
 133         | ufmToList dest_assig == ufmToList src_assig
 134         = joinToTargets' block_live new_blocks block_id instr dests
 135
 136         -- assignments don't match, need fixup code
 137         | otherwise
 138         = do
 139
 140                 -- make a graph of what things need to be moved where.
 141                 let graph = makeRegMovementGraph src_assig dest_assig
 142
 143                 -- look for cycles in the graph. This can happen if regs need to be swapped.
 144                 -- Note that we depend on the fact that this function does a
 145                 --      bottom up traversal of the tree-like portions of the graph.
 146                 --
 147                 --  eg, if we have
 148                 --      R1 -> R2 -> R3
 149                 --
 150                 --  ie move value in R1 to R2 and value in R2 to R3.
 151                 --
 152                 -- We need to do the R2 -> R3 move before R1 -> R2.
 153                 --
 154                 let sccs  = stronglyConnCompFromEdgedVerticesR graph
 155
 156 {-              -- debugging
 157                 pprTrace
 158                         ("joinToTargets: making fixup code")
 159                         (vcat   [ text "        in block: "     <> ppr block_id
 160                                 , text " jmp instruction: "     <> ppr instr
 161                                 , text "  src assignment: "     <> ppr src_assig
 162                                 , text " dest assignment: "     <> ppr dest_assig
 163                                 , text "  movement graph: "     <> ppr graph
 164                                 , text "   sccs of graph: "     <> ppr sccs
 165                                 , text ""])
 166                         (return ())
 167 -}
 168                 delta           <- getDeltaR
 169                 fixUpInstrs_    <- mapM (handleComponent delta instr) sccs
 170                 let fixUpInstrs = concat fixUpInstrs_
 171
 172                 -- make a new basic block containing the fixup code.
 173                 --      A the end of the current block we will jump to the fixup one,
 174                 --      then that will jump to our original destination.
 175                 fixup_block_id <- getUniqueR
 176                 let block = BasicBlock (BlockId fixup_block_id)
 177                                 $ fixUpInstrs ++ mkJumpInstr dest
 178
 179 {-              pprTrace
 180                         ("joinToTargets: fixup code is:")
 181                         (vcat   [ ppr block
 182                                 , text ""])
 183                         (return ())
 184 -}
 185                 -- if we didn't need any fixups, then don't include the block
 186                 case fixUpInstrs of
 187                  []     -> joinToTargets' block_live new_blocks block_id instr dests
 188
 189                  -- patch the original branch instruction so it goes to our
 190                  --     fixup block instead.
 191                  _      -> let  instr'  =  patchJumpInstr instr
 192                                                 (\bid -> if bid == dest
 193                                                                 then BlockId fixup_block_id
 194                                                                 else dest)
 195
 196                            in   joinToTargets' block_live (block : new_blocks) block_id instr' dests
 197
 198
 199 -- | Construct a graph of register\/spill movements.
 200 --
 201 --      Cyclic components seem to occur only very rarely.
 202 --
 203 --      We cut some corners by not handling memory-to-memory moves.
 204 --      This shouldn't happen because every temporary gets its own stack slot.
 205 --
 206 makeRegMovementGraph :: RegMap Loc -> RegMap Loc -> [(Unique, Loc, [Loc])]
 207 makeRegMovementGraph adjusted_assig dest_assig
 208  = let
 209         mkNodes src vreg
 210          = expandNode vreg src
 211          $ lookupWithDefaultUFM_Directly
 212                 dest_assig
 213                 (panic "RegAllocLinear.makeRegMovementGraph")
 214                 vreg
 215
 216    in   [ node  | (vreg, src) <- ufmToList adjusted_assig
 217                 , node <- mkNodes src vreg ]
 218
 219
 220 -- | Expand out the destination, so InBoth destinations turn into
 221 --      a combination of InReg and InMem.
 222
 223 --      The InBoth handling is a little tricky here.  If the destination is
 224 --      InBoth, then we must ensure that the value ends up in both locations.
 225 --      An InBoth  destination must conflict with an InReg or InMem source, so
 226 --      we expand an InBoth destination as necessary.
 227 --
 228 --      An InBoth source is slightly different: we only care about the register
 229 --      that the source value is in, so that we can move it to the destinations.
 230 --
 231 expandNode
 232         :: a
 233         -> Loc                  -- ^ source of move
 234         -> Loc                  -- ^ destination of move
 235         -> [(a, Loc, [Loc])]
 236
 237 expandNode vreg loc@(InReg src) (InBoth dst mem)
 238         | src == dst = [(vreg, loc, [InMem mem])]
 239         | otherwise  = [(vreg, loc, [InReg dst, InMem mem])]
 240
 241 expandNode vreg loc@(InMem src) (InBoth dst mem)
 242         | src == mem = [(vreg, loc, [InReg dst])]
 243         | otherwise  = [(vreg, loc, [InReg dst, InMem mem])]
 244
 245 expandNode _        (InBoth _ src) (InMem dst)
 246         | src == dst = [] -- guaranteed to be true
 247
 248 expandNode _        (InBoth src _) (InReg dst)
 249         | src == dst = []
 250
 251 expandNode vreg     (InBoth src _) dst
 252         = expandNode vreg (InReg src) dst
 253
 254 expandNode vreg src dst
 255         | src == dst = []
 256         | otherwise  = [(vreg, src, [dst])]
 257
 258
 259 -- | Generate fixup code for a particular component in the move graph
 260 --      This component tells us what values need to be moved to what
 261 --      destinations. We have eliminated any possibility of single-node
 262 --      cycles in expandNode above.
 263 --
 264 handleComponent
 265         :: Instruction instr
 266         => Int -> instr -> SCC (Unique, Loc, [Loc]) -> RegM [instr]
 267
 268 -- If the graph is acyclic then we won't get the swapping problem below.
 269 --      In this case we can just do the moves directly, and avoid having to
 270 --      go via a spill slot.
 271 --
 272 handleComponent delta _  (AcyclicSCC (vreg, src, dsts))
 273          = mapM (makeMove delta vreg src) dsts
 274
 275
 276 -- Handle some cyclic moves.
 277 --      This can happen if we have two regs that need to be swapped.
 278 --      eg:
 279 --           vreg   source loc   dest loc
 280 --          (vreg1, InReg r1,    [InReg r2])
 281 --          (vreg2, InReg r2,    [InReg r1])
 282 --
 283 --      To avoid needing temp register, we just spill all the source regs, then
 284 --      reaload them into their destination regs.
 285 --
 286 --      Note that we can not have cycles that involve memory locations as
 287 --      sources as single destination because memory locations (stack slots)
 288 --      are allocated exclusively for a virtual register and therefore can not
 289 --      require a fixup.
 290 --
 291 handleComponent delta instr
 292         (CyclicSCC      ( (vreg, InReg sreg, [InReg dreg]) : rest))
 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 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