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