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 import Instruction
  12
  13 import OldCmm  (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
  39         :: Instruction instr
  40         => NatCmmTop instr -> Int
  41
  42 countRegRegMovesNat cmm
  43         = execState (mapGenBlockTopM countBlock cmm) 0
  44  where
  45         countBlock b@(BasicBlock _ instrs)
  46          = do   mapM_ countInstr instrs
  47                 return  b
  48
  49         countInstr instr
  50                 | Just _        <- takeRegRegMoveInstr instr
  51                 = do    modify (+ 1)
  52                         return instr
  53
  54                 | otherwise
  55                 =       return instr
  56
  57
  58 -- | Pretty print some RegAllocStats
  59 pprStats
  60         :: Instruction instr
  61         => [NatCmmTop instr] -> [RegAllocStats] -> SDoc
  62
  63 pprStats code statss
  64  = let  -- sum up all the instrs inserted by the spiller
  65         spills          = foldl' (plusUFM_C (zipWith (+)))
  66                                 emptyUFM
  67                         $ map ra_spillInstrs statss
  68
  69         spillTotals     = foldl' (zipWith (+))
  70                                 [0, 0, 0, 0, 0]
  71                         $ eltsUFM spills
  72
  73         -- count how many reg-reg-moves remain in the code
  74         moves           = sum $ map countRegRegMovesNat code
  75
  76         pprSpill (reg, spills)
  77                 = parens $ (hcat $ punctuate (text ", ")  (doubleQuotes (ppr reg) : map ppr spills))
  78
  79    in   (  text "-- spills-added-total"
  80         $$ text "--    (allocs, clobbers, loads, joinRR, joinRM, reg_reg_moves_remaining)"
  81         $$ (parens $ (hcat $ punctuate (text ", ") (map ppr spillTotals ++ [ppr moves])))
  82         $$ text ""
  83         $$ text "-- spills-added"
  84         $$ text "--    (reg_name, allocs, clobbers, loads, joinRR, joinRM)"
  85         $$ (vcat $ map pprSpill
  86                  $ ufmToList spills)
  87         $$ text "")
  88