Merge remote-tracking branch 'origin/type-nats' into type-nats-merge
[ghc.git] / compiler / nativeGen / PPC / Regs.hs
1 -- -----------------------------------------------------------------------------
2 --
3 -- (c) The University of Glasgow 1994-2004
4 --
5 -- -----------------------------------------------------------------------------
6
7 {-# OPTIONS -fno-warn-tabs #-}
8 -- The above warning supression flag is a temporary kludge.
9 -- While working on this module you are encouraged to remove it and
10 -- detab the module (please do the detabbing in a separate patch). See
11 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
12 -- for details
13
14 module PPC.Regs (
15 -- squeeze functions
16 virtualRegSqueeze,
17 realRegSqueeze,
18
19 mkVirtualReg,
20 regDotColor,
21
22 -- immediates
23 Imm(..),
24 strImmLit,
25 litToImm,
26
27 -- addressing modes
28 AddrMode(..),
29 addrOffset,
30
31 -- registers
32 spRel,
33 argRegs,
34 allArgRegs,
35 callClobberedRegs,
36 allMachRegNos,
37 classOfRealReg,
38 showReg,
39
40 -- machine specific
41 allFPArgRegs,
42 fits16Bits,
43 makeImmediate,
44 fReg,
45 sp, r3, r4, r27, r28, f1, f20, f21,
46
47 -- horrow show
48 freeReg,
49 globalRegMaybe,
50 allocatableRegs
51
52 )
53
54 where
55
56 #include "nativeGen/NCG.h"
57 #include "HsVersions.h"
58 #include "../includes/stg/MachRegs.h"
59
60 import Reg
61 import RegClass
62 import Size
63
64 import BlockId
65 import OldCmm
66 import CLabel ( CLabel )
67 import Unique
68
69 import Pretty
70 import Outputable ( panic, SDoc )
71 import qualified Outputable
72 import Constants
73 import FastBool
74 import FastTypes
75
76 import Data.Word ( Word8, Word16, Word32 )
77 import Data.Int ( Int8, Int16, Int32 )
78
79
80 -- squeese functions for the graph allocator -----------------------------------
81
82 -- | regSqueeze_class reg
83 -- Calculuate the maximum number of register colors that could be
84 -- denied to a node of this class due to having this reg
85 -- as a neighbour.
86 --
87 {-# INLINE virtualRegSqueeze #-}
88 virtualRegSqueeze :: RegClass -> VirtualReg -> FastInt
89 virtualRegSqueeze cls vr
90 = case cls of
91 RcInteger
92 -> case vr of
93 VirtualRegI{} -> _ILIT(1)
94 VirtualRegHi{} -> _ILIT(1)
95 _other -> _ILIT(0)
96
97 RcDouble
98 -> case vr of
99 VirtualRegD{} -> _ILIT(1)
100 VirtualRegF{} -> _ILIT(0)
101 _other -> _ILIT(0)
102
103 _other -> _ILIT(0)
104
105 {-# INLINE realRegSqueeze #-}
106 realRegSqueeze :: RegClass -> RealReg -> FastInt
107 realRegSqueeze cls rr
108 = case cls of
109 RcInteger
110 -> case rr of
111 RealRegSingle regNo
112 | regNo < 32 -> _ILIT(1) -- first fp reg is 32
113 | otherwise -> _ILIT(0)
114
115 RealRegPair{} -> _ILIT(0)
116
117 RcDouble
118 -> case rr of
119 RealRegSingle regNo
120 | regNo < 32 -> _ILIT(0)
121 | otherwise -> _ILIT(1)
122
123 RealRegPair{} -> _ILIT(0)
124
125 _other -> _ILIT(0)
126
127 mkVirtualReg :: Unique -> Size -> VirtualReg
128 mkVirtualReg u size
129 | not (isFloatSize size) = VirtualRegI u
130 | otherwise
131 = case size of
132 FF32 -> VirtualRegD u
133 FF64 -> VirtualRegD u
134 _ -> panic "mkVirtualReg"
135
136 regDotColor :: RealReg -> SDoc
137 regDotColor reg
138 = case classOfRealReg reg of
139 RcInteger -> Outputable.text "blue"
140 RcFloat -> Outputable.text "red"
141 RcDouble -> Outputable.text "green"
142 RcDoubleSSE -> Outputable.text "yellow"
143
144
145 -- immediates ------------------------------------------------------------------
146 data Imm
147 = ImmInt Int
148 | ImmInteger Integer -- Sigh.
149 | ImmCLbl CLabel -- AbstractC Label (with baggage)
150 | ImmLit Doc -- Simple string
151 | ImmIndex CLabel Int
152 | ImmFloat Rational
153 | ImmDouble Rational
154 | ImmConstantSum Imm Imm
155 | ImmConstantDiff Imm Imm
156 | LO Imm
157 | HI Imm
158 | HA Imm {- high halfword adjusted -}
159
160
161 strImmLit :: String -> Imm
162 strImmLit s = ImmLit (text s)
163
164
165 litToImm :: CmmLit -> Imm
166 litToImm (CmmInt i w) = ImmInteger (narrowS w i)
167 -- narrow to the width: a CmmInt might be out of
168 -- range, but we assume that ImmInteger only contains
169 -- in-range values. A signed value should be fine here.
170 litToImm (CmmFloat f W32) = ImmFloat f
171 litToImm (CmmFloat f W64) = ImmDouble f
172 litToImm (CmmLabel l) = ImmCLbl l
173 litToImm (CmmLabelOff l off) = ImmIndex l off
174 litToImm (CmmLabelDiffOff l1 l2 off)
175 = ImmConstantSum
176 (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
177 (ImmInt off)
178 litToImm (CmmBlock id) = ImmCLbl (infoTblLbl id)
179 litToImm _ = panic "PPC.Regs.litToImm: no match"
180
181
182 -- addressing modes ------------------------------------------------------------
183
184 data AddrMode
185 = AddrRegReg Reg Reg
186 | AddrRegImm Reg Imm
187
188
189 addrOffset :: AddrMode -> Int -> Maybe AddrMode
190 addrOffset addr off
191 = case addr of
192 AddrRegImm r (ImmInt n)
193 | fits16Bits n2 -> Just (AddrRegImm r (ImmInt n2))
194 | otherwise -> Nothing
195 where n2 = n + off
196
197 AddrRegImm r (ImmInteger n)
198 | fits16Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
199 | otherwise -> Nothing
200 where n2 = n + toInteger off
201
202 _ -> Nothing
203
204
205 -- registers -------------------------------------------------------------------
206 -- @spRel@ gives us a stack relative addressing mode for volatile
207 -- temporaries and for excess call arguments. @fpRel@, where
208 -- applicable, is the same but for the frame pointer.
209
210 spRel :: Int -- desired stack offset in words, positive or negative
211 -> AddrMode
212
213 spRel n = AddrRegImm sp (ImmInt (n * wORD_SIZE))
214
215
216 -- argRegs is the set of regs which are read for an n-argument call to C.
217 -- For archs which pass all args on the stack (x86), is empty.
218 -- Sparc passes up to the first 6 args in regs.
219 argRegs :: RegNo -> [Reg]
220 argRegs 0 = []
221 argRegs 1 = map regSingle [3]
222 argRegs 2 = map regSingle [3,4]
223 argRegs 3 = map regSingle [3..5]
224 argRegs 4 = map regSingle [3..6]
225 argRegs 5 = map regSingle [3..7]
226 argRegs 6 = map regSingle [3..8]
227 argRegs 7 = map regSingle [3..9]
228 argRegs 8 = map regSingle [3..10]
229 argRegs _ = panic "MachRegs.argRegs(powerpc): don't know about >8 arguments!"
230
231
232 allArgRegs :: [Reg]
233 allArgRegs = map regSingle [3..10]
234
235
236 -- these are the regs which we cannot assume stay alive over a C call.
237 callClobberedRegs :: [Reg]
238 #if defined(darwin_TARGET_OS)
239 callClobberedRegs
240 = map regSingle (0:[2..12] ++ map fReg [0..13])
241
242 #elif defined(linux_TARGET_OS)
243 callClobberedRegs
244 = map regSingle (0:[2..13] ++ map fReg [0..13])
245
246 #else
247 callClobberedRegs
248 = panic "PPC.Regs.callClobberedRegs: not defined for this architecture"
249 #endif
250
251
252 allMachRegNos :: [RegNo]
253 allMachRegNos = [0..63]
254
255
256 {-# INLINE classOfRealReg #-}
257 classOfRealReg :: RealReg -> RegClass
258 classOfRealReg (RealRegSingle i)
259 | i < 32 = RcInteger
260 | otherwise = RcDouble
261
262 classOfRealReg (RealRegPair{})
263 = panic "regClass(ppr): no reg pairs on this architecture"
264
265 showReg :: RegNo -> String
266 showReg n
267 | n >= 0 && n <= 31 = "%r" ++ show n
268 | n >= 32 && n <= 63 = "%f" ++ show (n - 32)
269 | otherwise = "%unknown_powerpc_real_reg_" ++ show n
270
271
272
273 -- machine specific ------------------------------------------------------------
274
275 allFPArgRegs :: [Reg]
276 #if defined(darwin_TARGET_OS)
277 allFPArgRegs = map (regSingle . fReg) [1..13]
278
279 #elif defined(linux_TARGET_OS)
280 allFPArgRegs = map (regSingle . fReg) [1..8]
281
282 #else
283 allFPArgRegs = panic "PPC.Regs.allFPArgRegs: not defined for this architecture"
284
285 #endif
286
287 fits16Bits :: Integral a => a -> Bool
288 fits16Bits x = x >= -32768 && x < 32768
289
290 makeImmediate :: Integral a => Width -> Bool -> a -> Maybe Imm
291 makeImmediate rep signed x = fmap ImmInt (toI16 rep signed)
292 where
293 narrow W32 False = fromIntegral (fromIntegral x :: Word32)
294 narrow W16 False = fromIntegral (fromIntegral x :: Word16)
295 narrow W8 False = fromIntegral (fromIntegral x :: Word8)
296 narrow W32 True = fromIntegral (fromIntegral x :: Int32)
297 narrow W16 True = fromIntegral (fromIntegral x :: Int16)
298 narrow W8 True = fromIntegral (fromIntegral x :: Int8)
299 narrow _ _ = panic "PPC.Regs.narrow: no match"
300
301 narrowed = narrow rep signed
302
303 toI16 W32 True
304 | narrowed >= -32768 && narrowed < 32768 = Just narrowed
305 | otherwise = Nothing
306 toI16 W32 False
307 | narrowed >= 0 && narrowed < 65536 = Just narrowed
308 | otherwise = Nothing
309 toI16 _ _ = Just narrowed
310
311
312 {-
313 The PowerPC has 64 registers of interest; 32 integer registers and 32 floating
314 point registers.
315 -}
316
317 fReg :: Int -> RegNo
318 fReg x = (32 + x)
319
320 sp, r3, r4, r27, r28, f1, f20, f21 :: Reg
321 sp = regSingle 1
322 r3 = regSingle 3
323 r4 = regSingle 4
324 r27 = regSingle 27
325 r28 = regSingle 28
326 f1 = regSingle $ fReg 1
327 f20 = regSingle $ fReg 20
328 f21 = regSingle $ fReg 21
329
330
331
332 -- horror show -----------------------------------------------------------------
333 freeReg :: RegNo -> FastBool
334 globalRegMaybe :: GlobalReg -> Maybe Reg
335
336
337 #if powerpc_TARGET_ARCH
338 #define r0 0
339 #define r1 1
340 #define r2 2
341 #define r3 3
342 #define r4 4
343 #define r5 5
344 #define r6 6
345 #define r7 7
346 #define r8 8
347 #define r9 9
348 #define r10 10
349 #define r11 11
350 #define r12 12
351 #define r13 13
352 #define r14 14
353 #define r15 15
354 #define r16 16
355 #define r17 17
356 #define r18 18
357 #define r19 19
358 #define r20 20
359 #define r21 21
360 #define r22 22
361 #define r23 23
362 #define r24 24
363 #define r25 25
364 #define r26 26
365 #define r27 27
366 #define r28 28
367 #define r29 29
368 #define r30 30
369 #define r31 31
370
371 #ifdef darwin_TARGET_OS
372 #define f0 32
373 #define f1 33
374 #define f2 34
375 #define f3 35
376 #define f4 36
377 #define f5 37
378 #define f6 38
379 #define f7 39
380 #define f8 40
381 #define f9 41
382 #define f10 42
383 #define f11 43
384 #define f12 44
385 #define f13 45
386 #define f14 46
387 #define f15 47
388 #define f16 48
389 #define f17 49
390 #define f18 50
391 #define f19 51
392 #define f20 52
393 #define f21 53
394 #define f22 54
395 #define f23 55
396 #define f24 56
397 #define f25 57
398 #define f26 58
399 #define f27 59
400 #define f28 60
401 #define f29 61
402 #define f30 62
403 #define f31 63
404 #else
405 #define fr0 32
406 #define fr1 33
407 #define fr2 34
408 #define fr3 35
409 #define fr4 36
410 #define fr5 37
411 #define fr6 38
412 #define fr7 39
413 #define fr8 40
414 #define fr9 41
415 #define fr10 42
416 #define fr11 43
417 #define fr12 44
418 #define fr13 45
419 #define fr14 46
420 #define fr15 47
421 #define fr16 48
422 #define fr17 49
423 #define fr18 50
424 #define fr19 51
425 #define fr20 52
426 #define fr21 53
427 #define fr22 54
428 #define fr23 55
429 #define fr24 56
430 #define fr25 57
431 #define fr26 58
432 #define fr27 59
433 #define fr28 60
434 #define fr29 61
435 #define fr30 62
436 #define fr31 63
437 #endif
438
439
440
441 freeReg 0 = fastBool False -- Hack: r0 can't be used in all insns, but it's actually free
442 freeReg 1 = fastBool False -- The Stack Pointer
443 #if !darwin_TARGET_OS
444 -- most non-darwin powerpc OSes use r2 as a TOC pointer or something like that
445 freeReg 2 = fastBool False
446 #endif
447
448 #ifdef REG_Base
449 freeReg REG_Base = fastBool False
450 #endif
451 #ifdef REG_R1
452 freeReg REG_R1 = fastBool False
453 #endif
454 #ifdef REG_R2
455 freeReg REG_R2 = fastBool False
456 #endif
457 #ifdef REG_R3
458 freeReg REG_R3 = fastBool False
459 #endif
460 #ifdef REG_R4
461 freeReg REG_R4 = fastBool False
462 #endif
463 #ifdef REG_R5
464 freeReg REG_R5 = fastBool False
465 #endif
466 #ifdef REG_R6
467 freeReg REG_R6 = fastBool False
468 #endif
469 #ifdef REG_R7
470 freeReg REG_R7 = fastBool False
471 #endif
472 #ifdef REG_R8
473 freeReg REG_R8 = fastBool False
474 #endif
475 #ifdef REG_R9
476 freeReg REG_R9 = fastBool False
477 #endif
478 #ifdef REG_R10
479 freeReg REG_R10 = fastBool False
480 #endif
481 #ifdef REG_F1
482 freeReg REG_F1 = fastBool False
483 #endif
484 #ifdef REG_F2
485 freeReg REG_F2 = fastBool False
486 #endif
487 #ifdef REG_F3
488 freeReg REG_F3 = fastBool False
489 #endif
490 #ifdef REG_F4
491 freeReg REG_F4 = fastBool False
492 #endif
493 #ifdef REG_D1
494 freeReg REG_D1 = fastBool False
495 #endif
496 #ifdef REG_D2
497 freeReg REG_D2 = fastBool False
498 #endif
499 #ifdef REG_Sp
500 freeReg REG_Sp = fastBool False
501 #endif
502 #ifdef REG_Su
503 freeReg REG_Su = fastBool False
504 #endif
505 #ifdef REG_SpLim
506 freeReg REG_SpLim = fastBool False
507 #endif
508 #ifdef REG_Hp
509 freeReg REG_Hp = fastBool False
510 #endif
511 #ifdef REG_HpLim
512 freeReg REG_HpLim = fastBool False
513 #endif
514 freeReg _ = fastBool True
515
516
517 -- | Returns 'Nothing' if this global register is not stored
518 -- in a real machine register, otherwise returns @'Just' reg@, where
519 -- reg is the machine register it is stored in.
520
521
522 #ifdef REG_Base
523 globalRegMaybe BaseReg = Just (regSingle REG_Base)
524 #endif
525 #ifdef REG_R1
526 globalRegMaybe (VanillaReg 1 _) = Just (regSingle REG_R1)
527 #endif
528 #ifdef REG_R2
529 globalRegMaybe (VanillaReg 2 _) = Just (regSingle REG_R2)
530 #endif
531 #ifdef REG_R3
532 globalRegMaybe (VanillaReg 3 _) = Just (regSingle REG_R3)
533 #endif
534 #ifdef REG_R4
535 globalRegMaybe (VanillaReg 4 _) = Just (regSingle REG_R4)
536 #endif
537 #ifdef REG_R5
538 globalRegMaybe (VanillaReg 5 _) = Just (regSingle REG_R5)
539 #endif
540 #ifdef REG_R6
541 globalRegMaybe (VanillaReg 6 _) = Just (regSingle REG_R6)
542 #endif
543 #ifdef REG_R7
544 globalRegMaybe (VanillaReg 7 _) = Just (regSingle REG_R7)
545 #endif
546 #ifdef REG_R8
547 globalRegMaybe (VanillaReg 8 _) = Just (regSingle REG_R8)
548 #endif
549 #ifdef REG_R9
550 globalRegMaybe (VanillaReg 9 _) = Just (regSingle REG_R9)
551 #endif
552 #ifdef REG_R10
553 globalRegMaybe (VanillaReg 10 _) = Just (regSingle REG_R10)
554 #endif
555 #ifdef REG_F1
556 globalRegMaybe (FloatReg 1) = Just (regSingle REG_F1)
557 #endif
558 #ifdef REG_F2
559 globalRegMaybe (FloatReg 2) = Just (regSingle REG_F2)
560 #endif
561 #ifdef REG_F3
562 globalRegMaybe (FloatReg 3) = Just (regSingle REG_F3)
563 #endif
564 #ifdef REG_F4
565 globalRegMaybe (FloatReg 4) = Just (regSingle REG_F4)
566 #endif
567 #ifdef REG_D1
568 globalRegMaybe (DoubleReg 1) = Just (regSingle REG_D1)
569 #endif
570 #ifdef REG_D2
571 globalRegMaybe (DoubleReg 2) = Just (regSingle REG_D2)
572 #endif
573 #ifdef REG_Sp
574 globalRegMaybe Sp = Just (regSingle REG_Sp)
575 #endif
576 #ifdef REG_Lng1
577 globalRegMaybe (LongReg 1) = Just (regSingle REG_Lng1)
578 #endif
579 #ifdef REG_Lng2
580 globalRegMaybe (LongReg 2) = Just (regSingle REG_Lng2)
581 #endif
582 #ifdef REG_SpLim
583 globalRegMaybe SpLim = Just (regSingle REG_SpLim)
584 #endif
585 #ifdef REG_Hp
586 globalRegMaybe Hp = Just (regSingle REG_Hp)
587 #endif
588 #ifdef REG_HpLim
589 globalRegMaybe HpLim = Just (regSingle REG_HpLim)
590 #endif
591 #ifdef REG_CurrentTSO
592 globalRegMaybe CurrentTSO = Just (regSingle REG_CurrentTSO)
593 #endif
594 #ifdef REG_CurrentNursery
595 globalRegMaybe CurrentNursery = Just (regSingle REG_CurrentNursery)
596 #endif
597 globalRegMaybe _ = Nothing
598
599
600 #else /* powerpc_TARGET_ARCH */
601
602 freeReg _ = 0#
603 globalRegMaybe _ = panic "PPC.Regs.globalRegMaybe: not defined"
604
605 #endif /* powerpc_TARGET_ARCH */
606
607
608 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
609 -- i.e., these are the regs for which we are prepared to allow the
610 -- register allocator to attempt to map VRegs to.
611 allocatableRegs :: [RealReg]
612 allocatableRegs
613 = let isFree i = isFastTrue (freeReg i)
614 in map RealRegSingle $ filter isFree allMachRegNos