compiler/nativeGen/RegAlloc/Linear/Stats.hs

   1 module RegAlloc.Linear.Stats (
   2         binSpillReasons,
   3         countRegRegMovesNat,
   4         pprStats
   5 )
   6
   7 where
   8
   9 import RegAlloc.Linear.Base
  10 import RegLiveness
  11 import RegAllocInfo
  12 import Instrs
  13 import Cmm              (GenBasicBlock(..))
  14
  15 import UniqFM
  16 import Outputable
  17
  18 import Data.List
  19 import State
  20
  21 -- | Build a map of how many times each reg was alloced, clobbered, loaded etc.
  22 binSpillReasons
  23         :: [SpillReason] -> UniqFM [Int]
  24
  25 binSpillReasons reasons
  26         = addListToUFM_C
  27                 (zipWith (+))
  28                 emptyUFM
  29                 (map (\reason -> case reason of
  30                         SpillAlloc r    -> (r, [1, 0, 0, 0, 0])
  31                         SpillClobber r  -> (r, [0, 1, 0, 0, 0])
  32                         SpillLoad r     -> (r, [0, 0, 1, 0, 0])
  33                         SpillJoinRR r   -> (r, [0, 0, 0, 1, 0])
  34                         SpillJoinRM r   -> (r, [0, 0, 0, 0, 1])) reasons)
  35
  36
  37 -- | Count reg-reg moves remaining in this code.
  38 countRegRegMovesNat :: NatCmmTop -> Int
  39 countRegRegMovesNat cmm
  40         = execState (mapGenBlockTopM countBlock cmm) 0
  41  where
  42         countBlock b@(BasicBlock _ instrs)
  43          = do   mapM_ countInstr instrs
  44                 return  b
  45
  46         countInstr instr
  47                 | Just _        <- isRegRegMove instr
  48                 = do    modify (+ 1)
  49                         return instr
  50
  51                 | otherwise
  52                 =       return instr
  53
  54
  55 -- | Pretty print some RegAllocStats
  56 pprStats :: [NatCmmTop] -> [RegAllocStats] -> SDoc
  57 pprStats code statss
  58  = let  -- sum up all the instrs inserted by the spiller
  59         spills          = foldl' (plusUFM_C (zipWith (+)))
  60                                 emptyUFM
  61                         $ map ra_spillInstrs statss
  62
  63         spillTotals     = foldl' (zipWith (+))
  64                                 [0, 0, 0, 0, 0]
  65                         $ eltsUFM spills
  66
  67         -- count how many reg-reg-moves remain in the code
  68         moves           = sum $ map countRegRegMovesNat code
  69
  70         pprSpill (reg, spills)
  71                 = parens $ (hcat $ punctuate (text ", ")  (doubleQuotes (ppr reg) : map ppr spills))
  72
  73    in   (  text "-- spills-added-total"
  74         $$ text "--    (allocs, clobbers, loads, joinRR, joinRM, reg_reg_moves_remaining)"
  75         $$ (parens $ (hcat $ punctuate (text ", ") (map ppr spillTotals ++ [ppr moves])))
  76         $$ text ""
  77         $$ text "-- spills-added"
  78         $$ text "--    (reg_name, allocs, clobbers, loads, joinRR, joinRM)"
  79         $$ (vcat $ map pprSpill
  80                  $ ufmToList spills)
  81         $$ text "")
  82