never executed always true always false
1 -- -----------------------------------------------------------------------------
2 --
3 -- (c) The University of Glasgow 1994-2004
4 --
5 -- -----------------------------------------------------------------------------
6
7 module GHC.CmmToAsm.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 toRegNo,
33
34 -- machine specific
35 allFPArgRegs,
36 fits16Bits,
37 makeImmediate,
38 fReg,
39 r0, sp, toc, r3, r4, r11, r12, r30,
40 tmpReg,
41 f1,
42
43 allocatableRegs
44
45 )
46
47 where
48
49 import GHC.Prelude
50
51 import GHC.Platform.Reg
52 import GHC.Platform.Reg.Class
53 import GHC.CmmToAsm.Format
54
55 import GHC.Cmm
56 import GHC.Cmm.CLabel ( CLabel )
57 import GHC.Types.Unique
58
59 import GHC.Platform.Regs
60 import GHC.Utils.Outputable
61 import GHC.Utils.Panic
62 import GHC.Platform
63
64 import Data.Word ( Word8, Word16, Word32, Word64 )
65 import Data.Int ( Int8, Int16, Int32, Int64 )
66
67
68 -- squeese functions for the graph allocator -----------------------------------
69
70 -- | regSqueeze_class reg
71 -- Calculate 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 -> Int
77 virtualRegSqueeze cls vr
78 = case cls of
79 RcInteger
80 -> case vr of
81 VirtualRegI{} -> 1
82 VirtualRegHi{} -> 1
83 _other -> 0
84
85 RcDouble
86 -> case vr of
87 VirtualRegD{} -> 1
88 VirtualRegF{} -> 0
89 _other -> 0
90
91 _other -> 0
92
93 {-# INLINE realRegSqueeze #-}
94 realRegSqueeze :: RegClass -> RealReg -> Int
95 realRegSqueeze cls rr
96 = case cls of
97 RcInteger
98 -> case rr of
99 RealRegSingle regNo
100 | regNo < 32 -> 1 -- first fp reg is 32
101 | otherwise -> 0
102
103 RealRegPair{} -> 0
104
105 RcDouble
106 -> case rr of
107 RealRegSingle regNo
108 | regNo < 32 -> 0
109 | otherwise -> 1
110
111 RealRegPair{} -> 0
112
113 _other -> 0
114
115 mkVirtualReg :: Unique -> Format -> VirtualReg
116 mkVirtualReg u format
117 | not (isFloatFormat format) = VirtualRegI u
118 | otherwise
119 = case format 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
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 | HIGHERA Imm
148 | HIGHESTA Imm
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 :: Platform
200 -> Int -- desired stack offset in words, positive or negative
201 -> AddrMode
202
203 spRel platform n = AddrRegImm sp (ImmInt (n * platformWordSizeInBytes platform))
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 = map regSingle (0:[2..12] ++ map fReg [0..13])
230
231
232 allMachRegNos :: [RegNo]
233 allMachRegNos = [0..63]
234
235
236 {-# INLINE classOfRealReg #-}
237 classOfRealReg :: RealReg -> RegClass
238 classOfRealReg (RealRegSingle i)
239 | i < 32 = RcInteger
240 | otherwise = RcDouble
241
242 classOfRealReg (RealRegPair{})
243 = panic "regClass(ppr): no reg pairs on this architecture"
244
245 showReg :: RegNo -> String
246 showReg n
247 | n >= 0 && n <= 31 = "%r" ++ show n
248 | n >= 32 && n <= 63 = "%f" ++ show (n - 32)
249 | otherwise = "%unknown_powerpc_real_reg_" ++ show n
250
251 toRegNo :: Reg -> RegNo
252 toRegNo (RegReal (RealRegSingle n)) = n
253 toRegNo _ = panic "PPC.toRegNo: unsupported register"
254
255 -- machine specific ------------------------------------------------------------
256
257 allFPArgRegs :: Platform -> [Reg]
258 allFPArgRegs platform
259 = case platformOS platform of
260 OSAIX -> map (regSingle . fReg) [1..13]
261 _ -> case platformArch platform of
262 ArchPPC -> map (regSingle . fReg) [1..8]
263 ArchPPC_64 _ -> map (regSingle . fReg) [1..13]
264 _ -> panic "PPC.Regs.allFPArgRegs: unknown PPC Linux"
265
266 fits16Bits :: Integral a => a -> Bool
267 fits16Bits x = x >= -32768 && x < 32768
268
269 makeImmediate :: Integral a => Width -> Bool -> a -> Maybe Imm
270 makeImmediate rep signed x = fmap ImmInt (toI16 rep signed)
271 where
272 narrow W64 False = fromIntegral (fromIntegral x :: Word64)
273 narrow W32 False = fromIntegral (fromIntegral x :: Word32)
274 narrow W16 False = fromIntegral (fromIntegral x :: Word16)
275 narrow W8 False = fromIntegral (fromIntegral x :: Word8)
276 narrow W64 True = fromIntegral (fromIntegral x :: Int64)
277 narrow W32 True = fromIntegral (fromIntegral x :: Int32)
278 narrow W16 True = fromIntegral (fromIntegral x :: Int16)
279 narrow W8 True = fromIntegral (fromIntegral x :: Int8)
280 narrow _ _ = panic "PPC.Regs.narrow: no match"
281
282 narrowed = narrow rep signed
283
284 toI16 W32 True
285 | narrowed >= -32768 && narrowed < 32768 = Just narrowed
286 | otherwise = Nothing
287 toI16 W32 False
288 | narrowed >= 0 && narrowed < 65536 = Just narrowed
289 | otherwise = Nothing
290 toI16 W64 True
291 | narrowed >= -32768 && narrowed < 32768 = Just narrowed
292 | otherwise = Nothing
293 toI16 W64 False
294 | narrowed >= 0 && narrowed < 65536 = Just narrowed
295 | otherwise = Nothing
296 toI16 _ _ = Just narrowed
297
298
299 {-
300 The PowerPC has 64 registers of interest; 32 integer registers and 32 floating
301 point registers.
302 -}
303
304 fReg :: Int -> RegNo
305 fReg x = (32 + x)
306
307 r0, sp, toc, r3, r4, r11, r12, r30, f1 :: Reg
308 r0 = regSingle 0
309 sp = regSingle 1
310 toc = regSingle 2
311 r3 = regSingle 3
312 r4 = regSingle 4
313 r11 = regSingle 11
314 r12 = regSingle 12
315 r30 = regSingle 30
316 f1 = regSingle $ fReg 1
317
318 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
319 -- i.e., these are the regs for which we are prepared to allow the
320 -- register allocator to attempt to map VRegs to.
321 allocatableRegs :: Platform -> [RealReg]
322 allocatableRegs platform
323 = let isFree i = freeReg platform i
324 in map RealRegSingle $ filter isFree allMachRegNos
325
326 -- temporary register for compiler use
327 tmpReg :: Platform -> Reg
328 tmpReg platform =
329 case platformArch platform of
330 ArchPPC -> regSingle 13
331 ArchPPC_64 _ -> regSingle 30
332 _ -> panic "PPC.Regs.tmpReg: unknown arch"