Fix todo in compiler/nativeGen: Rename Size to Format
[ghc.git] / compiler / nativeGen / SPARC / Regs.hs
1 -- -----------------------------------------------------------------------------
2 --
3 -- (c) The University of Glasgow 1994-2004
4 --
5 -- -----------------------------------------------------------------------------
6
7 module SPARC.Regs (
8 -- registers
9 showReg,
10 virtualRegSqueeze,
11 realRegSqueeze,
12 classOfRealReg,
13 allRealRegs,
14
15 -- machine specific info
16 gReg, iReg, lReg, oReg, fReg,
17 fp, sp, g0, g1, g2, o0, o1, f0, f1, f6, f8, f22, f26, f27,
18
19 -- allocatable
20 allocatableRegs,
21
22 -- args
23 argRegs,
24 allArgRegs,
25 callClobberedRegs,
26
27 --
28 mkVirtualReg,
29 regDotColor
30 )
31
32 where
33
34
35 import CodeGen.Platform.SPARC
36 import Reg
37 import RegClass
38 import Format
39
40 import Unique
41 import Outputable
42 import FastTypes
43 import FastBool
44
45 {-
46 The SPARC has 64 registers of interest; 32 integer registers and 32
47 floating point registers. The mapping of STG registers to SPARC
48 machine registers is defined in StgRegs.h. We are, of course,
49 prepared for any eventuality.
50
51 The whole fp-register pairing thing on sparcs is a huge nuisance. See
52 includes/stg/MachRegs.h for a description of what's going on
53 here.
54 -}
55
56
57 -- | Get the standard name for the register with this number.
58 showReg :: RegNo -> String
59 showReg n
60 | n >= 0 && n < 8 = "%g" ++ show n
61 | n >= 8 && n < 16 = "%o" ++ show (n-8)
62 | n >= 16 && n < 24 = "%l" ++ show (n-16)
63 | n >= 24 && n < 32 = "%i" ++ show (n-24)
64 | n >= 32 && n < 64 = "%f" ++ show (n-32)
65 | otherwise = panic "SPARC.Regs.showReg: unknown sparc register"
66
67
68 -- Get the register class of a certain real reg
69 classOfRealReg :: RealReg -> RegClass
70 classOfRealReg reg
71 = case reg of
72 RealRegSingle i
73 | i < 32 -> RcInteger
74 | otherwise -> RcFloat
75
76 RealRegPair{} -> RcDouble
77
78
79 -- | regSqueeze_class reg
80 -- Calculuate the maximum number of register colors that could be
81 -- denied to a node of this class due to having this reg
82 -- as a neighbour.
83 --
84 {-# INLINE virtualRegSqueeze #-}
85 virtualRegSqueeze :: RegClass -> VirtualReg -> FastInt
86
87 virtualRegSqueeze cls vr
88 = case cls of
89 RcInteger
90 -> case vr of
91 VirtualRegI{} -> _ILIT(1)
92 VirtualRegHi{} -> _ILIT(1)
93 _other -> _ILIT(0)
94
95 RcFloat
96 -> case vr of
97 VirtualRegF{} -> _ILIT(1)
98 VirtualRegD{} -> _ILIT(2)
99 _other -> _ILIT(0)
100
101 RcDouble
102 -> case vr of
103 VirtualRegF{} -> _ILIT(1)
104 VirtualRegD{} -> _ILIT(1)
105 _other -> _ILIT(0)
106
107 _other -> _ILIT(0)
108
109 {-# INLINE realRegSqueeze #-}
110 realRegSqueeze :: RegClass -> RealReg -> FastInt
111
112 realRegSqueeze cls rr
113 = case cls of
114 RcInteger
115 -> case rr of
116 RealRegSingle regNo
117 | regNo < 32 -> _ILIT(1)
118 | otherwise -> _ILIT(0)
119
120 RealRegPair{} -> _ILIT(0)
121
122 RcFloat
123 -> case rr of
124 RealRegSingle regNo
125 | regNo < 32 -> _ILIT(0)
126 | otherwise -> _ILIT(1)
127
128 RealRegPair{} -> _ILIT(2)
129
130 RcDouble
131 -> case rr of
132 RealRegSingle regNo
133 | regNo < 32 -> _ILIT(0)
134 | otherwise -> _ILIT(1)
135
136 RealRegPair{} -> _ILIT(1)
137
138 _other -> _ILIT(0)
139
140 -- | All the allocatable registers in the machine,
141 -- including register pairs.
142 allRealRegs :: [RealReg]
143 allRealRegs
144 = [ (RealRegSingle i) | i <- [0..63] ]
145 ++ [ (RealRegPair i (i+1)) | i <- [32, 34 .. 62 ] ]
146
147
148 -- | Get the regno for this sort of reg
149 gReg, lReg, iReg, oReg, fReg :: Int -> RegNo
150
151 gReg x = x -- global regs
152 oReg x = (8 + x) -- output regs
153 lReg x = (16 + x) -- local regs
154 iReg x = (24 + x) -- input regs
155 fReg x = (32 + x) -- float regs
156
157
158 -- | Some specific regs used by the code generator.
159 g0, g1, g2, fp, sp, o0, o1, f0, f1, f6, f8, f22, f26, f27 :: Reg
160
161 f6 = RegReal (RealRegSingle (fReg 6))
162 f8 = RegReal (RealRegSingle (fReg 8))
163 f22 = RegReal (RealRegSingle (fReg 22))
164 f26 = RegReal (RealRegSingle (fReg 26))
165 f27 = RegReal (RealRegSingle (fReg 27))
166
167 -- g0 is always zero, and writes to it vanish.
168 g0 = RegReal (RealRegSingle (gReg 0))
169 g1 = RegReal (RealRegSingle (gReg 1))
170 g2 = RegReal (RealRegSingle (gReg 2))
171
172 -- FP, SP, int and float return (from C) regs.
173 fp = RegReal (RealRegSingle (iReg 6))
174 sp = RegReal (RealRegSingle (oReg 6))
175 o0 = RegReal (RealRegSingle (oReg 0))
176 o1 = RegReal (RealRegSingle (oReg 1))
177 f0 = RegReal (RealRegSingle (fReg 0))
178 f1 = RegReal (RealRegSingle (fReg 1))
179
180 -- | Produce the second-half-of-a-double register given the first half.
181 {-
182 fPair :: Reg -> Maybe Reg
183 fPair (RealReg n)
184 | n >= 32 && n `mod` 2 == 0 = Just (RealReg (n+1))
185
186 fPair (VirtualRegD u)
187 = Just (VirtualRegHi u)
188
189 fPair reg
190 = trace ("MachInstrs.fPair: can't get high half of supposed double reg " ++ showPpr reg)
191 Nothing
192 -}
193
194
195 -- | All the regs that the register allocator can allocate to,
196 -- with the the fixed use regs removed.
197 --
198 allocatableRegs :: [RealReg]
199 allocatableRegs
200 = let isFree rr
201 = case rr of
202 RealRegSingle r
203 -> isFastTrue (freeReg r)
204
205 RealRegPair r1 r2
206 -> isFastTrue (freeReg r1)
207 && isFastTrue (freeReg r2)
208
209 in filter isFree allRealRegs
210
211
212 -- | The registers to place arguments for function calls,
213 -- for some number of arguments.
214 --
215 argRegs :: RegNo -> [Reg]
216 argRegs r
217 = case r of
218 0 -> []
219 1 -> map (RegReal . RealRegSingle . oReg) [0]
220 2 -> map (RegReal . RealRegSingle . oReg) [0,1]
221 3 -> map (RegReal . RealRegSingle . oReg) [0,1,2]
222 4 -> map (RegReal . RealRegSingle . oReg) [0,1,2,3]
223 5 -> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4]
224 6 -> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4,5]
225 _ -> panic "MachRegs.argRegs(sparc): don't know about >6 arguments!"
226
227
228 -- | All all the regs that could possibly be returned by argRegs
229 --
230 allArgRegs :: [Reg]
231 allArgRegs
232 = map (RegReal . RealRegSingle) [oReg i | i <- [0..5]]
233
234
235 -- These are the regs that we cannot assume stay alive over a C call.
236 -- TODO: Why can we assume that o6 isn't clobbered? -- BL 2009/02
237 --
238 callClobberedRegs :: [Reg]
239 callClobberedRegs
240 = map (RegReal . RealRegSingle)
241 ( oReg 7 :
242 [oReg i | i <- [0..5]] ++
243 [gReg i | i <- [1..7]] ++
244 [fReg i | i <- [0..31]] )
245
246
247
248 -- | Make a virtual reg with this format.
249 mkVirtualReg :: Unique -> Format -> VirtualReg
250 mkVirtualReg u format
251 | not (isFloatFormat format)
252 = VirtualRegI u
253
254 | otherwise
255 = case format of
256 FF32 -> VirtualRegF u
257 FF64 -> VirtualRegD u
258 _ -> panic "mkVReg"
259
260
261 regDotColor :: RealReg -> SDoc
262 regDotColor reg
263 = case classOfRealReg reg of
264 RcInteger -> text "blue"
265 RcFloat -> text "red"
266 _other -> text "green"