never executed always true always false
    1 {-# LANGUAGE BangPatterns, DeriveFunctor #-}
    2 {-# LANGUAGE MultiParamTypeClasses #-}
    3 {-# LANGUAGE FlexibleInstances #-}
    4 {-# LANGUAGE FlexibleContexts #-}
    5 
    6 
    7 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
    8 
    9 -- | Carries interesting info for debugging / profiling of the
   10 --   graph coloring register allocator.
   11 module GHC.CmmToAsm.Reg.Graph.Stats (
   12         RegAllocStats (..),
   13 
   14         pprStats,
   15         pprStatsSpills,
   16         pprStatsLifetimes,
   17         pprStatsConflict,
   18         pprStatsLifeConflict,
   19 
   20         countSRMs, addSRM
   21 ) where
   22 
   23 import GHC.Prelude
   24 
   25 import qualified GHC.Data.Graph.Color as Color
   26 import GHC.CmmToAsm.Reg.Liveness
   27 import GHC.CmmToAsm.Reg.Graph.Spill
   28 import GHC.CmmToAsm.Reg.Graph.SpillCost
   29 import GHC.CmmToAsm.Reg.Graph.TrivColorable
   30 import GHC.CmmToAsm.Reg.Target
   31 import GHC.CmmToAsm.Instr
   32 import GHC.CmmToAsm.Types
   33 
   34 import GHC.Platform
   35 import GHC.Platform.Reg
   36 import GHC.Platform.Reg.Class
   37 
   38 import GHC.Types.Unique.FM
   39 import GHC.Types.Unique.Set
   40 import GHC.Utils.Outputable
   41 import GHC.Utils.Monad.State.Strict
   42 
   43 -- | Holds interesting statistics from the register allocator.
   44 data RegAllocStats statics instr
   45 
   46         -- Information about the initial conflict graph.
   47         = RegAllocStatsStart
   48         { -- | Initial code, with liveness.
   49           raLiveCmm     :: [LiveCmmDecl statics instr]
   50 
   51           -- | The initial, uncolored graph.
   52         , raGraph       :: Color.Graph VirtualReg RegClass RealReg
   53 
   54           -- | Information to help choose which regs to spill.
   55         , raSpillCosts  :: SpillCostInfo
   56 
   57           -- | Target platform
   58         , raPlatform    :: !Platform
   59         }
   60 
   61 
   62         -- Information about an intermediate graph.
   63         -- This is one that we couldn't color, so had to insert spill code
   64         -- instruction stream.
   65         | RegAllocStatsSpill
   66         { -- | Code we tried to allocate registers for.
   67           raCode        :: [LiveCmmDecl statics instr]
   68 
   69           -- | Partially colored graph.
   70         , raGraph       :: Color.Graph VirtualReg RegClass RealReg
   71 
   72           -- | The regs that were coalesced.
   73         , raCoalesced   :: UniqFM VirtualReg VirtualReg
   74 
   75           -- | Spiller stats.
   76         , raSpillStats  :: SpillStats
   77 
   78           -- | Number of instructions each reg lives for.
   79         , raSpillCosts  :: SpillCostInfo
   80 
   81           -- | Code with spill instructions added.
   82         , raSpilled     :: [LiveCmmDecl statics instr]
   83 
   84           -- | Target platform
   85         , raPlatform    :: !Platform
   86         }
   87 
   88 
   89         -- a successful coloring
   90         | RegAllocStatsColored
   91         { -- | Code we tried to allocate registers for.
   92           raCode          :: [LiveCmmDecl statics instr]
   93 
   94           -- | Uncolored graph.
   95         , raGraph         :: Color.Graph VirtualReg RegClass RealReg
   96 
   97           -- | Coalesced and colored graph.
   98         , raGraphColored  :: Color.Graph VirtualReg RegClass RealReg
   99 
  100           -- | Regs that were coalesced.
  101         , raCoalesced     :: UniqFM VirtualReg VirtualReg
  102 
  103           -- | Code with coalescings applied.
  104         , raCodeCoalesced :: [LiveCmmDecl statics instr]
  105 
  106           -- | Code with vregs replaced by hregs.
  107         , raPatched       :: [LiveCmmDecl statics instr]
  108 
  109           -- | Code with unneeded spill\/reloads cleaned out.
  110         , raSpillClean    :: [LiveCmmDecl statics instr]
  111 
  112           -- | Final code.
  113         , raFinal         :: [NatCmmDecl statics instr]
  114 
  115           -- | Spill\/reload\/reg-reg moves present in this code.
  116         , raSRMs          :: (Int, Int, Int)
  117 
  118           -- | Target platform
  119         , raPlatform    :: !Platform
  120         }
  121         deriving (Functor)
  122 
  123 
  124 instance (OutputableP Platform statics, OutputableP Platform instr)
  125        => Outputable (RegAllocStats statics instr) where
  126 
  127  ppr (s@RegAllocStatsStart{})
  128     =      text "#  Start"
  129         $$ text "#  Native code with liveness information."
  130         $$ pdoc (raPlatform s) (raLiveCmm s)
  131         $$ text ""
  132         $$ text "#  Initial register conflict graph."
  133         $$ Color.dotGraph
  134                 (targetRegDotColor (raPlatform s))
  135                 (trivColorable (raPlatform s)
  136                         (targetVirtualRegSqueeze (raPlatform s))
  137                         (targetRealRegSqueeze (raPlatform s)))
  138                 (raGraph s)
  139 
  140 
  141  ppr (s@RegAllocStatsSpill{}) =
  142            text "#  Spill"
  143 
  144         $$ text "#  Code with liveness information."
  145         $$ pdoc (raPlatform s) (raCode s)
  146         $$ text ""
  147 
  148         $$ (if (not $ isNullUFM $ raCoalesced s)
  149                 then    text "#  Registers coalesced."
  150                         $$ pprUFMWithKeys (raCoalesced s) (vcat . map ppr)
  151                         $$ text ""
  152                 else empty)
  153 
  154         $$ text "#  Spills inserted."
  155         $$ ppr (raSpillStats s)
  156         $$ text ""
  157 
  158         $$ text "#  Code with spills inserted."
  159         $$ pdoc (raPlatform s) (raSpilled s)
  160 
  161 
  162  ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
  163     =      text "#  Colored"
  164 
  165         $$ text "#  Code with liveness information."
  166         $$ pdoc (raPlatform s) (raCode s)
  167         $$ text ""
  168 
  169         $$ text "#  Register conflict graph (colored)."
  170         $$ Color.dotGraph
  171                 (targetRegDotColor (raPlatform s))
  172                 (trivColorable (raPlatform s)
  173                         (targetVirtualRegSqueeze (raPlatform s))
  174                         (targetRealRegSqueeze (raPlatform s)))
  175                 (raGraphColored s)
  176         $$ text ""
  177 
  178         $$ (if (not $ isNullUFM $ raCoalesced s)
  179                 then    text "#  Registers coalesced."
  180                         $$ pprUFMWithKeys (raCoalesced s) (vcat . map ppr)
  181                         $$ text ""
  182                 else empty)
  183 
  184         $$ text "#  Native code after coalescings applied."
  185         $$ pdoc (raPlatform s) (raCodeCoalesced s)
  186         $$ text ""
  187 
  188         $$ text "#  Native code after register allocation."
  189         $$ pdoc (raPlatform s) (raPatched s)
  190         $$ text ""
  191 
  192         $$ text "#  Clean out unneeded spill/reloads."
  193         $$ pdoc (raPlatform s) (raSpillClean s)
  194         $$ text ""
  195 
  196         $$ text "#  Final code, after rewriting spill/rewrite pseudo instrs."
  197         $$ pdoc (raPlatform s) (raFinal s)
  198         $$ text ""
  199         $$  text "#  Score:"
  200         $$ (text "#          spills  inserted: " <> int spills)
  201         $$ (text "#          reloads inserted: " <> int reloads)
  202         $$ (text "#   reg-reg moves remaining: " <> int moves)
  203         $$ text ""
  204 
  205 
  206 -- | Do all the different analysis on this list of RegAllocStats
  207 pprStats
  208         :: [RegAllocStats statics instr]
  209         -> Color.Graph VirtualReg RegClass RealReg
  210         -> SDoc
  211 
  212 pprStats stats graph
  213  = let  outSpills       = pprStatsSpills    stats
  214         outLife         = pprStatsLifetimes stats
  215         outConflict     = pprStatsConflict  stats
  216         outScatter      = pprStatsLifeConflict stats graph
  217 
  218   in    vcat [outSpills, outLife, outConflict, outScatter]
  219 
  220 
  221 -- | Dump a table of how many spill loads \/ stores were inserted for each vreg.
  222 pprStatsSpills
  223         :: [RegAllocStats statics instr] -> SDoc
  224 
  225 pprStatsSpills stats
  226  = let
  227         finals  = [ s   | s@RegAllocStatsColored{} <- stats]
  228 
  229         -- sum up how many stores\/loads\/reg-reg-moves were left in the code
  230         total   = foldl' addSRM (0, 0, 0)
  231                 $ map raSRMs finals
  232 
  233     in  (  text "-- spills-added-total"
  234         $$ text "--    (stores, loads, reg_reg_moves_remaining)"
  235         $$ ppr total
  236         $$ text "")
  237 
  238 
  239 -- | Dump a table of how long vregs tend to live for in the initial code.
  240 pprStatsLifetimes
  241         :: [RegAllocStats statics instr] -> SDoc
  242 
  243 pprStatsLifetimes stats
  244  = let  info            = foldl' plusSpillCostInfo zeroSpillCostInfo
  245                                 [ raSpillCosts s
  246                                         | s@RegAllocStatsStart{} <- stats ]
  247 
  248         lifeBins        = binLifetimeCount $ lifeMapFromSpillCostInfo info
  249 
  250    in   (  text "-- vreg-population-lifetimes"
  251         $$ text "--   (instruction_count, number_of_vregs_that_lived_that_long)"
  252         $$ pprUFM lifeBins (vcat . map ppr)
  253         $$ text "\n")
  254 
  255 
  256 binLifetimeCount :: UniqFM VirtualReg (VirtualReg, Int) -> UniqFM Int (Int, Int)
  257 binLifetimeCount fm
  258  = let  lifes   = map (\l -> (l, (l, 1)))
  259                 $ map snd
  260                 $ nonDetEltsUFM fm
  261                 -- See Note [Unique Determinism and code generation]
  262 
  263    in   addListToUFM_C
  264                 (\(l1, c1) (_, c2) -> (l1, c1 + c2))
  265                 emptyUFM
  266                 lifes
  267 
  268 
  269 -- | Dump a table of how many conflicts vregs tend to have in the initial code.
  270 pprStatsConflict
  271         :: [RegAllocStats statics instr] -> SDoc
  272 
  273 pprStatsConflict stats
  274  = let  confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
  275                         emptyUFM
  276                 $ map Color.slurpNodeConflictCount
  277                         [ raGraph s | s@RegAllocStatsStart{} <- stats ]
  278 
  279    in   (  text "-- vreg-conflicts"
  280         $$ text "--   (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
  281         $$ pprUFM confMap (vcat . map ppr)
  282         $$ text "\n")
  283 
  284 
  285 -- | For every vreg, dump how many conflicts it has, and its lifetime.
  286 --      Good for making a scatter plot.
  287 pprStatsLifeConflict
  288         :: [RegAllocStats statics instr]
  289         -> Color.Graph VirtualReg RegClass RealReg -- ^ global register conflict graph
  290         -> SDoc
  291 
  292 pprStatsLifeConflict stats graph
  293  = let  lifeMap = lifeMapFromSpillCostInfo
  294                 $ foldl' plusSpillCostInfo zeroSpillCostInfo
  295                 $ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]
  296 
  297         scatter = map   (\r ->  let lifetime  = case lookupUFM lifeMap r of
  298                                                       Just (_, l) -> l
  299                                                       Nothing     -> 0
  300                                     Just node = Color.lookupNode graph r
  301                                 in parens $ hcat $ punctuate (text ", ")
  302                                         [ doubleQuotes $ ppr $ Color.nodeId node
  303                                         , ppr $ sizeUniqSet (Color.nodeConflicts node)
  304                                         , ppr $ lifetime ])
  305                 $ map Color.nodeId
  306                 $ nonDetEltsUFM
  307                 -- See Note [Unique Determinism and code generation]
  308                 $ Color.graphMap graph
  309 
  310    in   (  text "-- vreg-conflict-lifetime"
  311         $$ text "--   (vreg, vreg_conflicts, vreg_lifetime)"
  312         $$ (vcat scatter)
  313         $$ text "\n")
  314 
  315 
  316 -- | Count spill/reload/reg-reg moves.
  317 --      Lets us see how well the register allocator has done.
  318 countSRMs
  319         :: Instruction instr
  320         => LiveCmmDecl statics instr -> (Int, Int, Int)
  321 
  322 countSRMs cmm
  323         = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
  324 
  325 
  326 countSRM_block
  327         :: Instruction instr
  328         => GenBasicBlock (LiveInstr instr)
  329         -> State (Int, Int, Int) (GenBasicBlock (LiveInstr instr))
  330 
  331 countSRM_block (BasicBlock i instrs)
  332  = do   instrs' <- mapM countSRM_instr instrs
  333         return  $ BasicBlock i instrs'
  334 
  335 
  336 countSRM_instr
  337         :: Instruction instr
  338         => LiveInstr instr -> State (Int, Int, Int) (LiveInstr instr)
  339 
  340 countSRM_instr li
  341         | LiveInstr SPILL{} _    <- li
  342         = do    modify  $ \(s, r, m)    -> (s + 1, r, m)
  343                 return li
  344 
  345         | LiveInstr RELOAD{} _  <- li
  346         = do    modify  $ \(s, r, m)    -> (s, r + 1, m)
  347                 return li
  348 
  349         | LiveInstr instr _     <- li
  350         , Just _        <- takeRegRegMoveInstr instr
  351         = do    modify  $ \(s, r, m)    -> (s, r, m + 1)
  352                 return li
  353 
  354         | otherwise
  355         =       return li
  356 
  357 
  358 -- sigh..
  359 addSRM :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int)
  360 addSRM (s1, r1, m1) (s2, r2, m2)
  361  = let  !s = s1 + s2
  362         !r = r1 + r2
  363         !m = m1 + m2
  364    in   (s, r, m)
  365