Fix -fPIC with the new code generator
[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 -- horrow show
41 freeReg,
42 globalRegMaybe,
43 allocatableRegs
44
45 )
46
47 where
48
49 #include "nativeGen/NCG.h"
50 #include "HsVersions.h"
51 #include "../includes/stg/HaskellMachRegs.h"
52
53 import Reg
54 import RegClass
55 import Size
56
57 import OldCmm
58 import CLabel ( CLabel )
59 import Unique
60
61 import Outputable
62 import Constants
63 import FastBool
64 import FastTypes
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 :: Int -- desired stack offset in words, positive or negative
200 -> AddrMode
201
202 spRel n = AddrRegImm sp (ImmInt (n * wORD_SIZE))
203
204
205 -- argRegs is the set of regs which are read for an n-argument call to C.
206 -- For archs which pass all args on the stack (x86), is empty.
207 -- Sparc passes up to the first 6 args in regs.
208 argRegs :: RegNo -> [Reg]
209 argRegs 0 = []
210 argRegs 1 = map regSingle [3]
211 argRegs 2 = map regSingle [3,4]
212 argRegs 3 = map regSingle [3..5]
213 argRegs 4 = map regSingle [3..6]
214 argRegs 5 = map regSingle [3..7]
215 argRegs 6 = map regSingle [3..8]
216 argRegs 7 = map regSingle [3..9]
217 argRegs 8 = map regSingle [3..10]
218 argRegs _ = panic "MachRegs.argRegs(powerpc): don't know about >8 arguments!"
219
220
221 allArgRegs :: [Reg]
222 allArgRegs = map regSingle [3..10]
223
224
225 -- these are the regs which we cannot assume stay alive over a C call.
226 callClobberedRegs :: [Reg]
227 #if defined(darwin_TARGET_OS)
228 callClobberedRegs
229 = map regSingle (0:[2..12] ++ map fReg [0..13])
230
231 #elif defined(linux_TARGET_OS)
232 callClobberedRegs
233 = map regSingle (0:[2..13] ++ map fReg [0..13])
234
235 #else
236 callClobberedRegs
237 = panic "PPC.Regs.callClobberedRegs: not defined for this architecture"
238 #endif
239
240
241 allMachRegNos :: [RegNo]
242 allMachRegNos = [0..63]
243
244
245 {-# INLINE classOfRealReg #-}
246 classOfRealReg :: RealReg -> RegClass
247 classOfRealReg (RealRegSingle i)
248 | i < 32 = RcInteger
249 | otherwise = RcDouble
250
251 classOfRealReg (RealRegPair{})
252 = panic "regClass(ppr): no reg pairs on this architecture"
253
254 showReg :: RegNo -> String
255 showReg n
256 | n >= 0 && n <= 31 = "%r" ++ show n
257 | n >= 32 && n <= 63 = "%f" ++ show (n - 32)
258 | otherwise = "%unknown_powerpc_real_reg_" ++ show n
259
260
261
262 -- machine specific ------------------------------------------------------------
263
264 allFPArgRegs :: [Reg]
265 #if defined(darwin_TARGET_OS)
266 allFPArgRegs = map (regSingle . fReg) [1..13]
267
268 #elif defined(linux_TARGET_OS)
269 allFPArgRegs = map (regSingle . fReg) [1..8]
270
271 #else
272 allFPArgRegs = panic "PPC.Regs.allFPArgRegs: not defined for this architecture"
273
274 #endif
275
276 fits16Bits :: Integral a => a -> Bool
277 fits16Bits x = x >= -32768 && x < 32768
278
279 makeImmediate :: Integral a => Width -> Bool -> a -> Maybe Imm
280 makeImmediate rep signed x = fmap ImmInt (toI16 rep signed)
281 where
282 narrow W32 False = fromIntegral (fromIntegral x :: Word32)
283 narrow W16 False = fromIntegral (fromIntegral x :: Word16)
284 narrow W8 False = fromIntegral (fromIntegral x :: Word8)
285 narrow W32 True = fromIntegral (fromIntegral x :: Int32)
286 narrow W16 True = fromIntegral (fromIntegral x :: Int16)
287 narrow W8 True = fromIntegral (fromIntegral x :: Int8)
288 narrow _ _ = panic "PPC.Regs.narrow: no match"
289
290 narrowed = narrow rep signed
291
292 toI16 W32 True
293 | narrowed >= -32768 && narrowed < 32768 = Just narrowed
294 | otherwise = Nothing
295 toI16 W32 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 sp, r3, r4, r27, r28, f1, f20, f21 :: Reg
310 sp = regSingle 1
311 r3 = regSingle 3
312 r4 = regSingle 4
313 r27 = regSingle 27
314 r28 = regSingle 28
315 f1 = regSingle $ fReg 1
316 f20 = regSingle $ fReg 20
317 f21 = regSingle $ fReg 21
318
319
320
321 -- horror show -----------------------------------------------------------------
322 freeReg :: RegNo -> FastBool
323 globalRegMaybe :: GlobalReg -> Maybe RealReg
324
325
326 #if powerpc_TARGET_ARCH
327 #define r0 0
328 #define r1 1
329 #define r2 2
330 #define r3 3
331 #define r4 4
332 #define r5 5
333 #define r6 6
334 #define r7 7
335 #define r8 8
336 #define r9 9
337 #define r10 10
338 #define r11 11
339 #define r12 12
340 #define r13 13
341 #define r14 14
342 #define r15 15
343 #define r16 16
344 #define r17 17
345 #define r18 18
346 #define r19 19
347 #define r20 20
348 #define r21 21
349 #define r22 22
350 #define r23 23
351 #define r24 24
352 #define r25 25
353 #define r26 26
354 #define r27 27
355 #define r28 28
356 #define r29 29
357 #define r30 30
358 #define r31 31
359
360 #ifdef darwin_TARGET_OS
361 #define f0 32
362 #define f1 33
363 #define f2 34
364 #define f3 35
365 #define f4 36
366 #define f5 37
367 #define f6 38
368 #define f7 39
369 #define f8 40
370 #define f9 41
371 #define f10 42
372 #define f11 43
373 #define f12 44
374 #define f13 45
375 #define f14 46
376 #define f15 47
377 #define f16 48
378 #define f17 49
379 #define f18 50
380 #define f19 51
381 #define f20 52
382 #define f21 53
383 #define f22 54
384 #define f23 55
385 #define f24 56
386 #define f25 57
387 #define f26 58
388 #define f27 59
389 #define f28 60
390 #define f29 61
391 #define f30 62
392 #define f31 63
393 #else
394 #define fr0 32
395 #define fr1 33
396 #define fr2 34
397 #define fr3 35
398 #define fr4 36
399 #define fr5 37
400 #define fr6 38
401 #define fr7 39
402 #define fr8 40
403 #define fr9 41
404 #define fr10 42
405 #define fr11 43
406 #define fr12 44
407 #define fr13 45
408 #define fr14 46
409 #define fr15 47
410 #define fr16 48
411 #define fr17 49
412 #define fr18 50
413 #define fr19 51
414 #define fr20 52
415 #define fr21 53
416 #define fr22 54
417 #define fr23 55
418 #define fr24 56
419 #define fr25 57
420 #define fr26 58
421 #define fr27 59
422 #define fr28 60
423 #define fr29 61
424 #define fr30 62
425 #define fr31 63
426 #endif
427
428
429
430 freeReg 0 = fastBool False -- Hack: r0 can't be used in all insns, but it's actually free
431 freeReg 1 = fastBool False -- The Stack Pointer
432 #if !darwin_TARGET_OS
433 -- most non-darwin powerpc OSes use r2 as a TOC pointer or something like that
434 freeReg 2 = fastBool False
435 #endif
436
437 #ifdef REG_Base
438 freeReg REG_Base = fastBool False
439 #endif
440 #ifdef REG_R1
441 freeReg REG_R1 = fastBool False
442 #endif
443 #ifdef REG_R2
444 freeReg REG_R2 = fastBool False
445 #endif
446 #ifdef REG_R3
447 freeReg REG_R3 = fastBool False
448 #endif
449 #ifdef REG_R4
450 freeReg REG_R4 = fastBool False
451 #endif
452 #ifdef REG_R5
453 freeReg REG_R5 = fastBool False
454 #endif
455 #ifdef REG_R6
456 freeReg REG_R6 = fastBool False
457 #endif
458 #ifdef REG_R7
459 freeReg REG_R7 = fastBool False
460 #endif
461 #ifdef REG_R8
462 freeReg REG_R8 = fastBool False
463 #endif
464 #ifdef REG_R9
465 freeReg REG_R9 = fastBool False
466 #endif
467 #ifdef REG_R10
468 freeReg REG_R10 = fastBool False
469 #endif
470 #ifdef REG_F1
471 freeReg REG_F1 = fastBool False
472 #endif
473 #ifdef REG_F2
474 freeReg REG_F2 = fastBool False
475 #endif
476 #ifdef REG_F3
477 freeReg REG_F3 = fastBool False
478 #endif
479 #ifdef REG_F4
480 freeReg REG_F4 = fastBool False
481 #endif
482 #ifdef REG_D1
483 freeReg REG_D1 = fastBool False
484 #endif
485 #ifdef REG_D2
486 freeReg REG_D2 = fastBool False
487 #endif
488 #ifdef REG_Sp
489 freeReg REG_Sp = fastBool False
490 #endif
491 #ifdef REG_Su
492 freeReg REG_Su = fastBool False
493 #endif
494 #ifdef REG_SpLim
495 freeReg REG_SpLim = fastBool False
496 #endif
497 #ifdef REG_Hp
498 freeReg REG_Hp = fastBool False
499 #endif
500 #ifdef REG_HpLim
501 freeReg REG_HpLim = fastBool False
502 #endif
503 freeReg _ = fastBool True
504
505
506 -- | Returns 'Nothing' if this global register is not stored
507 -- in a real machine register, otherwise returns @'Just' reg@, where
508 -- reg is the machine register it is stored in.
509
510
511 #ifdef REG_Base
512 globalRegMaybe BaseReg = Just (RealRegSingle REG_Base)
513 #endif
514 #ifdef REG_R1
515 globalRegMaybe (VanillaReg 1 _) = Just (RealRegSingle REG_R1)
516 #endif
517 #ifdef REG_R2
518 globalRegMaybe (VanillaReg 2 _) = Just (RealRegSingle REG_R2)
519 #endif
520 #ifdef REG_R3
521 globalRegMaybe (VanillaReg 3 _) = Just (RealRegSingle REG_R3)
522 #endif
523 #ifdef REG_R4
524 globalRegMaybe (VanillaReg 4 _) = Just (RealRegSingle REG_R4)
525 #endif
526 #ifdef REG_R5
527 globalRegMaybe (VanillaReg 5 _) = Just (RealRegSingle REG_R5)
528 #endif
529 #ifdef REG_R6
530 globalRegMaybe (VanillaReg 6 _) = Just (RealRegSingle REG_R6)
531 #endif
532 #ifdef REG_R7
533 globalRegMaybe (VanillaReg 7 _) = Just (RealRegSingle REG_R7)
534 #endif
535 #ifdef REG_R8
536 globalRegMaybe (VanillaReg 8 _) = Just (RealRegSingle REG_R8)
537 #endif
538 #ifdef REG_R9
539 globalRegMaybe (VanillaReg 9 _) = Just (RealRegSingle REG_R9)
540 #endif
541 #ifdef REG_R10
542 globalRegMaybe (VanillaReg 10 _) = Just (RealRegSingle REG_R10)
543 #endif
544 #ifdef REG_F1
545 globalRegMaybe (FloatReg 1) = Just (RealRegSingle REG_F1)
546 #endif
547 #ifdef REG_F2
548 globalRegMaybe (FloatReg 2) = Just (RealRegSingle REG_F2)
549 #endif
550 #ifdef REG_F3
551 globalRegMaybe (FloatReg 3) = Just (RealRegSingle REG_F3)
552 #endif
553 #ifdef REG_F4
554 globalRegMaybe (FloatReg 4) = Just (RealRegSingle REG_F4)
555 #endif
556 #ifdef REG_D1
557 globalRegMaybe (DoubleReg 1) = Just (RealRegSingle REG_D1)
558 #endif
559 #ifdef REG_D2
560 globalRegMaybe (DoubleReg 2) = Just (RealRegSingle REG_D2)
561 #endif
562 #ifdef REG_Sp
563 globalRegMaybe Sp = Just (RealRegSingle REG_Sp)
564 #endif
565 #ifdef REG_Lng1
566 globalRegMaybe (LongReg 1) = Just (RealRegSingle REG_Lng1)
567 #endif
568 #ifdef REG_Lng2
569 globalRegMaybe (LongReg 2) = Just (RealRegSingle REG_Lng2)
570 #endif
571 #ifdef REG_SpLim
572 globalRegMaybe SpLim = Just (RealRegSingle REG_SpLim)
573 #endif
574 #ifdef REG_Hp
575 globalRegMaybe Hp = Just (RealRegSingle REG_Hp)
576 #endif
577 #ifdef REG_HpLim
578 globalRegMaybe HpLim = Just (RealRegSingle REG_HpLim)
579 #endif
580 #ifdef REG_CurrentTSO
581 globalRegMaybe CurrentTSO = Just (RealRegSingle REG_CurrentTSO)
582 #endif
583 #ifdef REG_CurrentNursery
584 globalRegMaybe CurrentNursery = Just (RealRegSingle REG_CurrentNursery)
585 #endif
586 globalRegMaybe _ = Nothing
587
588
589 #else /* powerpc_TARGET_ARCH */
590
591 freeReg _ = 0#
592 globalRegMaybe _ = panic "PPC.Regs.globalRegMaybe: not defined"
593
594 #endif /* powerpc_TARGET_ARCH */
595
596
597 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
598 -- i.e., these are the regs for which we are prepared to allow the
599 -- register allocator to attempt to map VRegs to.
600 allocatableRegs :: [RealReg]
601 allocatableRegs
602 = let isFree i = isFastTrue (freeReg i)
603 in map RealRegSingle $ filter isFree allMachRegNos