PPC NCG: Fix float parameter passing on 64-bit.
[ghc.git] / compiler / nativeGen / PPC / Regs.hs
1 {-# LANGUAGE CPP #-}
2
3 -- -----------------------------------------------------------------------------
4 --
5 -- (c) The University of Glasgow 1994-2004
6 --
7 -- -----------------------------------------------------------------------------
8
9 module PPC.Regs (
10 -- squeeze functions
11 virtualRegSqueeze,
12 realRegSqueeze,
13
14 mkVirtualReg,
15 regDotColor,
16
17 -- immediates
18 Imm(..),
19 strImmLit,
20 litToImm,
21
22 -- addressing modes
23 AddrMode(..),
24 addrOffset,
25
26 -- registers
27 spRel,
28 argRegs,
29 allArgRegs,
30 callClobberedRegs,
31 allMachRegNos,
32 classOfRealReg,
33 showReg,
34
35 -- machine specific
36 allFPArgRegs,
37 fits16Bits,
38 makeImmediate,
39 fReg,
40 r0, sp, toc, r3, r4, r11, r12, r27, r28, r30,
41 tmpReg,
42 f1, f20, f21,
43
44 allocatableRegs
45
46 )
47
48 where
49
50 #include "nativeGen/NCG.h"
51 #include "HsVersions.h"
52
53 import Reg
54 import RegClass
55 import Format
56
57 import Cmm
58 import CLabel ( CLabel )
59 import Unique
60
61 import CodeGen.Platform
62 import DynFlags
63 import Outputable
64 import Platform
65
66 import Data.Word ( Word8, Word16, Word32, Word64 )
67 import Data.Int ( Int8, Int16, Int32, Int64 )
68
69
70 -- squeese functions for the graph allocator -----------------------------------
71
72 -- | regSqueeze_class reg
73 -- Calculuate the maximum number of register colors that could be
74 -- denied to a node of this class due to having this reg
75 -- as a neighbour.
76 --
77 {-# INLINE virtualRegSqueeze #-}
78 virtualRegSqueeze :: RegClass -> VirtualReg -> Int
79 virtualRegSqueeze cls vr
80 = case cls of
81 RcInteger
82 -> case vr of
83 VirtualRegI{} -> 1
84 VirtualRegHi{} -> 1
85 _other -> 0
86
87 RcDouble
88 -> case vr of
89 VirtualRegD{} -> 1
90 VirtualRegF{} -> 0
91 _other -> 0
92
93 _other -> 0
94
95 {-# INLINE realRegSqueeze #-}
96 realRegSqueeze :: RegClass -> RealReg -> Int
97 realRegSqueeze cls rr
98 = case cls of
99 RcInteger
100 -> case rr of
101 RealRegSingle regNo
102 | regNo < 32 -> 1 -- first fp reg is 32
103 | otherwise -> 0
104
105 RealRegPair{} -> 0
106
107 RcDouble
108 -> case rr of
109 RealRegSingle regNo
110 | regNo < 32 -> 0
111 | otherwise -> 1
112
113 RealRegPair{} -> 0
114
115 _other -> 0
116
117 mkVirtualReg :: Unique -> Format -> VirtualReg
118 mkVirtualReg u format
119 | not (isFloatFormat format) = VirtualRegI u
120 | otherwise
121 = case format of
122 FF32 -> VirtualRegD u
123 FF64 -> VirtualRegD u
124 _ -> panic "mkVirtualReg"
125
126 regDotColor :: RealReg -> SDoc
127 regDotColor reg
128 = case classOfRealReg reg of
129 RcInteger -> text "blue"
130 RcFloat -> text "red"
131 RcDouble -> text "green"
132 RcDoubleSSE -> text "yellow"
133
134
135 -- immediates ------------------------------------------------------------------
136 data Imm
137 = ImmInt Int
138 | ImmInteger Integer -- Sigh.
139 | ImmCLbl CLabel -- AbstractC Label (with baggage)
140 | ImmLit SDoc -- Simple string
141 | ImmIndex CLabel Int
142 | ImmFloat Rational
143 | ImmDouble Rational
144 | ImmConstantSum Imm Imm
145 | ImmConstantDiff Imm Imm
146 | LO Imm
147 | HI Imm
148 | HA Imm {- high halfword adjusted -}
149 | HIGHERA Imm
150 | HIGHESTA Imm
151
152
153 strImmLit :: String -> Imm
154 strImmLit s = ImmLit (text s)
155
156
157 litToImm :: CmmLit -> Imm
158 litToImm (CmmInt i w) = ImmInteger (narrowS w i)
159 -- narrow to the width: a CmmInt might be out of
160 -- range, but we assume that ImmInteger only contains
161 -- in-range values. A signed value should be fine here.
162 litToImm (CmmFloat f W32) = ImmFloat f
163 litToImm (CmmFloat f W64) = ImmDouble f
164 litToImm (CmmLabel l) = ImmCLbl l
165 litToImm (CmmLabelOff l off) = ImmIndex l off
166 litToImm (CmmLabelDiffOff l1 l2 off)
167 = ImmConstantSum
168 (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
169 (ImmInt off)
170 litToImm _ = panic "PPC.Regs.litToImm: no match"
171
172
173 -- addressing modes ------------------------------------------------------------
174
175 data AddrMode
176 = AddrRegReg Reg Reg
177 | AddrRegImm Reg Imm
178
179
180 addrOffset :: AddrMode -> Int -> Maybe AddrMode
181 addrOffset addr off
182 = case addr of
183 AddrRegImm r (ImmInt n)
184 | fits16Bits n2 -> Just (AddrRegImm r (ImmInt n2))
185 | otherwise -> Nothing
186 where n2 = n + off
187
188 AddrRegImm r (ImmInteger n)
189 | fits16Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
190 | otherwise -> Nothing
191 where n2 = n + toInteger off
192
193 _ -> Nothing
194
195
196 -- registers -------------------------------------------------------------------
197 -- @spRel@ gives us a stack relative addressing mode for volatile
198 -- temporaries and for excess call arguments. @fpRel@, where
199 -- applicable, is the same but for the frame pointer.
200
201 spRel :: DynFlags
202 -> Int -- desired stack offset in words, positive or negative
203 -> AddrMode
204
205 spRel dflags n = AddrRegImm sp (ImmInt (n * wORD_SIZE dflags))
206
207
208 -- argRegs is the set of regs which are read for an n-argument call to C.
209 -- For archs which pass all args on the stack (x86), is empty.
210 -- Sparc passes up to the first 6 args in regs.
211 argRegs :: RegNo -> [Reg]
212 argRegs 0 = []
213 argRegs 1 = map regSingle [3]
214 argRegs 2 = map regSingle [3,4]
215 argRegs 3 = map regSingle [3..5]
216 argRegs 4 = map regSingle [3..6]
217 argRegs 5 = map regSingle [3..7]
218 argRegs 6 = map regSingle [3..8]
219 argRegs 7 = map regSingle [3..9]
220 argRegs 8 = map regSingle [3..10]
221 argRegs _ = panic "MachRegs.argRegs(powerpc): don't know about >8 arguments!"
222
223
224 allArgRegs :: [Reg]
225 allArgRegs = map regSingle [3..10]
226
227
228 -- these are the regs which we cannot assume stay alive over a C call.
229 callClobberedRegs :: Platform -> [Reg]
230 callClobberedRegs platform
231 = case platformOS platform of
232 OSAIX -> map regSingle (0:[2..12] ++ map fReg [0..13])
233 OSDarwin -> map regSingle (0:[2..12] ++ map fReg [0..13])
234 OSLinux -> map regSingle (0:[2..13] ++ map fReg [0..13])
235 _ -> panic "PPC.Regs.callClobberedRegs: not defined for this architecture"
236
237
238 allMachRegNos :: [RegNo]
239 allMachRegNos = [0..63]
240
241
242 {-# INLINE classOfRealReg #-}
243 classOfRealReg :: RealReg -> RegClass
244 classOfRealReg (RealRegSingle i)
245 | i < 32 = RcInteger
246 | otherwise = RcDouble
247
248 classOfRealReg (RealRegPair{})
249 = panic "regClass(ppr): no reg pairs on this architecture"
250
251 showReg :: RegNo -> String
252 showReg n
253 | n >= 0 && n <= 31 = "%r" ++ show n
254 | n >= 32 && n <= 63 = "%f" ++ show (n - 32)
255 | otherwise = "%unknown_powerpc_real_reg_" ++ show n
256
257
258
259 -- machine specific ------------------------------------------------------------
260
261 allFPArgRegs :: Platform -> [Reg]
262 allFPArgRegs platform
263 = case platformOS platform of
264 OSAIX -> map (regSingle . fReg) [1..13]
265 OSDarwin -> map (regSingle . fReg) [1..13]
266 OSLinux -> case platformArch platform of
267 ArchPPC -> map (regSingle . fReg) [1..8]
268 ArchPPC_64 _ -> map (regSingle . fReg) [1..13]
269 _ -> panic "PPC.Regs.allFPArgRegs: unknown PPC Linux"
270 _ -> panic "PPC.Regs.allFPArgRegs: not defined for this architecture"
271
272 fits16Bits :: Integral a => a -> Bool
273 fits16Bits x = x >= -32768 && x < 32768
274
275 makeImmediate :: Integral a => Width -> Bool -> a -> Maybe Imm
276 makeImmediate rep signed x = fmap ImmInt (toI16 rep signed)
277 where
278 narrow W64 False = fromIntegral (fromIntegral x :: Word64)
279 narrow W32 False = fromIntegral (fromIntegral x :: Word32)
280 narrow W16 False = fromIntegral (fromIntegral x :: Word16)
281 narrow W8 False = fromIntegral (fromIntegral x :: Word8)
282 narrow W64 True = fromIntegral (fromIntegral x :: Int64)
283 narrow W32 True = fromIntegral (fromIntegral x :: Int32)
284 narrow W16 True = fromIntegral (fromIntegral x :: Int16)
285 narrow W8 True = fromIntegral (fromIntegral x :: Int8)
286 narrow _ _ = panic "PPC.Regs.narrow: no match"
287
288 narrowed = narrow rep signed
289
290 toI16 W32 True
291 | narrowed >= -32768 && narrowed < 32768 = Just narrowed
292 | otherwise = Nothing
293 toI16 W32 False
294 | narrowed >= 0 && narrowed < 65536 = Just narrowed
295 | otherwise = Nothing
296 toI16 W64 True
297 | narrowed >= -32768 && narrowed < 32768 = Just narrowed
298 | otherwise = Nothing
299 toI16 W64 False
300 | narrowed >= 0 && narrowed < 65536 = Just narrowed
301 | otherwise = Nothing
302 toI16 _ _ = Just narrowed
303
304
305 {-
306 The PowerPC has 64 registers of interest; 32 integer registers and 32 floating
307 point registers.
308 -}
309
310 fReg :: Int -> RegNo
311 fReg x = (32 + x)
312
313 r0, sp, toc, r3, r4, r11, r12, r27, r28, r30, f1, f20, f21 :: Reg
314 r0 = regSingle 0
315 sp = regSingle 1
316 toc = regSingle 2
317 r3 = regSingle 3
318 r4 = regSingle 4
319 r11 = regSingle 11
320 r12 = regSingle 12
321 r27 = regSingle 27
322 r28 = regSingle 28
323 r30 = regSingle 30
324 f1 = regSingle $ fReg 1
325 f20 = regSingle $ fReg 20
326 f21 = regSingle $ fReg 21
327
328 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
329 -- i.e., these are the regs for which we are prepared to allow the
330 -- register allocator to attempt to map VRegs to.
331 allocatableRegs :: Platform -> [RealReg]
332 allocatableRegs platform
333 = let isFree i = freeReg platform i
334 in map RealRegSingle $ filter isFree allMachRegNos
335
336 -- temporary register for compiler use
337 tmpReg :: Platform -> Reg
338 tmpReg platform =
339 case platformArch platform of
340 ArchPPC -> regSingle 13
341 ArchPPC_64 _ -> regSingle 30
342 _ -> panic "PPC.Regs.tmpReg: unknowm arch"