Add LANGUAGE pragmas to compiler/ source files
[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, r3, r4, r27, r28, f1, f20, f21,
41
42 allocatableRegs
43
44 )
45
46 where
47
48 #include "nativeGen/NCG.h"
49 #include "HsVersions.h"
50
51 import Reg
52 import RegClass
53 import Size
54
55 import Cmm
56 import CLabel ( CLabel )
57 import Unique
58
59 import CodeGen.Platform
60 import DynFlags
61 import Outputable
62 import FastBool
63 import FastTypes
64 import Platform
65
66 import Data.Word ( Word8, Word16, Word32 )
67 import Data.Int ( Int8, Int16, Int32 )
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 -> FastInt
79 virtualRegSqueeze cls vr
80 = case cls of
81 RcInteger
82 -> case vr of
83 VirtualRegI{} -> _ILIT(1)
84 VirtualRegHi{} -> _ILIT(1)
85 _other -> _ILIT(0)
86
87 RcDouble
88 -> case vr of
89 VirtualRegD{} -> _ILIT(1)
90 VirtualRegF{} -> _ILIT(0)
91 _other -> _ILIT(0)
92
93 _other -> _ILIT(0)
94
95 {-# INLINE realRegSqueeze #-}
96 realRegSqueeze :: RegClass -> RealReg -> FastInt
97 realRegSqueeze cls rr
98 = case cls of
99 RcInteger
100 -> case rr of
101 RealRegSingle regNo
102 | regNo < 32 -> _ILIT(1) -- first fp reg is 32
103 | otherwise -> _ILIT(0)
104
105 RealRegPair{} -> _ILIT(0)
106
107 RcDouble
108 -> case rr of
109 RealRegSingle regNo
110 | regNo < 32 -> _ILIT(0)
111 | otherwise -> _ILIT(1)
112
113 RealRegPair{} -> _ILIT(0)
114
115 _other -> _ILIT(0)
116
117 mkVirtualReg :: Unique -> Size -> VirtualReg
118 mkVirtualReg u size
119 | not (isFloatSize size) = VirtualRegI u
120 | otherwise
121 = case size 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
150
151 strImmLit :: String -> Imm
152 strImmLit s = ImmLit (text s)
153
154
155 litToImm :: CmmLit -> Imm
156 litToImm (CmmInt i w) = ImmInteger (narrowS w i)
157 -- narrow to the width: a CmmInt might be out of
158 -- range, but we assume that ImmInteger only contains
159 -- in-range values. A signed value should be fine here.
160 litToImm (CmmFloat f W32) = ImmFloat f
161 litToImm (CmmFloat f W64) = ImmDouble f
162 litToImm (CmmLabel l) = ImmCLbl l
163 litToImm (CmmLabelOff l off) = ImmIndex l off
164 litToImm (CmmLabelDiffOff l1 l2 off)
165 = ImmConstantSum
166 (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
167 (ImmInt off)
168 litToImm _ = panic "PPC.Regs.litToImm: no match"
169
170
171 -- addressing modes ------------------------------------------------------------
172
173 data AddrMode
174 = AddrRegReg Reg Reg
175 | AddrRegImm Reg Imm
176
177
178 addrOffset :: AddrMode -> Int -> Maybe AddrMode
179 addrOffset addr off
180 = case addr of
181 AddrRegImm r (ImmInt n)
182 | fits16Bits n2 -> Just (AddrRegImm r (ImmInt n2))
183 | otherwise -> Nothing
184 where n2 = n + off
185
186 AddrRegImm r (ImmInteger n)
187 | fits16Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
188 | otherwise -> Nothing
189 where n2 = n + toInteger off
190
191 _ -> Nothing
192
193
194 -- registers -------------------------------------------------------------------
195 -- @spRel@ gives us a stack relative addressing mode for volatile
196 -- temporaries and for excess call arguments. @fpRel@, where
197 -- applicable, is the same but for the frame pointer.
198
199 spRel :: DynFlags
200 -> Int -- desired stack offset in words, positive or negative
201 -> AddrMode
202
203 spRel dflags n = AddrRegImm sp (ImmInt (n * wORD_SIZE dflags))
204
205
206 -- argRegs is the set of regs which are read for an n-argument call to C.
207 -- For archs which pass all args on the stack (x86), is empty.
208 -- Sparc passes up to the first 6 args in regs.
209 argRegs :: RegNo -> [Reg]
210 argRegs 0 = []
211 argRegs 1 = map regSingle [3]
212 argRegs 2 = map regSingle [3,4]
213 argRegs 3 = map regSingle [3..5]
214 argRegs 4 = map regSingle [3..6]
215 argRegs 5 = map regSingle [3..7]
216 argRegs 6 = map regSingle [3..8]
217 argRegs 7 = map regSingle [3..9]
218 argRegs 8 = map regSingle [3..10]
219 argRegs _ = panic "MachRegs.argRegs(powerpc): don't know about >8 arguments!"
220
221
222 allArgRegs :: [Reg]
223 allArgRegs = map regSingle [3..10]
224
225
226 -- these are the regs which we cannot assume stay alive over a C call.
227 callClobberedRegs :: Platform -> [Reg]
228 callClobberedRegs platform
229 = case platformOS platform of
230 OSDarwin -> map regSingle (0:[2..12] ++ map fReg [0..13])
231 OSLinux -> map regSingle (0:[2..13] ++ map fReg [0..13])
232 _ -> panic "PPC.Regs.callClobberedRegs: not defined for this architecture"
233
234
235 allMachRegNos :: [RegNo]
236 allMachRegNos = [0..63]
237
238
239 {-# INLINE classOfRealReg #-}
240 classOfRealReg :: RealReg -> RegClass
241 classOfRealReg (RealRegSingle i)
242 | i < 32 = RcInteger
243 | otherwise = RcDouble
244
245 classOfRealReg (RealRegPair{})
246 = panic "regClass(ppr): no reg pairs on this architecture"
247
248 showReg :: RegNo -> String
249 showReg n
250 | n >= 0 && n <= 31 = "%r" ++ show n
251 | n >= 32 && n <= 63 = "%f" ++ show (n - 32)
252 | otherwise = "%unknown_powerpc_real_reg_" ++ show n
253
254
255
256 -- machine specific ------------------------------------------------------------
257
258 allFPArgRegs :: Platform -> [Reg]
259 allFPArgRegs platform
260 = case platformOS platform of
261 OSDarwin -> map (regSingle . fReg) [1..13]
262 OSLinux -> map (regSingle . fReg) [1..8]
263 _ -> panic "PPC.Regs.allFPArgRegs: not defined for this architecture"
264
265 fits16Bits :: Integral a => a -> Bool
266 fits16Bits x = x >= -32768 && x < 32768
267
268 makeImmediate :: Integral a => Width -> Bool -> a -> Maybe Imm
269 makeImmediate rep signed x = fmap ImmInt (toI16 rep signed)
270 where
271 narrow W32 False = fromIntegral (fromIntegral x :: Word32)
272 narrow W16 False = fromIntegral (fromIntegral x :: Word16)
273 narrow W8 False = fromIntegral (fromIntegral x :: Word8)
274 narrow W32 True = fromIntegral (fromIntegral x :: Int32)
275 narrow W16 True = fromIntegral (fromIntegral x :: Int16)
276 narrow W8 True = fromIntegral (fromIntegral x :: Int8)
277 narrow _ _ = panic "PPC.Regs.narrow: no match"
278
279 narrowed = narrow rep signed
280
281 toI16 W32 True
282 | narrowed >= -32768 && narrowed < 32768 = Just narrowed
283 | otherwise = Nothing
284 toI16 W32 False
285 | narrowed >= 0 && narrowed < 65536 = Just narrowed
286 | otherwise = Nothing
287 toI16 _ _ = Just narrowed
288
289
290 {-
291 The PowerPC has 64 registers of interest; 32 integer registers and 32 floating
292 point registers.
293 -}
294
295 fReg :: Int -> RegNo
296 fReg x = (32 + x)
297
298 sp, r3, r4, r27, r28, f1, f20, f21 :: Reg
299 sp = regSingle 1
300 r3 = regSingle 3
301 r4 = regSingle 4
302 r27 = regSingle 27
303 r28 = regSingle 28
304 f1 = regSingle $ fReg 1
305 f20 = regSingle $ fReg 20
306 f21 = regSingle $ fReg 21
307
308 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
309 -- i.e., these are the regs for which we are prepared to allow the
310 -- register allocator to attempt to map VRegs to.
311 allocatableRegs :: Platform -> [RealReg]
312 allocatableRegs platform
313 = let isFree i = isFastTrue (freeReg platform i)
314 in map RealRegSingle $ filter isFree allMachRegNos