PPC NCG: Use liveness information in CmmCall
[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, r30,
41 tmpReg,
42 f1,
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 = map regSingle (0:[2..12] ++ map fReg [0..13])
234
235
236 allMachRegNos :: [RegNo]
237 allMachRegNos = [0..63]
238
239
240 {-# INLINE classOfRealReg #-}
241 classOfRealReg :: RealReg -> RegClass
242 classOfRealReg (RealRegSingle i)
243 | i < 32 = RcInteger
244 | otherwise = RcDouble
245
246 classOfRealReg (RealRegPair{})
247 = panic "regClass(ppr): no reg pairs on this architecture"
248
249 showReg :: RegNo -> String
250 showReg n
251 | n >= 0 && n <= 31 = "%r" ++ show n
252 | n >= 32 && n <= 63 = "%f" ++ show (n - 32)
253 | otherwise = "%unknown_powerpc_real_reg_" ++ show n
254
255
256
257 -- machine specific ------------------------------------------------------------
258
259 allFPArgRegs :: Platform -> [Reg]
260 allFPArgRegs platform
261 = case platformOS platform of
262 OSAIX -> map (regSingle . fReg) [1..13]
263 _ -> case platformArch platform of
264 ArchPPC -> map (regSingle . fReg) [1..8]
265 ArchPPC_64 _ -> map (regSingle . fReg) [1..13]
266 _ -> panic "PPC.Regs.allFPArgRegs: unknown PPC Linux"
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 r0, sp, toc, r3, r4, r11, r12, r30, f1 :: Reg
310 r0 = regSingle 0
311 sp = regSingle 1
312 toc = regSingle 2
313 r3 = regSingle 3
314 r4 = regSingle 4
315 r11 = regSingle 11
316 r12 = regSingle 12
317 r30 = regSingle 30
318 f1 = regSingle $ fReg 1
319
320 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
321 -- i.e., these are the regs for which we are prepared to allow the
322 -- register allocator to attempt to map VRegs to.
323 allocatableRegs :: Platform -> [RealReg]
324 allocatableRegs platform
325 = let isFree i = freeReg platform i
326 in map RealRegSingle $ filter isFree allMachRegNos
327
328 -- temporary register for compiler use
329 tmpReg :: Platform -> Reg
330 tmpReg platform =
331 case platformArch platform of
332 ArchPPC -> regSingle 13
333 ArchPPC_64 _ -> regSingle 30
334 _ -> panic "PPC.Regs.tmpReg: unknown arch"