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