powerpc: fix and enable shared libraries by default on linux
[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, 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 )
68 import Data.Int ( Int8, Int16, Int32 )
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
151
152 strImmLit :: String -> Imm
153 strImmLit s = ImmLit (text s)
154
155
156 litToImm :: CmmLit -> Imm
157 litToImm (CmmInt i w) = ImmInteger (narrowS w i)
158 -- narrow to the width: a CmmInt might be out of
159 -- range, but we assume that ImmInteger only contains
160 -- in-range values. A signed value should be fine here.
161 litToImm (CmmFloat f W32) = ImmFloat f
162 litToImm (CmmFloat f W64) = ImmDouble f
163 litToImm (CmmLabel l) = ImmCLbl l
164 litToImm (CmmLabelOff l off) = ImmIndex l off
165 litToImm (CmmLabelDiffOff l1 l2 off)
166 = ImmConstantSum
167 (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
168 (ImmInt off)
169 litToImm _ = panic "PPC.Regs.litToImm: no match"
170
171
172 -- addressing modes ------------------------------------------------------------
173
174 data AddrMode
175 = AddrRegReg Reg Reg
176 | AddrRegImm Reg Imm
177
178
179 addrOffset :: AddrMode -> Int -> Maybe AddrMode
180 addrOffset addr off
181 = case addr of
182 AddrRegImm r (ImmInt n)
183 | fits16Bits n2 -> Just (AddrRegImm r (ImmInt n2))
184 | otherwise -> Nothing
185 where n2 = n + off
186
187 AddrRegImm r (ImmInteger n)
188 | fits16Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
189 | otherwise -> Nothing
190 where n2 = n + toInteger off
191
192 _ -> Nothing
193
194
195 -- registers -------------------------------------------------------------------
196 -- @spRel@ gives us a stack relative addressing mode for volatile
197 -- temporaries and for excess call arguments. @fpRel@, where
198 -- applicable, is the same but for the frame pointer.
199
200 spRel :: DynFlags
201 -> Int -- desired stack offset in words, positive or negative
202 -> AddrMode
203
204 spRel dflags n = AddrRegImm sp (ImmInt (n * wORD_SIZE dflags))
205
206
207 -- argRegs is the set of regs which are read for an n-argument call to C.
208 -- For archs which pass all args on the stack (x86), is empty.
209 -- Sparc passes up to the first 6 args in regs.
210 argRegs :: RegNo -> [Reg]
211 argRegs 0 = []
212 argRegs 1 = map regSingle [3]
213 argRegs 2 = map regSingle [3,4]
214 argRegs 3 = map regSingle [3..5]
215 argRegs 4 = map regSingle [3..6]
216 argRegs 5 = map regSingle [3..7]
217 argRegs 6 = map regSingle [3..8]
218 argRegs 7 = map regSingle [3..9]
219 argRegs 8 = map regSingle [3..10]
220 argRegs _ = panic "MachRegs.argRegs(powerpc): don't know about >8 arguments!"
221
222
223 allArgRegs :: [Reg]
224 allArgRegs = map regSingle [3..10]
225
226
227 -- these are the regs which we cannot assume stay alive over a C call.
228 callClobberedRegs :: Platform -> [Reg]
229 callClobberedRegs platform
230 = case platformOS platform of
231 OSDarwin -> map regSingle (0:[2..12] ++ map fReg [0..13])
232 OSLinux -> map regSingle (0:[2..13] ++ map fReg [0..13])
233 _ -> panic "PPC.Regs.callClobberedRegs: not defined for this architecture"
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 OSDarwin -> map (regSingle . fReg) [1..13]
263 OSLinux -> map (regSingle . fReg) [1..8]
264 _ -> panic "PPC.Regs.allFPArgRegs: not defined for this architecture"
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 W32 False = fromIntegral (fromIntegral x :: Word32)
273 narrow W16 False = fromIntegral (fromIntegral x :: Word16)
274 narrow W8 False = fromIntegral (fromIntegral x :: Word8)
275 narrow W32 True = fromIntegral (fromIntegral x :: Int32)
276 narrow W16 True = fromIntegral (fromIntegral x :: Int16)
277 narrow W8 True = fromIntegral (fromIntegral x :: Int8)
278 narrow _ _ = panic "PPC.Regs.narrow: no match"
279
280 narrowed = narrow rep signed
281
282 toI16 W32 True
283 | narrowed >= -32768 && narrowed < 32768 = Just narrowed
284 | otherwise = Nothing
285 toI16 W32 False
286 | narrowed >= 0 && narrowed < 65536 = Just narrowed
287 | otherwise = Nothing
288 toI16 _ _ = Just narrowed
289
290
291 {-
292 The PowerPC has 64 registers of interest; 32 integer registers and 32 floating
293 point registers.
294 -}
295
296 fReg :: Int -> RegNo
297 fReg x = (32 + x)
298
299 sp, r3, r4, r27, r28, r30, f1, f20, f21 :: Reg
300 sp = regSingle 1
301 r3 = regSingle 3
302 r4 = regSingle 4
303 r27 = regSingle 27
304 r28 = regSingle 28
305 r30 = regSingle 30
306 f1 = regSingle $ fReg 1
307 f20 = regSingle $ fReg 20
308 f21 = regSingle $ fReg 21
309
310 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
311 -- i.e., these are the regs for which we are prepared to allow the
312 -- register allocator to attempt to map VRegs to.
313 allocatableRegs :: Platform -> [RealReg]
314 allocatableRegs platform
315 = let isFree i = isFastTrue (freeReg platform i)
316 in map RealRegSingle $ filter isFree allMachRegNos