summaryrefslogtreecommitdiff
path: root/compiler/nativeGen/RegArchBase.hs
blob: ebf46e68a1be61380b4f3ca67fb26c8861b97c9a (plain)
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

-- | Utils for calculating general worst, bound, squeese and free, functions.
--
--	as per: "A Generalized Algorithm for Graph-Coloring Register Allocation"
--		Michael Smith, Normal Ramsey, Glenn Holloway.
--		PLDI 2004
--	
--	These general versions are not used in GHC proper because they are too slow.
--	Instead, hand written optimised versions are provided for each architecture
--	in MachRegs*.hs 
--
--	This code is here because we can test the architecture specific code against it.
--

{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
--     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
-- for details

module RegArchBase (
	RegClass(..),
	Reg(..),
	RegSub(..),
	
	worst,
	bound,
	squeese
)
	
where

-----
import UniqSet
import Unique


-- Some basic register classes.
--	These aren't nessesarally in 1-to-1 correspondance with the allocatable
--	RegClasses in MachRegs.hs
--
data RegClass
	-- general purpose regs
	= ClassG32	-- 32 bit GPRs
	| ClassG16	-- 16 bit GPRs
	| ClassG8	-- 8  bit GPRs
	
	-- floating point regs
	| ClassF64	-- 64 bit FPRs
	deriving (Show, Eq, Enum)


-- | A register of some class
data Reg
	-- a register of some class
	= Reg RegClass Int
	
	-- a sub-component of one of the other regs
	| RegSub RegSub Reg
	deriving (Show, Eq)


-- | so we can put regs in UniqSets
instance Uniquable Reg where
	getUnique (Reg c i)
	 = mkUnique 'R'
	 $ fromEnum c * 1000 + i

	getUnique (RegSub s (Reg c i))
	 = mkUnique 'S'
	 $ fromEnum s * 10000 + fromEnum c * 1000 + i

	getUnique (RegSub s (RegSub c _))
	  = error "RegArchBase.getUnique: can't have a sub-reg of a sub-reg."

-- | A subcomponent of another register
data RegSub
	= SubL16	-- lowest 16 bits
	| SubL8		-- lowest  8 bits
	| SubL8H	-- second lowest 8 bits
	deriving (Show, Enum, Ord, Eq)
	

-- | Worst case displacement
--
--	a node N of classN has some number of neighbors, 
--	all of which are from classC.
--
--	(worst neighbors classN classC) is the maximum number of potential
--	colors for N that can be lost by coloring its neighbors.

-- This should be hand coded/cached for each particular architecture,
--	because the compute time is very long..

worst 
	:: (RegClass 	-> UniqSet Reg)
	-> (Reg 	-> UniqSet Reg)
	-> Int -> RegClass -> RegClass -> Int

worst regsOfClass regAlias neighbors classN classC
 = let	regAliasS regs	= unionManyUniqSets
 			$ map regAlias
			$ uniqSetToList regs

	-- all the regs in classes N, C
 	regsN		= regsOfClass classN
	regsC		= regsOfClass classC
	
	-- all the possible subsets of c which have size < m
	regsS		= filter (\s -> sizeUniqSet s >= 1 && sizeUniqSet s <= neighbors)
			$ powersetLS regsC

	-- for each of the subsets of C, the regs which conflict with posiblities for N
	regsS_conflict 
		= map (\s -> intersectUniqSets regsN (regAliasS s)) regsS

  in	maximum $ map sizeUniqSet $ regsS_conflict


-- | For a node N of classN and neighbors of classesC
--	(bound classN classesC) is the maximum number of potential 
--	colors for N that can be lost by coloring its neighbors.
--

bound 
	:: (RegClass 	-> UniqSet Reg)
	-> (Reg		-> UniqSet Reg)
	-> RegClass -> [RegClass] -> Int

bound regsOfClass regAlias classN classesC
 = let	regAliasS regs	= unionManyUniqSets
 			$ map regAlias
			$ uniqSetToList regs
 
 	regsC_aliases
		= unionManyUniqSets
		$ map (regAliasS . regsOfClass) classesC

	overlap	= intersectUniqSets (regsOfClass classN) regsC_aliases
   
   in	sizeUniqSet overlap


-- | The total squeese on a particular node with a list of neighbors.
--
--	A version of this should be constructed for each particular architecture,
--	possibly including uses of bound, so that alised registers don't get counted
--	twice, as per the paper.
--	
squeese 
	:: (RegClass	-> UniqSet Reg)
	-> (Reg		-> UniqSet Reg)
	-> RegClass -> [(Int, RegClass)] -> Int

squeese regsOfClass regAlias classN countCs
	= sum (map (\(i, classC) -> worst regsOfClass regAlias i classN classC) countCs)
	

-- | powerset (for lists)
powersetL :: [a] -> [[a]]
powersetL 	= map concat . mapM (\x -> [[],[x]])
	
-- | powersetLS (list of sets)
powersetLS :: Uniquable a => UniqSet a -> [UniqSet a]
powersetLS s	= map mkUniqSet $ powersetL $ uniqSetToList s

{-
-- | unions (for sets)
unionsS :: Ord a => Set (Set a) -> Set a
unionsS	ss 	= Set.unions $ Set.toList ss
-}