GHC-XAppFix /compiler/nativeGen/RegAlloc/Graph/Stats.hs

Language Haskell Lines 296
MD5 Hash 75a0b0efea686b32847606d9a951a60f Estimated Cost $5,300 (why?)
Repository git://github.com/ilyasergey/GHC-XAppFix.git View Raw File View Project SPDX
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
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
{-# OPTIONS -fno-warn-missing-signatures #-}
-- | Carries interesting info for debugging / profiling of the 
--	graph coloring register allocator.
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

module RegAlloc.Graph.Stats (
	RegAllocStats (..),

	pprStats,
	pprStatsSpills,
	pprStatsLifetimes,
	pprStatsConflict,
	pprStatsLifeConflict,

	countSRMs, addSRM
)

where

#include "nativeGen/NCG.h"

import qualified GraphColor as Color
import RegAlloc.Liveness
import RegAlloc.Graph.Spill
import RegAlloc.Graph.SpillCost
import RegAlloc.Graph.TrivColorable
import Instruction
import RegClass
import Reg
import TargetReg

import OldCmm
import OldPprCmm()
import Outputable
import UniqFM
import UniqSet
import State

import Data.List

data RegAllocStats statics instr

	-- initial graph
	= RegAllocStatsStart
	{ raLiveCmm	:: [LiveCmmDecl statics instr]		  	-- ^ initial code, with liveness
	, raGraph	:: Color.Graph VirtualReg RegClass RealReg   	-- ^ the initial, uncolored graph
	, raSpillCosts	:: SpillCostInfo } 		 		-- ^ information to help choose which regs to spill

	-- a spill stage
	| RegAllocStatsSpill
	{ raCode	:: [LiveCmmDecl statics instr]			-- ^ the code we tried to allocate registers for
	, raGraph	:: Color.Graph VirtualReg RegClass RealReg	-- ^ the partially colored graph
	, raCoalesced	:: UniqFM VirtualReg				-- ^ the regs that were coaleced
	, raSpillStats	:: SpillStats 					-- ^ spiller stats
	, raSpillCosts	:: SpillCostInfo 				-- ^ number of instrs each reg lives for
	, raSpilled	:: [LiveCmmDecl statics instr] }			-- ^ code with spill instructions added

	-- a successful coloring
	| RegAllocStatsColored
	{ raCode	  :: [LiveCmmDecl statics instr]			-- ^ the code we tried to allocate registers for
	, raGraph	  :: Color.Graph VirtualReg RegClass RealReg	-- ^ the uncolored graph
	, raGraphColored  :: Color.Graph VirtualReg RegClass RealReg 	-- ^ the coalesced and colored graph
	, raCoalesced	  :: UniqFM VirtualReg				-- ^ the regs that were coaleced
	, raCodeCoalesced :: [LiveCmmDecl statics instr]			-- ^ code with coalescings applied 
	, raPatched	  :: [LiveCmmDecl statics instr] 		-- ^ code with vregs replaced by hregs
	, raSpillClean    :: [LiveCmmDecl statics instr]			-- ^ code with unneeded spill\/reloads cleaned out
	, raFinal	  :: [NatCmmDecl statics instr] 			-- ^ final code
	, raSRMs	  :: (Int, Int, Int) }				-- ^ spill\/reload\/reg-reg moves present in this code

instance (PlatformOutputable statics, PlatformOutputable instr) => PlatformOutputable (RegAllocStats statics instr) where

 pprPlatform platform (s@RegAllocStatsStart{})
 	=  text "#  Start"
	$$ text "#  Native code with liveness information."
	$$ pprPlatform platform (raLiveCmm s)
	$$ text ""
	$$ text "#  Initial register conflict graph."
	$$ Color.dotGraph 
		(targetRegDotColor platform)
		(trivColorable platform
			(targetVirtualRegSqueeze platform)
			(targetRealRegSqueeze platform))
		(raGraph s)


 pprPlatform platform (s@RegAllocStatsSpill{})
 	=  text "#  Spill"

	$$ text "#  Code with liveness information."
	$$ pprPlatform platform (raCode s)
	$$ text ""

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

	$$ text "#  Spills inserted."
	$$ ppr (raSpillStats s)
	$$ text ""

	$$ text "#  Code with spills inserted."
	$$ pprPlatform platform (raSpilled s)


 pprPlatform platform (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
 	=  text "#  Colored"

	$$ text "#  Code with liveness information."
	$$ pprPlatform platform (raCode s)
	$$ text ""

	$$ text "#  Register conflict graph (colored)."
	$$ Color.dotGraph 
		(targetRegDotColor platform)
		(trivColorable platform
			(targetVirtualRegSqueeze platform)
			(targetRealRegSqueeze platform))
		(raGraphColored s)
	$$ text ""

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

	$$ text "#  Native code after coalescings applied."
	$$ pprPlatform platform (raCodeCoalesced s)
	$$ text ""

	$$ text "#  Native code after register allocation."
	$$ pprPlatform platform (raPatched s)
	$$ text ""

	$$ text "#  Clean out unneeded spill/reloads."
	$$ pprPlatform platform (raSpillClean s)
	$$ text ""

	$$ text "#  Final code, after rewriting spill/rewrite pseudo instrs."
	$$ pprPlatform platform (raFinal s)
	$$ text ""
	$$  text "#  Score:"
	$$ (text "#          spills  inserted: " <> int spills)
	$$ (text "#          reloads inserted: " <> int reloads)
	$$ (text "#   reg-reg moves remaining: " <> int moves)
	$$ text ""

-- | Do all the different analysis on this list of RegAllocStats
pprStats 
	:: [RegAllocStats statics instr] 
	-> Color.Graph VirtualReg RegClass RealReg 
	-> SDoc
	
pprStats stats graph
 = let 	outSpills	= pprStatsSpills    stats
	outLife		= pprStatsLifetimes stats
	outConflict	= pprStatsConflict  stats
	outScatter	= pprStatsLifeConflict stats graph

  in	vcat [outSpills, outLife, outConflict, outScatter]


-- | Dump a table of how many spill loads \/ stores were inserted for each vreg.
pprStatsSpills
	:: [RegAllocStats statics instr] -> SDoc

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

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

    in	(  text "-- spills-added-total"
	$$ text "--    (stores, loads, reg_reg_moves_remaining)"
	$$ ppr total
	$$ text "")


-- | Dump a table of how long vregs tend to live for in the initial code.
pprStatsLifetimes
	:: [RegAllocStats statics instr] -> SDoc

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

	lifeBins	= binLifetimeCount $ lifeMapFromSpillCostInfo info

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

binLifetimeCount :: UniqFM (VirtualReg, Int) -> UniqFM (Int, Int)
binLifetimeCount fm
 = let	lifes	= map (\l -> (l, (l, 1)))
 		$ map snd
		$ eltsUFM fm

   in	addListToUFM_C
		(\(l1, c1) (_, c2) -> (l1, c1 + c2))
		emptyUFM
		lifes


-- | Dump a table of how many conflicts vregs tend to have in the initial code.
pprStatsConflict
	:: [RegAllocStats statics instr] -> SDoc

pprStatsConflict stats
 = let	confMap	= foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
			emptyUFM
		$ map Color.slurpNodeConflictCount
			[ raGraph s | s@RegAllocStatsStart{} <- stats ]

   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
	:: [RegAllocStats statics instr]
	-> Color.Graph VirtualReg RegClass RealReg 	-- ^ global register conflict graph
	-> SDoc

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

 	scatter	= map	(\r ->  let lifetime	= case lookupUFM lifeMap r of
							Just (_, l)	-> l
							Nothing		-> 0
				    Just node	= Color.lookupNode graph r
				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")


-- | Count spill/reload/reg-reg moves.
--	Lets us see how well the register allocator has done.
countSRMs 
	:: Instruction instr
	=> LiveCmmDecl statics instr -> (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'

countSRM_instr li
	| LiveInstr SPILL{} _	 <- li
	= do	modify  $ \(s, r, m)	-> (s + 1, r, m)
		return li

	| LiveInstr RELOAD{} _ 	<- li
	= do	modify  $ \(s, r, m)	-> (s, r + 1, m)
		return li
	
	| LiveInstr instr _	<- li
	, Just _	<- takeRegRegMoveInstr 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)
Back to Top