PageRenderTime 39ms CodeModel.GetById 14ms RepoModel.GetById 0ms app.codeStats 0ms

/ghc-7.0.4/compiler/nativeGen/RegAlloc/Graph/Stats.hs

http://picorec.googlecode.com/
Haskell | 287 lines | 209 code | 62 blank | 16 comment | 2 complexity | 23635f80c458faf33be7891249c50f4e MD5 | raw file
Possible License(s): BSD-3-Clause, BSD-2-Clause
  1. {-# OPTIONS -fno-warn-missing-signatures #-}
  2. -- | Carries interesting info for debugging / profiling of the
  3. -- graph coloring register allocator.
  4. module RegAlloc.Graph.Stats (
  5. RegAllocStats (..),
  6. pprStats,
  7. pprStatsSpills,
  8. pprStatsLifetimes,
  9. pprStatsConflict,
  10. pprStatsLifeConflict,
  11. countSRMs, addSRM
  12. )
  13. where
  14. #include "nativeGen/NCG.h"
  15. import qualified GraphColor as Color
  16. import RegAlloc.Liveness
  17. import RegAlloc.Graph.Spill
  18. import RegAlloc.Graph.SpillCost
  19. import RegAlloc.Graph.TrivColorable
  20. import Instruction
  21. import RegClass
  22. import Reg
  23. import TargetReg
  24. import Cmm
  25. import Outputable
  26. import UniqFM
  27. import UniqSet
  28. import State
  29. import Data.List
  30. data RegAllocStats instr
  31. -- initial graph
  32. = RegAllocStatsStart
  33. { raLiveCmm :: [LiveCmmTop instr] -- ^ initial code, with liveness
  34. , raGraph :: Color.Graph VirtualReg RegClass RealReg -- ^ the initial, uncolored graph
  35. , raSpillCosts :: SpillCostInfo } -- ^ information to help choose which regs to spill
  36. -- a spill stage
  37. | RegAllocStatsSpill
  38. { raCode :: [LiveCmmTop instr] -- ^ the code we tried to allocate registers for
  39. , raGraph :: Color.Graph VirtualReg RegClass RealReg -- ^ the partially colored graph
  40. , raCoalesced :: UniqFM VirtualReg -- ^ the regs that were coaleced
  41. , raSpillStats :: SpillStats -- ^ spiller stats
  42. , raSpillCosts :: SpillCostInfo -- ^ number of instrs each reg lives for
  43. , raSpilled :: [LiveCmmTop instr] } -- ^ code with spill instructions added
  44. -- a successful coloring
  45. | RegAllocStatsColored
  46. { raCode :: [LiveCmmTop instr] -- ^ the code we tried to allocate registers for
  47. , raGraph :: Color.Graph VirtualReg RegClass RealReg -- ^ the uncolored graph
  48. , raGraphColored :: Color.Graph VirtualReg RegClass RealReg -- ^ the coalesced and colored graph
  49. , raCoalesced :: UniqFM VirtualReg -- ^ the regs that were coaleced
  50. , raCodeCoalesced :: [LiveCmmTop instr] -- ^ code with coalescings applied
  51. , raPatched :: [LiveCmmTop instr] -- ^ code with vregs replaced by hregs
  52. , raSpillClean :: [LiveCmmTop instr] -- ^ code with unneeded spill\/reloads cleaned out
  53. , raFinal :: [NatCmmTop instr] -- ^ final code
  54. , raSRMs :: (Int, Int, Int) } -- ^ spill\/reload\/reg-reg moves present in this code
  55. instance Outputable instr => Outputable (RegAllocStats instr) where
  56. ppr (s@RegAllocStatsStart{})
  57. = text "# Start"
  58. $$ text "# Native code with liveness information."
  59. $$ ppr (raLiveCmm s)
  60. $$ text ""
  61. $$ text "# Initial register conflict graph."
  62. $$ Color.dotGraph
  63. targetRegDotColor
  64. (trivColorable
  65. targetVirtualRegSqueeze
  66. targetRealRegSqueeze)
  67. (raGraph s)
  68. ppr (s@RegAllocStatsSpill{})
  69. = text "# Spill"
  70. $$ text "# Code with liveness information."
  71. $$ (ppr (raCode s))
  72. $$ text ""
  73. $$ (if (not $ isNullUFM $ raCoalesced s)
  74. then text "# Registers coalesced."
  75. $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
  76. $$ text ""
  77. else empty)
  78. $$ text "# Spills inserted."
  79. $$ ppr (raSpillStats s)
  80. $$ text ""
  81. $$ text "# Code with spills inserted."
  82. $$ (ppr (raSpilled s))
  83. ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
  84. = text "# Colored"
  85. $$ text "# Code with liveness information."
  86. $$ (ppr (raCode s))
  87. $$ text ""
  88. $$ text "# Register conflict graph (colored)."
  89. $$ Color.dotGraph
  90. targetRegDotColor
  91. (trivColorable
  92. targetVirtualRegSqueeze
  93. targetRealRegSqueeze)
  94. (raGraphColored s)
  95. $$ text ""
  96. $$ (if (not $ isNullUFM $ raCoalesced s)
  97. then text "# Registers coalesced."
  98. $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
  99. $$ text ""
  100. else empty)
  101. $$ text "# Native code after coalescings applied."
  102. $$ ppr (raCodeCoalesced s)
  103. $$ text ""
  104. $$ text "# Native code after register allocation."
  105. $$ ppr (raPatched s)
  106. $$ text ""
  107. $$ text "# Clean out unneeded spill/reloads."
  108. $$ ppr (raSpillClean s)
  109. $$ text ""
  110. $$ text "# Final code, after rewriting spill/rewrite pseudo instrs."
  111. $$ ppr (raFinal s)
  112. $$ text ""
  113. $$ text "# Score:"
  114. $$ (text "# spills inserted: " <> int spills)
  115. $$ (text "# reloads inserted: " <> int reloads)
  116. $$ (text "# reg-reg moves remaining: " <> int moves)
  117. $$ text ""
  118. -- | Do all the different analysis on this list of RegAllocStats
  119. pprStats
  120. :: [RegAllocStats instr]
  121. -> Color.Graph VirtualReg RegClass RealReg
  122. -> SDoc
  123. pprStats stats graph
  124. = let outSpills = pprStatsSpills stats
  125. outLife = pprStatsLifetimes stats
  126. outConflict = pprStatsConflict stats
  127. outScatter = pprStatsLifeConflict stats graph
  128. in vcat [outSpills, outLife, outConflict, outScatter]
  129. -- | Dump a table of how many spill loads \/ stores were inserted for each vreg.
  130. pprStatsSpills
  131. :: [RegAllocStats instr] -> SDoc
  132. pprStatsSpills stats
  133. = let
  134. finals = [ s | s@RegAllocStatsColored{} <- stats]
  135. -- sum up how many stores\/loads\/reg-reg-moves were left in the code
  136. total = foldl' addSRM (0, 0, 0)
  137. $ map raSRMs finals
  138. in ( text "-- spills-added-total"
  139. $$ text "-- (stores, loads, reg_reg_moves_remaining)"
  140. $$ ppr total
  141. $$ text "")
  142. -- | Dump a table of how long vregs tend to live for in the initial code.
  143. pprStatsLifetimes
  144. :: [RegAllocStats instr] -> SDoc
  145. pprStatsLifetimes stats
  146. = let info = foldl' plusSpillCostInfo zeroSpillCostInfo
  147. [ raSpillCosts s
  148. | s@RegAllocStatsStart{} <- stats ]
  149. lifeBins = binLifetimeCount $ lifeMapFromSpillCostInfo info
  150. in ( text "-- vreg-population-lifetimes"
  151. $$ text "-- (instruction_count, number_of_vregs_that_lived_that_long)"
  152. $$ (vcat $ map ppr $ eltsUFM lifeBins)
  153. $$ text "\n")
  154. binLifetimeCount :: UniqFM (VirtualReg, Int) -> UniqFM (Int, Int)
  155. binLifetimeCount fm
  156. = let lifes = map (\l -> (l, (l, 1)))
  157. $ map snd
  158. $ eltsUFM fm
  159. in addListToUFM_C
  160. (\(l1, c1) (_, c2) -> (l1, c1 + c2))
  161. emptyUFM
  162. lifes
  163. -- | Dump a table of how many conflicts vregs tend to have in the initial code.
  164. pprStatsConflict
  165. :: [RegAllocStats instr] -> SDoc
  166. pprStatsConflict stats
  167. = let confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
  168. emptyUFM
  169. $ map Color.slurpNodeConflictCount
  170. [ raGraph s | s@RegAllocStatsStart{} <- stats ]
  171. in ( text "-- vreg-conflicts"
  172. $$ text "-- (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
  173. $$ (vcat $ map ppr $ eltsUFM confMap)
  174. $$ text "\n")
  175. -- | For every vreg, dump it's how many conflicts it has and its lifetime
  176. -- good for making a scatter plot.
  177. pprStatsLifeConflict
  178. :: [RegAllocStats instr]
  179. -> Color.Graph VirtualReg RegClass RealReg -- ^ global register conflict graph
  180. -> SDoc
  181. pprStatsLifeConflict stats graph
  182. = let lifeMap = lifeMapFromSpillCostInfo
  183. $ foldl' plusSpillCostInfo zeroSpillCostInfo
  184. $ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]
  185. scatter = map (\r -> let lifetime = case lookupUFM lifeMap r of
  186. Just (_, l) -> l
  187. Nothing -> 0
  188. Just node = Color.lookupNode graph r
  189. in parens $ hcat $ punctuate (text ", ")
  190. [ doubleQuotes $ ppr $ Color.nodeId node
  191. , ppr $ sizeUniqSet (Color.nodeConflicts node)
  192. , ppr $ lifetime ])
  193. $ map Color.nodeId
  194. $ eltsUFM
  195. $ Color.graphMap graph
  196. in ( text "-- vreg-conflict-lifetime"
  197. $$ text "-- (vreg, vreg_conflicts, vreg_lifetime)"
  198. $$ (vcat scatter)
  199. $$ text "\n")
  200. -- | Count spill/reload/reg-reg moves.
  201. -- Lets us see how well the register allocator has done.
  202. countSRMs
  203. :: Instruction instr
  204. => LiveCmmTop instr -> (Int, Int, Int)
  205. countSRMs cmm
  206. = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
  207. countSRM_block (BasicBlock i instrs)
  208. = do instrs' <- mapM countSRM_instr instrs
  209. return $ BasicBlock i instrs'
  210. countSRM_instr li
  211. | LiveInstr SPILL{} _ <- li
  212. = do modify $ \(s, r, m) -> (s + 1, r, m)
  213. return li
  214. | LiveInstr RELOAD{} _ <- li
  215. = do modify $ \(s, r, m) -> (s, r + 1, m)
  216. return li
  217. | LiveInstr instr _ <- li
  218. , Just _ <- takeRegRegMoveInstr instr
  219. = do modify $ \(s, r, m) -> (s, r, m + 1)
  220. return li
  221. | otherwise
  222. = return li
  223. -- sigh..
  224. addSRM (s1, r1, m1) (s2, r2, m2)
  225. = (s1+s2, r1+r2, m1+m2)