removing x87 register support from native code gen
[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 GhcPrelude
36
37 import CodeGen.Platform.SPARC
38 import Reg
39 import RegClass
40 import Format
41
42 import Unique
43 import Outputable
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 -- Calculate 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 -> Int
86
87 virtualRegSqueeze cls vr
88 = case cls of
89 RcInteger
90 -> case vr of
91 VirtualRegI{} -> 1
92 VirtualRegHi{} -> 1
93 _other -> 0
94
95 RcFloat
96 -> case vr of
97 VirtualRegF{} -> 1
98 VirtualRegD{} -> 2
99 _other -> 0
100
101 RcDouble
102 -> case vr of
103 VirtualRegF{} -> 1
104 VirtualRegD{} -> 1
105 _other -> 0
106
107
108 {-# INLINE realRegSqueeze #-}
109 realRegSqueeze :: RegClass -> RealReg -> Int
110
111 realRegSqueeze cls rr
112 = case cls of
113 RcInteger
114 -> case rr of
115 RealRegSingle regNo
116 | regNo < 32 -> 1
117 | otherwise -> 0
118
119 RealRegPair{} -> 0
120
121 RcFloat
122 -> case rr of
123 RealRegSingle regNo
124 | regNo < 32 -> 0
125 | otherwise -> 1
126
127 RealRegPair{} -> 2
128
129 RcDouble
130 -> case rr of
131 RealRegSingle regNo
132 | regNo < 32 -> 0
133 | otherwise -> 1
134
135 RealRegPair{} -> 1
136
137
138 -- | All the allocatable registers in the machine,
139 -- including register pairs.
140 allRealRegs :: [RealReg]
141 allRealRegs
142 = [ (RealRegSingle i) | i <- [0..63] ]
143 ++ [ (RealRegPair i (i+1)) | i <- [32, 34 .. 62 ] ]
144
145
146 -- | Get the regno for this sort of reg
147 gReg, lReg, iReg, oReg, fReg :: Int -> RegNo
148
149 gReg x = x -- global regs
150 oReg x = (8 + x) -- output regs
151 lReg x = (16 + x) -- local regs
152 iReg x = (24 + x) -- input regs
153 fReg x = (32 + x) -- float regs
154
155
156 -- | Some specific regs used by the code generator.
157 g0, g1, g2, fp, sp, o0, o1, f0, f1, f6, f8, f22, f26, f27 :: Reg
158
159 f6 = RegReal (RealRegSingle (fReg 6))
160 f8 = RegReal (RealRegSingle (fReg 8))
161 f22 = RegReal (RealRegSingle (fReg 22))
162 f26 = RegReal (RealRegSingle (fReg 26))
163 f27 = RegReal (RealRegSingle (fReg 27))
164
165 -- g0 is always zero, and writes to it vanish.
166 g0 = RegReal (RealRegSingle (gReg 0))
167 g1 = RegReal (RealRegSingle (gReg 1))
168 g2 = RegReal (RealRegSingle (gReg 2))
169
170 -- FP, SP, int and float return (from C) regs.
171 fp = RegReal (RealRegSingle (iReg 6))
172 sp = RegReal (RealRegSingle (oReg 6))
173 o0 = RegReal (RealRegSingle (oReg 0))
174 o1 = RegReal (RealRegSingle (oReg 1))
175 f0 = RegReal (RealRegSingle (fReg 0))
176 f1 = RegReal (RealRegSingle (fReg 1))
177
178 -- | Produce the second-half-of-a-double register given the first half.
179 {-
180 fPair :: Reg -> Maybe Reg
181 fPair (RealReg n)
182 | n >= 32 && n `mod` 2 == 0 = Just (RealReg (n+1))
183
184 fPair (VirtualRegD u)
185 = Just (VirtualRegHi u)
186
187 fPair reg
188 = trace ("MachInstrs.fPair: can't get high half of supposed double reg " ++ showPpr reg)
189 Nothing
190 -}
191
192
193 -- | All the regs that the register allocator can allocate to,
194 -- with the fixed use regs removed.
195 --
196 allocatableRegs :: [RealReg]
197 allocatableRegs
198 = let isFree rr
199 = case rr of
200 RealRegSingle r -> freeReg r
201 RealRegPair r1 r2 -> freeReg r1 && freeReg r2
202 in filter isFree allRealRegs
203
204
205 -- | The registers to place arguments for function calls,
206 -- for some number of arguments.
207 --
208 argRegs :: RegNo -> [Reg]
209 argRegs r
210 = case r of
211 0 -> []
212 1 -> map (RegReal . RealRegSingle . oReg) [0]
213 2 -> map (RegReal . RealRegSingle . oReg) [0,1]
214 3 -> map (RegReal . RealRegSingle . oReg) [0,1,2]
215 4 -> map (RegReal . RealRegSingle . oReg) [0,1,2,3]
216 5 -> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4]
217 6 -> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4,5]
218 _ -> panic "MachRegs.argRegs(sparc): don't know about >6 arguments!"
219
220
221 -- | All all the regs that could possibly be returned by argRegs
222 --
223 allArgRegs :: [Reg]
224 allArgRegs
225 = map (RegReal . RealRegSingle) [oReg i | i <- [0..5]]
226
227
228 -- These are the regs that we cannot assume stay alive over a C call.
229 -- TODO: Why can we assume that o6 isn't clobbered? -- BL 2009/02
230 --
231 callClobberedRegs :: [Reg]
232 callClobberedRegs
233 = map (RegReal . RealRegSingle)
234 ( oReg 7 :
235 [oReg i | i <- [0..5]] ++
236 [gReg i | i <- [1..7]] ++
237 [fReg i | i <- [0..31]] )
238
239
240
241 -- | Make a virtual reg with this format.
242 mkVirtualReg :: Unique -> Format -> VirtualReg
243 mkVirtualReg u format
244 | not (isFloatFormat format)
245 = VirtualRegI u
246
247 | otherwise
248 = case format of
249 FF32 -> VirtualRegF u
250 FF64 -> VirtualRegD u
251 _ -> panic "mkVReg"
252
253
254 regDotColor :: RealReg -> SDoc
255 regDotColor reg
256 = case classOfRealReg reg of
257 RcInteger -> text "blue"
258 RcFloat -> text "red"
259 _other -> text "green"