RegAllocStats.hs 8.42 KB
Newer Older
1 2
-- Carries interesting info for debugging / profiling of the 
--	graph coloring register allocator.
Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
3 4
--
{-# OPTIONS -fno-warn-missing-signatures #-}
5

6 7
module RegAllocStats (
	RegAllocStats (..),
8
	regDotColor,
9

10
	pprStats,
11 12 13
	pprStatsSpills,
	pprStatsLifetimes,
	pprStatsConflict,
14 15 16
	pprStatsLifeConflict,

	countSRMs, addSRM
17 18 19 20 21 22 23 24
)

where

#include "nativeGen/NCG.h"

import qualified GraphColor as Color
import RegLiveness
25
import RegAllocInfo
26
import RegSpill
27
import RegSpillCost
28
import MachRegs
29
import MachInstrs
30
import Cmm
31 32 33

import Outputable
import UniqFM
34
import UniqSet
35
import State
36

37
import Data.List
38 39 40

data RegAllocStats

41 42 43
	-- initial graph
	= RegAllocStatsStart
	{ raLiveCmm	:: [LiveCmmTop]			  -- ^ initial code, with liveness
44 45
	, raGraph	:: Color.Graph Reg RegClass Reg   -- ^ the initial, uncolored graph
	, raSpillCosts	:: SpillCostInfo } 		  -- ^ information to help choose which regs to spill
46

47
	-- a spill stage
48 49
	| RegAllocStatsSpill
	{ raGraph	:: Color.Graph Reg RegClass Reg	-- ^ the partially colored graph
50
	, raCoalesced	:: UniqFM Reg			-- ^ the regs that were coaleced
51
	, raSpillStats	:: SpillStats 			-- ^ spiller stats
52
	, raSpillCosts	:: SpillCostInfo 		-- ^ number of instrs each reg lives for
53
	, raSpilled	:: [LiveCmmTop] }		-- ^ code with spill instructions added
54 55 56

	-- a successful coloring
	| RegAllocStatsColored
57
	{ raGraph	:: Color.Graph Reg RegClass Reg -- ^ the colored graph
58
	, raCoalesced	:: UniqFM Reg			-- ^ the regs that were coaleced
59 60
	, raPatched	:: [LiveCmmTop] 		-- ^ code with vregs replaced by hregs
	, raSpillClean  :: [LiveCmmTop]			-- ^ code with unneeded spill/reloads cleaned out
61 62
	, raFinal	:: [NatCmmTop] 			-- ^ final code
	, raSRMs	:: (Int, Int, Int) }		-- ^ spill/reload/reg-reg moves present in this code
63 64 65

instance Outputable RegAllocStats where

66 67 68
 ppr (s@RegAllocStatsStart{})
 	=  text "#  Start"
	$$ text "#  Native code with liveness information."
69
	$$ ppr (raLiveCmm s)
70 71
	$$ text ""
	$$ text "#  Initial register conflict graph."
72 73
	$$ Color.dotGraph regDotColor trivColorable (raGraph s)

74

75 76
 ppr (s@RegAllocStatsSpill{})
 	=  text "#  Spill"
77

78 79 80
	$$ text "#  Register conflict graph."
	$$ Color.dotGraph regDotColor trivColorable (raGraph s)
	$$ text ""
81 82 83 84 85 86 87

	$$ (if (not $ isNullUFM $ raCoalesced s)
		then 	text "#  Registers coalesced."
			$$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
			$$ text ""
		else empty)

88 89 90 91
	$$ text "#  Spill costs.  reg uses defs lifetime degree cost"
	$$ vcat (map (pprSpillCostRecord (raGraph s)) $ eltsUFM $ raSpillCosts s)
	$$ text ""

92
	$$ text "#  Spills inserted."
93
	$$ ppr (raSpillStats s)
94
	$$ text ""
95

96 97
	$$ text "#  Code with spills inserted."
	$$ (ppr (raSpilled s))
98

99

100
 ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
101
 	=  text "#  Colored"
102

103 104 105
	$$ text "#  Register conflict graph."
	$$ Color.dotGraph regDotColor trivColorable (raGraph s)
	$$ text ""
106 107 108 109 110 111 112

	$$ (if (not $ isNullUFM $ raCoalesced s)
		then 	text "#  Registers coalesced."
			$$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
			$$ text ""
		else empty)

113
	$$ text "#  Native code after register allocation."
114 115
	$$ ppr (raPatched s)
	$$ text ""
116

117 118
	$$ text "#  Clean out unneeded spill/reloads."
	$$ ppr (raSpillClean s)
119
	$$ text ""
120

121
	$$ text "#  Final code, after rewriting spill/rewrite pseudo instrs."
122
	$$ ppr (raFinal s)
123
	$$ text ""
124 125 126 127 128
	$$  text "#  Score:"
	$$ (text "#          spills  inserted: " <> int spills)
	$$ (text "#          reloads inserted: " <> int reloads)
	$$ (text "#   reg-reg moves remaining: " <> int moves)
	$$ text ""
129

130 131 132 133 134 135 136
-- | Do all the different analysis on this list of RegAllocStats
pprStats :: [RegAllocStats] -> Color.Graph Reg RegClass Reg -> SDoc
pprStats stats graph
 = let 	outSpills	= pprStatsSpills    stats
	outLife		= pprStatsLifetimes stats
	outConflict	= pprStatsConflict  stats
	outScatter	= pprStatsLifeConflict stats graph
137

138
  in	vcat [outSpills, outLife, outConflict, outScatter]
139 140


141 142 143 144 145
-- | Dump a table of how many spill loads / stores were inserted for each vreg.
pprStatsSpills
	:: [RegAllocStats] -> SDoc

pprStatsSpills stats
146 147
 = let
	finals	= [ s	| s@RegAllocStatsColored{} <- stats]
148

149 150 151
	-- sum up how many stores/loads/reg-reg-moves were left in the code
	total	= foldl' addSRM (0, 0, 0)
		$ map raSRMs finals
152

153
    in	(  text "-- spills-added-total"
154 155
	$$ text "--    (stores, loads, reg_reg_moves_remaining)"
	$$ ppr total
156
	$$ text "")
157 158


159
-- | Dump a table of how long vregs tend to live for in the initial code.
160 161 162 163
pprStatsLifetimes
	:: [RegAllocStats] -> SDoc

pprStatsLifetimes stats
164 165 166 167 168
 = let	info		= foldl' plusSpillCostInfo zeroSpillCostInfo
 				[ raSpillCosts s
					| s@RegAllocStatsStart{} <- stats ]

	lifeBins	= binLifetimeCount $ lifeMapFromSpillCostInfo info
169 170 171 172 173 174

   in	(  text "-- vreg-population-lifetimes"
	$$ text "--   (instruction_count, number_of_vregs_that_lived_that_long)"
	$$ (vcat $ map ppr $ eltsUFM lifeBins)
	$$ text "\n")

175 176 177 178 179 180 181
binLifetimeCount :: UniqFM (Reg, Int) -> UniqFM (Int, Int)
binLifetimeCount fm
 = let	lifes	= map (\l -> (l, (l, 1)))
 		$ map snd
		$ eltsUFM fm

   in	addListToUFM_C
Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
182
		(\(l1, c1) (_, c2) -> (l1, c1 + c2))
183 184 185
		emptyUFM
		lifes

186

187
-- | Dump a table of how many conflicts vregs tend to have in the initial code.
188 189 190 191
pprStatsConflict
	:: [RegAllocStats] -> SDoc

pprStatsConflict stats
Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
192
 = let	confMap	= foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
193 194
			emptyUFM
		$ map Color.slurpNodeConflictCount
195
			[ raGraph s | s@RegAllocStatsStart{} <- stats ]
196 197 198 199 200 201 202 203 204 205

   in	(  text "-- vreg-conflicts"
	$$ text "--   (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
	$$ (vcat $ map ppr $ eltsUFM confMap)
	$$ text "\n")


-- | For every vreg, dump it's how many conflicts it has and its lifetime
--	good for making a scatter plot.
pprStatsLifeConflict
206 207 208
	:: [RegAllocStats]
	-> Color.Graph Reg RegClass Reg 	-- ^ global register conflict graph
	-> SDoc
209 210

pprStatsLifeConflict stats graph
211 212 213
 = let	lifeMap	= lifeMapFromSpillCostInfo
 		$ foldl' plusSpillCostInfo zeroSpillCostInfo
		$ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]
214

215 216 217 218
 	scatter	= map	(\r ->  let lifetime	= case lookupUFM lifeMap r of
							Just (_, l)	-> l
							Nothing		-> 0
				    Just node	= Color.lookupNode graph r
219 220 221 222 223 224 225 226 227 228 229 230 231 232
				in parens $ hcat $ punctuate (text ", ")
					[ doubleQuotes $ ppr $ Color.nodeId node
					, ppr $ sizeUniqSet (Color.nodeConflicts node)
					, ppr $ lifetime ])
		$ map Color.nodeId
		$ eltsUFM
		$ Color.graphMap graph

   in 	(  text "-- vreg-conflict-lifetime"
	$$ text "--   (vreg, vreg_conflicts, vreg_lifetime)"
	$$ (vcat scatter)
	$$ text "\n")


233 234 235 236 237 238 239 240 241 242 243
-- | Count spill/reload/reg-reg moves.
--	Lets us see how well the register allocator has done.
--
countSRMs :: LiveCmmTop -> (Int, Int, Int)
countSRMs cmm
	= execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)

countSRM_block (BasicBlock i instrs)
 = do	instrs'	<- mapM countSRM_instr instrs
 	return	$ BasicBlock i instrs'

Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
244 245
countSRM_instr li@(Instr instr _)
	| SPILL _ _	<- instr
246 247 248
	= do	modify 	$ \(s, r, m)	-> (s + 1, r, m)
		return li

Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
249
	| RELOAD _ _	<- instr
250 251 252 253 254 255 256 257 258 259 260 261 262 263
	= do	modify	$ \(s, r, m)	-> (s, r + 1, m)
		return li

	| Just _		<- isRegRegMove instr
	= do	modify	$ \(s, r, m)	-> (s, r, m + 1)
		return li

	| otherwise
	=	return li

-- sigh..
addSRM (s1, r1, m1) (s2, r2, m2)
	= (s1+s2, r1+r2, m1+m2)

264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337
-----
-- Register colors for drawing conflict graphs
--	Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.


-- reg colors for x86
#if i386_TARGET_ARCH
regDotColor :: Reg -> SDoc
regDotColor reg
 = let	Just	str	= lookupUFM regColors reg
   in	text str

regColors
 = listToUFM
 $  	[ (eax,	"#00ff00")
	, (ebx,	"#0000ff")
	, (ecx,	"#00ffff")
	, (edx,	"#0080ff")

	, (fake0, "#ff00ff")
	, (fake1, "#ff00aa")
	, (fake2, "#aa00ff")
	, (fake3, "#aa00aa")
	, (fake4, "#ff0055")
	, (fake5, "#5500ff") ]
#endif


-- reg colors for x86_64
#if x86_64_TARGET_ARCH
regDotColor :: Reg -> SDoc
regDotColor reg
 = let	Just	str	= lookupUFM regColors reg
   in	text str

regColors
 = listToUFM
 $	[ (rax, "#00ff00"), (eax, "#00ff00")
	, (rbx,	"#0000ff"), (ebx, "#0000ff")
	, (rcx,	"#00ffff"), (ecx, "#00ffff")
	, (rdx,	"#0080ff"), (edx, "#00ffff")
	, (r8,  "#00ff80")
	, (r9,  "#008080")
	, (r10, "#0040ff")
	, (r11, "#00ff40")
	, (r12, "#008040")
	, (r13, "#004080")
	, (r14, "#004040")
	, (r15, "#002080") ]

	++ zip (map RealReg [16..31]) (repeat "red")
#endif


-- reg colors for ppc
#if powerpc_TARGET_ARCH
regDotColor :: Reg -> SDoc
regDotColor reg
 = case regClass reg of
 	RcInteger	-> text "blue"
	RcFloat		-> text "red"
#endif


{-
toX11Color (r, g, b)
 = let	rs	= padL 2 '0' (showHex r "")
 	gs	= padL 2 '0' (showHex r "")
	bs	= padL 2 '0' (showHex r "")

	padL n c s
		= replicate (n - length s) c ++ s
  in	"#" ++ rs ++ gs ++ bs
-}