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