PageRenderTime 50ms CodeModel.GetById 22ms RepoModel.GetById 1ms app.codeStats 0ms

/compiler/nativeGen/RegAlloc/Graph/Stats.hs

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