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