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