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