ghc /compiler/nativeGen/RegAlloc/Linear/Stats.hs

Language Haskell Lines 96
MD5 Hash 059caa7dd4b2f4442be1dc5c3110a55a Estimated Cost $1,532 (why?)
Repository https://bitbucket.org/carter/ghc.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
{-# 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.Linear.Stats (
	binSpillReasons,
	countRegRegMovesNat,
	pprStats
)

where

import RegAlloc.Linear.Base
import RegAlloc.Liveness
import Instruction

import OldCmm  (GenBasicBlock(..))

import UniqFM
import Outputable

import Data.List
import State

-- | Build a map of how many times each reg was alloced, clobbered, loaded etc.
binSpillReasons
	:: [SpillReason] -> UniqFM [Int]

binSpillReasons reasons
	= addListToUFM_C
		(zipWith (+))
		emptyUFM
		(map (\reason -> case reason of
			SpillAlloc r	-> (r, [1, 0, 0, 0, 0])
			SpillClobber r	-> (r, [0, 1, 0, 0, 0])
			SpillLoad r	-> (r, [0, 0, 1, 0, 0])
			SpillJoinRR r	-> (r, [0, 0, 0, 1, 0])
			SpillJoinRM r	-> (r, [0, 0, 0, 0, 1])) reasons)


-- | Count reg-reg moves remaining in this code.
countRegRegMovesNat 
	:: Instruction instr
	=> NatCmmDecl statics instr -> Int

countRegRegMovesNat cmm
	= execState (mapGenBlockTopM countBlock cmm) 0
 where
 	countBlock b@(BasicBlock _ instrs)
	 = do	mapM_ countInstr instrs
	 	return	b

	countInstr instr
		| Just _	<- takeRegRegMoveInstr instr
		= do	modify (+ 1)
			return instr

		| otherwise
		=	return instr


-- | Pretty print some RegAllocStats
pprStats 
	:: Instruction instr 
	=> [NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc

pprStats code statss
 = let	-- sum up all the instrs inserted by the spiller
 	spills		= foldl' (plusUFM_C (zipWith (+)))
 				emptyUFM
			$ map ra_spillInstrs statss

	spillTotals	= foldl' (zipWith (+))
				[0, 0, 0, 0, 0]
			$ eltsUFM spills

	-- count how many reg-reg-moves remain in the code
	moves		= sum $ map countRegRegMovesNat code

	pprSpill (reg, spills)
		= parens $ (hcat $ punctuate (text ", ")  (doubleQuotes (ppr reg) : map ppr spills))

   in	(  text "-- spills-added-total"
	$$ text "--    (allocs, clobbers, loads, joinRR, joinRM, reg_reg_moves_remaining)"
	$$ (parens $ (hcat $ punctuate (text ", ") (map ppr spillTotals ++ [ppr moves])))
	$$ text ""
	$$ text "-- spills-added"
   	$$ text "--    (reg_name, allocs, clobbers, loads, joinRR, joinRM)"
	$$ (vcat $ map pprSpill
   		 $ ufmToList spills)
	$$ text "")
Back to Top