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
  22 import BlockId
  23 import MachInstrs
  24 import MachRegs
  25 import RegAllocInfo
  26 import RegLiveness
  27 import Cmm      hiding (RegSet)
  28
  29 import Digraph
  30 import Outputable
  31 import Unique
  32 import UniqFM
  33 import UniqSet
  34
  35
  36 -- | For a jump instruction at the end of a block, generate fixup code so its
  37 --      vregs are in the correct regs for its destination.
  38 --
  39 joinToTargets
  40         :: BlockMap RegSet              -- ^ maps the unique of the blockid to the set of vregs
  41                                         --      that are known to be live on the entry to each block.
  42
  43         -> BlockId                      -- ^ id of the current block
  44         -> Instr                        -- ^ branch instr on the end of the source block.
  45
  46         -> RegM ([NatBasicBlock]        --   fresh blocks of fixup code.
  47                 , Instr)                --   the original branch instruction, but maybe patched to jump
  48                                         --      to a fixup block first.
  49
  50 joinToTargets block_live id instr
  51
  52         -- we only need to worry about jump instructions.
  53         | not $ isJumpish instr
  54         = return ([], instr)
  55
  56         | otherwise
  57         = joinToTargets' block_live [] id instr (jumpDests instr [])
  58
  59 -----
  60 joinToTargets'
  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]              -- ^ 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]
  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 to_free
 114
 115  = do   -- free up the regs that are not live on entry to this block.
 116         freeregs        <- getFreeRegsR
 117         let freeregs'   = foldr releaseReg freeregs to_free
 118
 119         -- remember the current assignment on entry to this block.
 120         setBlockAssigR (extendBlockEnv block_assig dest
 121                                 (freeregs', src_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 (BlockId fixup_block_id)
 176                                 $ fixUpInstrs ++ mkBranchInstr 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'  =  patchJump instr dest (BlockId fixup_block_id)
 191                            in   joinToTargets' block_live (block : new_blocks) block_id instr' dests
 192
 193
 194 -- | Construct a graph of register\/spill movements.
 195 --
 196 --      Cyclic components seem to occur only very rarely.
 197 --
 198 --      We cut some corners by not handling memory-to-memory moves.
 199 --      This shouldn't happen because every temporary gets its own stack slot.
 200 --
 201 makeRegMovementGraph :: RegMap Loc -> RegMap Loc -> [(Unique, Loc, [Loc])]
 202 makeRegMovementGraph adjusted_assig dest_assig
 203  = let
 204         mkNodes src vreg
 205          = expandNode vreg src
 206          $ lookupWithDefaultUFM_Directly
 207                 dest_assig
 208                 (panic "RegAllocLinear.makeRegMovementGraph")
 209                 vreg
 210
 211    in   [ node  | (vreg, src) <- ufmToList adjusted_assig
 212                 , node <- mkNodes src vreg ]
 213
 214
 215 -- | Expand out the destination, so InBoth destinations turn into
 216 --      a combination of InReg and InMem.
 217
 218 --      The InBoth handling is a little tricky here.  If the destination is
 219 --      InBoth, then we must ensure that the value ends up in both locations.
 220 --      An InBoth  destination must conflict with an InReg or InMem source, so
 221 --      we expand an InBoth destination as necessary.
 222 --
 223 --      An InBoth source is slightly different: we only care about the register
 224 --      that the source value is in, so that we can move it to the destinations.
 225 --
 226 expandNode
 227         :: a
 228         -> Loc                  -- ^ source of move
 229         -> Loc                  -- ^ destination of move
 230         -> [(a, Loc, [Loc])]
 231
 232 expandNode vreg loc@(InReg src) (InBoth dst mem)
 233         | src == dst = [(vreg, loc, [InMem mem])]
 234         | otherwise  = [(vreg, loc, [InReg dst, InMem mem])]
 235
 236 expandNode vreg loc@(InMem src) (InBoth dst mem)
 237         | src == mem = [(vreg, loc, [InReg dst])]
 238         | otherwise  = [(vreg, loc, [InReg dst, InMem mem])]
 239
 240 expandNode _        (InBoth _ src) (InMem dst)
 241         | src == dst = [] -- guaranteed to be true
 242
 243 expandNode _        (InBoth src _) (InReg dst)
 244         | src == dst = []
 245
 246 expandNode vreg     (InBoth src _) dst
 247         = expandNode vreg (InReg src) dst
 248
 249 expandNode vreg src dst
 250         | src == dst = []
 251         | otherwise  = [(vreg, src, [dst])]
 252
 253
 254 -- | Generate fixup code for a particular component in the move graph
 255 --      This component tells us what values need to be moved to what
 256 --      destinations. We have eliminated any possibility of single-node
 257 --      cycles in expandNode above.
 258 --
 259 handleComponent :: Int -> Instr -> SCC (Unique, Loc, [Loc]) -> RegM [Instr]
 260
 261 -- If the graph is acyclic then we won't get the swapping problem below.
 262 --      In this case we can just do the moves directly, and avoid having to
 263 --      go via a spill slot.
 264 --
 265 handleComponent delta _  (AcyclicSCC (vreg, src, dsts))
 266          = mapM (makeMove delta vreg src) dsts
 267
 268
 269 -- Handle some cyclic moves.
 270 --      This can happen if we have two regs that need to be swapped.
 271 --      eg:
 272 --           vreg   source loc   dest loc
 273 --          (vreg1, InReg r1,    [InReg r2])
 274 --          (vreg2, InReg r2,    [InReg r1])
 275 --
 276 --      To avoid needing temp register, we just spill all the source regs, then
 277 --      reaload them into their destination regs.
 278 --
 279 --      Note that we can not have cycles that involve memory locations as
 280 --      sources as single destination because memory locations (stack slots)
 281 --      are allocated exclusively for a virtual register and therefore can not
 282 --      require a fixup.
 283 --
 284 handleComponent delta instr
 285         (CyclicSCC      ( (vreg, InReg sreg, [InReg dreg]) : rest))
 286  = do
 287         -- spill the source into its slot
 288         (instrSpill, slot)
 289                         <- spillR (RealReg sreg) vreg
 290
 291         -- reload into destination reg
 292         instrLoad       <- loadR (RealReg dreg) slot
 293
 294         remainingFixUps <- mapM (handleComponent delta instr)
 295                                 (stronglyConnCompFromEdgedVerticesR rest)
 296
 297         -- make sure to do all the reloads after all the spills,
 298         --      so we don't end up clobbering the source values.
 299         return ([instrSpill] ++ concat remainingFixUps ++ [instrLoad])
 300
 301 handleComponent _ _ (CyclicSCC _)
 302  = panic "Register Allocator: handleComponent cyclic"
 303
 304
 305 -- | Move a vreg between these two locations.
 306 --
 307 makeMove
 308         :: Int          -- ^ current C stack delta.
 309         -> Unique       -- ^ unique of the vreg that we're moving.
 310         -> Loc          -- ^ source location.
 311         -> Loc          -- ^ destination location.
 312         -> RegM Instr   -- ^ move instruction.
 313
 314 makeMove _     vreg (InReg src) (InReg dst)
 315  = do   recordSpill (SpillJoinRR vreg)
 316         return  $ mkRegRegMoveInstr (RealReg src) (RealReg dst)
 317
 318 makeMove delta vreg (InMem src) (InReg dst)
 319  = do   recordSpill (SpillJoinRM vreg)
 320         return  $ mkLoadInstr (RealReg dst) delta src
 321
 322 makeMove delta vreg (InReg src) (InMem dst)
 323  = do   recordSpill (SpillJoinRM vreg)
 324         return  $ mkSpillInstr (RealReg src) delta dst
 325
 326 -- we don't handle memory to memory moves.
 327 --      they shouldn't happen because we don't share stack slots between vregs.
 328 makeMove _     vreg src dst
 329         = panic $ "makeMove " ++ show vreg ++ " (" ++ show src ++ ") ("
 330                 ++ show dst ++ ")"
 331                 ++ " we don't handle mem->mem moves."
 332