ghc/compiler/nativeGen/MachRegs.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996-1998
   3 %
   4 \section[MachRegs]{Machine-specific info about registers}
   5
   6 Also includes stuff about immediate operands, which are
   7 often/usually quite entangled with registers.
   8
   9 (Immediates could be untangled from registers at some cost in tangled
  10 modules --- the pleasure has been foregone.)
  11
  12 \begin{code}
  13 #include "nativeGen/NCG.h"
  14
  15 module MachRegs (
  16
  17         Reg(..),
  18         Imm(..),
  19         MachRegsAddr(..),
  20         RegLoc(..),
  21         RegNo,
  22
  23         addrOffset,
  24         argRegs,
  25         baseRegOffset,
  26         callClobberedRegs,
  27         callerSaves,
  28         extractMappedRegNos,
  29         mappedRegNo,
  30         freeMappedRegs,
  31         freeReg, freeRegs,
  32         getNewRegNCG,
  33         magicIdRegMaybe,
  34         mkReg,
  35         realReg,
  36         saveLoc,
  37         spRel,
  38         stgReg,
  39         strImmLit
  40
  41 #if alpha_TARGET_ARCH
  42         , allArgRegs
  43         , fits8Bits
  44         , fReg
  45         , gp, pv, ra, sp, t9, t10, t11, t12, v0, f0, zeroh
  46 #endif
  47 #if i386_TARGET_ARCH
  48         , eax, ebx, ecx, edx, esi, esp
  49         , fake0, fake1, fake2, fake3, fake4, fake5
  50 #endif
  51 #if sparc_TARGET_ARCH
  52         , allArgRegs
  53         , fits13Bits
  54         , fPair, fpRel, gReg, iReg, lReg, oReg, largeOffsetError
  55         , fp, g0, o0, f0
  56
  57 #endif
  58     ) where
  59
  60 #include "HsVersions.h"
  61
  62 import AbsCSyn          ( MagicId(..) )
  63 import AbsCUtils        ( magicIdPrimRep )
  64 import CLabel           ( CLabel, mkMainRegTableLabel )
  65 import PrimOp           ( PrimOp(..) )
  66 import PrimRep          ( PrimRep(..) )
  67 import Stix             ( StixTree(..), StixReg(..),
  68                           getUniqueNat, returnNat, thenNat, NatM )
  69 import Unique           ( mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
  70                           Uniquable(..), Unique
  71                         )
  72 --import UniqSupply     ( getUniqueUs, returnUs, thenUs, UniqSM )
  73 import Outputable
  74 \end{code}
  75
  76 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  77
  78 \begin{code}
  79 data Imm
  80   = ImmInt      Int
  81   | ImmInteger  Integer     -- Sigh.
  82   | ImmCLbl     CLabel      -- AbstractC Label (with baggage)
  83   | ImmLab      Bool SDoc    -- Simple string label (underscore-able)
  84                              -- Bool==True ==> in a different DLL
  85   | ImmLit      SDoc    -- Simple string
  86   | ImmIndex    CLabel Int
  87   | ImmDouble   Rational
  88   IF_ARCH_sparc(
  89   | LO Imm                  -- Possible restrictions...
  90   | HI Imm
  91   ,)
  92 strImmLit s = ImmLit (text s)
  93 \end{code}
  94
  95 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  96
  97 \begin{code}
  98 data MachRegsAddr
  99 #if alpha_TARGET_ARCH
 100   = AddrImm     Imm
 101   | AddrReg     Reg
 102   | AddrRegImm  Reg Imm
 103 #endif
 104
 105 #if i386_TARGET_ARCH
 106   = AddrBaseIndex       Base Index Displacement
 107   | ImmAddr             Imm Int
 108
 109 type Base         = Maybe Reg
 110 type Index        = Maybe (Reg, Int)    -- Int is 2, 4 or 8
 111 type Displacement = Imm
 112 #endif
 113
 114 #if sparc_TARGET_ARCH
 115   = AddrRegReg  Reg Reg
 116   | AddrRegImm  Reg Imm
 117 #endif
 118
 119 addrOffset :: MachRegsAddr -> Int -> Maybe MachRegsAddr
 120
 121 addrOffset addr off
 122   = case addr of
 123 #if alpha_TARGET_ARCH
 124       _ -> panic "MachMisc.addrOffset not defined for Alpha"
 125 #endif
 126 #if i386_TARGET_ARCH
 127       ImmAddr i off0      -> Just (ImmAddr i (off0 + off))
 128       AddrBaseIndex r i (ImmInt n) -> Just (AddrBaseIndex r i (ImmInt (n + off)))
 129       AddrBaseIndex r i (ImmInteger n)
 130         -> Just (AddrBaseIndex r i (ImmInt (fromInteger (n + toInteger off))))
 131       _ -> Nothing
 132 #endif
 133 #if sparc_TARGET_ARCH
 134       AddrRegImm r (ImmInt n)
 135        | fits13Bits n2 -> Just (AddrRegImm r (ImmInt n2))
 136        | otherwise     -> Nothing
 137        where n2 = n + off
 138
 139       AddrRegImm r (ImmInteger n)
 140        | fits13Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
 141        | otherwise     -> Nothing
 142        where n2 = n + toInteger off
 143
 144       AddrRegReg r (FixedReg ILIT(0))
 145        | fits13Bits off -> Just (AddrRegImm r (ImmInt off))
 146        | otherwise     -> Nothing
 147
 148       _ -> Nothing
 149
 150 #endif {-sparc-}
 151
 152 -----------------
 153 #if alpha_TARGET_ARCH
 154
 155 fits8Bits :: Integer -> Bool
 156 fits8Bits i = i >= -256 && i < 256
 157
 158 #endif
 159
 160 #if sparc_TARGET_ARCH
 161 {-# SPECIALIZE
 162     fits13Bits :: Int -> Bool
 163   #-}
 164 {-# SPECIALIZE
 165     fits13Bits :: Integer -> Bool
 166   #-}
 167
 168 fits13Bits :: Integral a => a -> Bool
 169 fits13Bits x = x >= -4096 && x < 4096
 170
 171 -----------------
 172 largeOffsetError i
 173   = error ("ERROR: SPARC native-code generator cannot handle large offset ("
 174            ++show i++");\nprobably because of large constant data structures;" ++
 175            "\nworkaround: use -fvia-C on this module.\n")
 176
 177 #endif {-sparc-}
 178 \end{code}
 179
 180 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 181
 182 @stgReg@: we map STG registers onto appropriate Stix Trees.  First, we
 183 handle the two constants, @STK_STUB_closure@ and @vtbl_StdUpdFrame@.
 184 The rest are either in real machine registers or stored as offsets
 185 from BaseReg.
 186
 187 \begin{code}
 188 data RegLoc = Save StixTree | Always StixTree
 189 \end{code}
 190
 191 Trees for register save locations:
 192 \begin{code}
 193 saveLoc :: MagicId -> StixTree
 194
 195 saveLoc reg = case (stgReg reg) of {Always loc -> loc; Save loc -> loc}
 196 \end{code}
 197
 198 \begin{code}
 199 stgReg :: MagicId -> RegLoc
 200
 201 stgReg x
 202   = case (magicIdRegMaybe x) of
 203         Just _  -> Save   nonReg
 204         Nothing -> Always nonReg
 205   where
 206     offset = baseRegOffset x
 207
 208     baseLoc = case (magicIdRegMaybe BaseReg) of
 209       Just _  -> StReg (StixMagicId BaseReg)
 210       Nothing -> StCLbl mkMainRegTableLabel
 211
 212     nonReg = case x of
 213       BaseReg -> StCLbl mkMainRegTableLabel
 214
 215       _ -> StInd (magicIdPrimRep x)
 216                  (StPrim IntAddOp [baseLoc,
 217                         StInt (toInteger (offset*BYTES_PER_WORD))])
 218 \end{code}
 219
 220 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 221
 222 @spRel@ gives us a stack relative addressing mode for volatile
 223 temporaries and for excess call arguments.  @fpRel@, where
 224 applicable, is the same but for the frame pointer.
 225
 226 \begin{code}
 227 spRel :: Int    -- desired stack offset in words, positive or negative
 228       -> MachRegsAddr
 229
 230 spRel n
 231 #if i386_TARGET_ARCH
 232   = AddrBaseIndex (Just esp) Nothing (ImmInt (n * BYTES_PER_WORD))
 233 #else
 234   = AddrRegImm sp (ImmInt (n * BYTES_PER_WORD))
 235 #endif
 236
 237 #if sparc_TARGET_ARCH
 238 fpRel :: Int -> MachRegsAddr
 239     -- Duznae work for offsets greater than 13 bits; we just hope for
 240     -- the best
 241 fpRel n
 242   = AddrRegImm fp (ImmInt (n * BYTES_PER_WORD))
 243 #endif
 244 \end{code}
 245
 246 %************************************************************************
 247 %*                                                                      *
 248 \subsection[Reg]{Real registers}
 249 %*                                                                      *
 250 %************************************************************************
 251
 252 Static Registers correspond to actual machine registers.  These should
 253 be avoided until the last possible moment.
 254
 255 Dynamic registers are allocated on the fly, usually to represent a single
 256 value in the abstract assembly code (i.e. dynamic registers are usually
 257 single assignment).  Ultimately, they are mapped to available machine
 258 registers before spitting out the code.
 259
 260 \begin{code}
 261 data Reg
 262   = FixedReg  FAST_INT          -- A pre-allocated machine register
 263
 264   | MappedReg FAST_INT          -- A dynamically allocated machine register
 265
 266   | MemoryReg Int PrimRep       -- A machine "register" actually held in
 267                                 -- a memory allocated table of
 268                                 -- registers which didn't fit in real
 269                                 -- registers.
 270
 271   | UnmappedReg Unique PrimRep  -- One of an infinite supply of registers,
 272                                 -- always mapped to one of the earlier
 273                                 -- two (?)  before we're done.
 274 mkReg :: Unique -> PrimRep -> Reg
 275 mkReg = UnmappedReg
 276
 277 getNewRegNCG :: PrimRep -> NatM Reg
 278 getNewRegNCG pk
 279   = getUniqueNat `thenNat` \ u ->
 280     returnNat (UnmappedReg u pk)
 281
 282 instance Show Reg where
 283     showsPrec _ (FixedReg i)    = showString "%"  . shows IBOX(i)
 284     showsPrec _ (MappedReg i)   = showString "%"  . shows IBOX(i)
 285     showsPrec _ (MemoryReg i _) = showString "%M"  . shows i
 286     showsPrec _ (UnmappedReg i _) = showString "%U" . shows i
 287
 288 #ifdef DEBUG
 289 instance Outputable Reg where
 290     ppr r = text (show r)
 291 #endif
 292
 293 cmpReg (FixedReg i)      (FixedReg i')      = cmp_ihash i i'
 294 cmpReg (MappedReg i)     (MappedReg i')     = cmp_ihash i i'
 295 cmpReg (MemoryReg i _)   (MemoryReg i' _)   = i `compare` i'
 296 cmpReg (UnmappedReg u _) (UnmappedReg u' _) = compare u u'
 297 cmpReg r1 r2
 298   = let tag1 = tagReg r1
 299         tag2 = tagReg r2
 300     in
 301         if tag1 _LT_ tag2 then LT else GT
 302     where
 303         tagReg (FixedReg _)      = (ILIT(1) :: FAST_INT)
 304         tagReg (MappedReg _)     = ILIT(2)
 305         tagReg (MemoryReg _ _)   = ILIT(3)
 306         tagReg (UnmappedReg _ _) = ILIT(4)
 307
 308 cmp_ihash :: FAST_INT -> FAST_INT -> Ordering
 309 cmp_ihash a1 a2 = if a1 _EQ_ a2 then EQ else if a1 _LT_ a2 then LT else GT
 310
 311 instance Eq Reg where
 312     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
 313     a /= b = case (a `compare` b) of { EQ -> False; _ -> True  }
 314
 315 instance Ord Reg where
 316     a <= b = case (a `compare` b) of { LT -> True;      EQ -> True;  GT -> False }
 317     a <  b = case (a `compare` b) of { LT -> True;      EQ -> False; GT -> False }
 318     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 319     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 320     compare a b = cmpReg a b
 321
 322 instance Uniquable Reg where
 323     getUnique (UnmappedReg u _) = u
 324     getUnique (FixedReg i)      = mkPseudoUnique1 IBOX(i)
 325     getUnique (MappedReg i)     = mkPseudoUnique2 IBOX(i)
 326     getUnique (MemoryReg i _)   = mkPseudoUnique3 i
 327 \end{code}
 328
 329 \begin{code}
 330 type RegNo = Int
 331
 332 realReg :: RegNo -> Reg
 333 realReg n@IBOX(i)
 334   = if _IS_TRUE_(freeReg i) then MappedReg i else FixedReg i
 335
 336 extractMappedRegNos :: [Reg] -> [RegNo]
 337
 338 extractMappedRegNos regs
 339   = foldr ex [] regs
 340   where
 341     ex (MappedReg i) acc = IBOX(i) : acc  -- we'll take it
 342     ex _             acc = acc            -- leave it out
 343
 344 mappedRegNo :: Reg -> RegNo
 345 mappedRegNo (MappedReg i) = IBOX(i)
 346 mappedRegNo _             = pprPanic "mappedRegNo" empty
 347 \end{code}
 348
 349 ** Machine-specific Reg stuff: **
 350
 351 The Alpha has 64 registers of interest; 32 integer registers and 32 floating
 352 point registers.  The mapping of STG registers to alpha machine registers
 353 is defined in StgRegs.h.  We are, of course, prepared for any eventuality.
 354 \begin{code}
 355 #if alpha_TARGET_ARCH
 356 fReg :: Int -> Int
 357 fReg x = (32 + x)
 358
 359 v0, f0, ra, pv, gp, sp, zeroh :: Reg
 360 v0    = realReg 0
 361 f0    = realReg (fReg 0)
 362 ra    = FixedReg ILIT(26)
 363 pv    = t12
 364 gp    = FixedReg ILIT(29)
 365 sp    = FixedReg ILIT(30)
 366 zeroh = FixedReg ILIT(31) -- "zero" is used in 1.3 (MonadZero method)
 367
 368 t9, t10, t11, t12 :: Reg
 369 t9  = realReg 23
 370 t10 = realReg 24
 371 t11 = realReg 25
 372 t12 = realReg 27
 373 #endif
 374 \end{code}
 375
 376 Intel x86 architecture:
 377 - All registers except 7 (esp) are available for use.
 378 - Only ebx, esi, edi and esp are available across a C call (they are callee-saves).
 379 - Registers 0-7 have 16-bit counterparts (ax, bx etc.)
 380 - Registers 0-3 have 8 bit counterparts (ah, bh etc.)
 381 - Registers 8-13 are fakes; we pretend x86 has 6 conventionally-addressable
 382   fp registers, and 3-operand insns for them, and we translate this into
 383   real stack-based x86 fp code after register allocation.
 384
 385 \begin{code}
 386 #if i386_TARGET_ARCH
 387
 388 gReg,fReg :: Int -> Int
 389 gReg x = x
 390 fReg x = (8 + x)
 391
 392 fake0, fake1, fake2, fake3, fake4, fake5, eax, ebx, ecx, edx, esp :: Reg
 393 eax = realReg (gReg 0)
 394 ebx = realReg (gReg 1)
 395 ecx = realReg (gReg 2)
 396 edx = realReg (gReg 3)
 397 esi = realReg (gReg 4)
 398 edi = realReg (gReg 5)
 399 ebp = realReg (gReg 6)
 400 esp = realReg (gReg 7)
 401 fake0 = realReg (fReg 0)
 402 fake1 = realReg (fReg 1)
 403 fake2 = realReg (fReg 2)
 404 fake3 = realReg (fReg 3)
 405 fake4 = realReg (fReg 4)
 406 fake5 = realReg (fReg 5)
 407 #endif
 408 \end{code}
 409
 410 The SPARC has 64 registers of interest; 32 integer registers and 32
 411 floating point registers.  The mapping of STG registers to SPARC
 412 machine registers is defined in StgRegs.h.  We are, of course,
 413 prepared for any eventuality.
 414
 415 \begin{code}
 416 #if sparc_TARGET_ARCH
 417
 418 gReg,lReg,iReg,oReg,fReg :: Int -> Int
 419 gReg x = x
 420 oReg x = (8 + x)
 421 lReg x = (16 + x)
 422 iReg x = (24 + x)
 423 fReg x = (32 + x)
 424
 425 fPair :: Reg -> Reg
 426 fPair (FixedReg i) = FixedReg (i _ADD_ ILIT(1))
 427 fPair (MappedReg i) = MappedReg (i _ADD_ ILIT(1))
 428
 429 g0, fp, sp, o0, f0 :: Reg
 430 g0 = case (gReg 0) of { IBOX(g0) -> FixedReg g0 }
 431 fp = case (iReg 6) of { IBOX(i6) -> FixedReg i6 }
 432 sp = case (oReg 6) of { IBOX(o6) -> FixedReg o6 }
 433 o0 = realReg  (oReg 0)
 434 f0 = realReg  (fReg 0)
 435
 436 #endif
 437 \end{code}
 438
 439 Redefine the literals used for machine-registers with non-numeric
 440 names in the header files.  Gag me with a spoon, eh?
 441 \begin{code}
 442 #if alpha_TARGET_ARCH
 443 #define f0 32
 444 #define f1 33
 445 #define f2 34
 446 #define f3 35
 447 #define f4 36
 448 #define f5 37
 449 #define f6 38
 450 #define f7 39
 451 #define f8 40
 452 #define f9 41
 453 #define f10 42
 454 #define f11 43
 455 #define f12 44
 456 #define f13 45
 457 #define f14 46
 458 #define f15 47
 459 #define f16 48
 460 #define f17 49
 461 #define f18 50
 462 #define f19 51
 463 #define f20 52
 464 #define f21 53
 465 #define f22 54
 466 #define f23 55
 467 #define f24 56
 468 #define f25 57
 469 #define f26 58
 470 #define f27 59
 471 #define f28 60
 472 #define f29 61
 473 #define f30 62
 474 #define f31 63
 475 #endif
 476 #if i386_TARGET_ARCH
 477 #define eax 0
 478 #define ebx 1
 479 #define ecx 2
 480 #define edx 3
 481 #define esi 4
 482 #define edi 5
 483 #define ebp 6
 484 #define esp 7
 485 #define fake0 8
 486 #define fake1 9
 487 #define fake2 10
 488 #define fake3 11
 489 #define fake4 12
 490 #define fake5 13
 491 #endif
 492 #if sparc_TARGET_ARCH
 493 #define g0 0
 494 #define g1 1
 495 #define g2 2
 496 #define g3 3
 497 #define g4 4
 498 #define g5 5
 499 #define g6 6
 500 #define g7 7
 501 #define o0 8
 502 #define o1 9
 503 #define o2 10
 504 #define o3 11
 505 #define o4 12
 506 #define o5 13
 507 #define o6 14
 508 #define o7 15
 509 #define l0 16
 510 #define l1 17
 511 #define l2 18
 512 #define l3 19
 513 #define l4 20
 514 #define l5 21
 515 #define l6 22
 516 #define l7 23
 517 #define i0 24
 518 #define i1 25
 519 #define i2 26
 520 #define i3 27
 521 #define i4 28
 522 #define i5 29
 523 #define i6 30
 524 #define i7 31
 525 #define f0 32
 526 #define f1 33
 527 #define f2 34
 528 #define f3 35
 529 #define f4 36
 530 #define f5 37
 531 #define f6 38
 532 #define f7 39
 533 #define f8 40
 534 #define f9 41
 535 #define f10 42
 536 #define f11 43
 537 #define f12 44
 538 #define f13 45
 539 #define f14 46
 540 #define f15 47
 541 #define f16 48
 542 #define f17 49
 543 #define f18 50
 544 #define f19 51
 545 #define f20 52
 546 #define f21 53
 547 #define f22 54
 548 #define f23 55
 549 #define f24 56
 550 #define f25 57
 551 #define f26 58
 552 #define f27 59
 553 #define f28 60
 554 #define f29 61
 555 #define f30 62
 556 #define f31 63
 557 #endif
 558 \end{code}
 559
 560 \begin{code}
 561 baseRegOffset :: MagicId -> Int
 562
 563 baseRegOffset (VanillaReg _ ILIT(1)) = OFFSET_R1
 564 baseRegOffset (VanillaReg _ ILIT(2)) = OFFSET_R2
 565 baseRegOffset (VanillaReg _ ILIT(3)) = OFFSET_R3
 566 baseRegOffset (VanillaReg _ ILIT(4)) = OFFSET_R4
 567 baseRegOffset (VanillaReg _ ILIT(5)) = OFFSET_R5
 568 baseRegOffset (VanillaReg _ ILIT(6)) = OFFSET_R6
 569 baseRegOffset (VanillaReg _ ILIT(7)) = OFFSET_R7
 570 baseRegOffset (VanillaReg _ ILIT(8)) = OFFSET_R8
 571 baseRegOffset (VanillaReg _ ILIT(9)) = OFFSET_R9
 572 baseRegOffset (VanillaReg _ ILIT(10)) = OFFSET_R10
 573 baseRegOffset (FloatReg  ILIT(1))    = OFFSET_F1
 574 baseRegOffset (FloatReg  ILIT(2))    = OFFSET_F2
 575 baseRegOffset (FloatReg  ILIT(3))    = OFFSET_F3
 576 baseRegOffset (FloatReg  ILIT(4))    = OFFSET_F4
 577 baseRegOffset (DoubleReg ILIT(1))    = OFFSET_D1
 578 baseRegOffset (DoubleReg ILIT(2))    = OFFSET_D2
 579 baseRegOffset Sp                     = OFFSET_Sp
 580 baseRegOffset Su                     = OFFSET_Su
 581 baseRegOffset SpLim                  = OFFSET_SpLim
 582 #ifdef OFFSET_Lng1
 583 baseRegOffset (LongReg _ ILIT(1))    = OFFSET_Lng1
 584 #endif
 585 #ifdef OFFSET_Lng2
 586 baseRegOffset (LongReg _ ILIT(2))    = OFFSET_Lng2
 587 #endif
 588 baseRegOffset Hp                     = OFFSET_Hp
 589 baseRegOffset HpLim                  = OFFSET_HpLim
 590 baseRegOffset CurrentTSO             = OFFSET_CurrentTSO
 591 baseRegOffset CurrentNursery         = OFFSET_CurrentNursery
 592 #ifdef DEBUG
 593 baseRegOffset BaseReg                = panic "baseRegOffset:BaseReg"
 594 baseRegOffset CurCostCentre          = panic "baseRegOffset:CurCostCentre"
 595 baseRegOffset VoidReg                = panic "baseRegOffset:VoidReg"
 596 #endif
 597 \end{code}
 598
 599 \begin{code}
 600 callerSaves :: MagicId -> Bool
 601
 602 #ifdef CALLER_SAVES_Base
 603 callerSaves BaseReg                     = True
 604 #endif
 605 #ifdef CALLER_SAVES_R1
 606 callerSaves (VanillaReg _ ILIT(1))      = True
 607 #endif
 608 #ifdef CALLER_SAVES_R2
 609 callerSaves (VanillaReg _ ILIT(2))      = True
 610 #endif
 611 #ifdef CALLER_SAVES_R3
 612 callerSaves (VanillaReg _ ILIT(3))      = True
 613 #endif
 614 #ifdef CALLER_SAVES_R4
 615 callerSaves (VanillaReg _ ILIT(4))      = True
 616 #endif
 617 #ifdef CALLER_SAVES_R5
 618 callerSaves (VanillaReg _ ILIT(5))      = True
 619 #endif
 620 #ifdef CALLER_SAVES_R6
 621 callerSaves (VanillaReg _ ILIT(6))      = True
 622 #endif
 623 #ifdef CALLER_SAVES_R7
 624 callerSaves (VanillaReg _ ILIT(7))      = True
 625 #endif
 626 #ifdef CALLER_SAVES_R8
 627 callerSaves (VanillaReg _ ILIT(8))      = True
 628 #endif
 629 #ifdef CALLER_SAVES_F1
 630 callerSaves (FloatReg ILIT(1))          = True
 631 #endif
 632 #ifdef CALLER_SAVES_F2
 633 callerSaves (FloatReg ILIT(2))          = True
 634 #endif
 635 #ifdef CALLER_SAVES_F3
 636 callerSaves (FloatReg ILIT(3))          = True
 637 #endif
 638 #ifdef CALLER_SAVES_F4
 639 callerSaves (FloatReg ILIT(4))          = True
 640 #endif
 641 #ifdef CALLER_SAVES_D1
 642 callerSaves (DoubleReg ILIT(1))         = True
 643 #endif
 644 #ifdef CALLER_SAVES_D2
 645 callerSaves (DoubleReg ILIT(2))         = True
 646 #endif
 647 #ifdef CALLER_SAVES_L1
 648 callerSaves (LongReg _ ILIT(1))         = True
 649 #endif
 650 #ifdef CALLER_SAVES_Sp
 651 callerSaves Sp                          = True
 652 #endif
 653 #ifdef CALLER_SAVES_Su
 654 callerSaves Su                          = True
 655 #endif
 656 #ifdef CALLER_SAVES_SpLim
 657 callerSaves SpLim                       = True
 658 #endif
 659 #ifdef CALLER_SAVES_Hp
 660 callerSaves Hp                          = True
 661 #endif
 662 #ifdef CALLER_SAVES_HpLim
 663 callerSaves HpLim                       = True
 664 #endif
 665 #ifdef CALLER_SAVES_CurrentTSO
 666 callerSaves CurrentTSO                  = True
 667 #endif
 668 #ifdef CALLER_SAVES_CurrentNursery
 669 callerSaves CurrentNursery              = True
 670 #endif
 671 callerSaves _                           = False
 672 \end{code}
 673
 674 \begin{code}
 675 magicIdRegMaybe :: MagicId -> Maybe Reg
 676
 677 #ifdef REG_Base
 678 magicIdRegMaybe BaseReg                 = Just (FixedReg ILIT(REG_Base))
 679 #endif
 680 #ifdef REG_R1
 681 magicIdRegMaybe (VanillaReg _ ILIT(1))  = Just (FixedReg ILIT(REG_R1))
 682 #endif
 683 #ifdef REG_R2
 684 magicIdRegMaybe (VanillaReg _ ILIT(2))  = Just (FixedReg ILIT(REG_R2))
 685 #endif
 686 #ifdef REG_R3
 687 magicIdRegMaybe (VanillaReg _ ILIT(3))  = Just (FixedReg ILIT(REG_R3))
 688 #endif
 689 #ifdef REG_R4
 690 magicIdRegMaybe (VanillaReg _ ILIT(4))  = Just (FixedReg ILIT(REG_R4))
 691 #endif
 692 #ifdef REG_R5
 693 magicIdRegMaybe (VanillaReg _ ILIT(5))  = Just (FixedReg ILIT(REG_R5))
 694 #endif
 695 #ifdef REG_R6
 696 magicIdRegMaybe (VanillaReg _ ILIT(6))  = Just (FixedReg ILIT(REG_R6))
 697 #endif
 698 #ifdef REG_R7
 699 magicIdRegMaybe (VanillaReg _ ILIT(7))  = Just (FixedReg ILIT(REG_R7))
 700 #endif
 701 #ifdef REG_R8
 702 magicIdRegMaybe (VanillaReg _ ILIT(8))  = Just (FixedReg ILIT(REG_R8))
 703 #endif
 704 #ifdef REG_R9
 705 magicIdRegMaybe (VanillaReg _ ILIT(9))  = Just (FixedReg ILIT(REG_R9))
 706 #endif
 707 #ifdef REG_R10
 708 magicIdRegMaybe (VanillaReg _ ILIT(10)) = Just (FixedReg ILIT(REG_R10))
 709 #endif
 710 #ifdef REG_F1
 711 magicIdRegMaybe (FloatReg ILIT(1))      = Just (FixedReg ILIT(REG_F1))
 712 #endif
 713 #ifdef REG_F2
 714 magicIdRegMaybe (FloatReg ILIT(2))      = Just (FixedReg ILIT(REG_F2))
 715 #endif
 716 #ifdef REG_F3
 717 magicIdRegMaybe (FloatReg ILIT(3))      = Just (FixedReg ILIT(REG_F3))
 718 #endif
 719 #ifdef REG_F4
 720 magicIdRegMaybe (FloatReg ILIT(4))      = Just (FixedReg ILIT(REG_F4))
 721 #endif
 722 #ifdef REG_D1
 723 magicIdRegMaybe (DoubleReg ILIT(1))     = Just (FixedReg ILIT(REG_D1))
 724 #endif
 725 #ifdef REG_D2
 726 magicIdRegMaybe (DoubleReg ILIT(2))     = Just (FixedReg ILIT(REG_D2))
 727 #endif
 728 #ifdef REG_Sp
 729 magicIdRegMaybe Sp                      = Just (FixedReg ILIT(REG_Sp))
 730 #endif
 731 #ifdef REG_Lng1
 732 magicIdRegMaybe (LongReg _ ILIT(1))     = Just (FixedReg ILIT(REG_Lng1))
 733 #endif
 734 #ifdef REG_Lng2
 735 magicIdRegMaybe (LongReg _ ILIT(2))     = Just (FixedReg ILIT(REG_Lng2))
 736 #endif
 737 #ifdef REG_Su
 738 magicIdRegMaybe Su                      = Just (FixedReg ILIT(REG_Su))
 739 #endif
 740 #ifdef REG_SpLim
 741 magicIdRegMaybe SpLim                   = Just (FixedReg ILIT(REG_SpLim))
 742 #endif
 743 #ifdef REG_Hp
 744 magicIdRegMaybe Hp                      = Just (FixedReg ILIT(REG_Hp))
 745 #endif
 746 #ifdef REG_HpLim
 747 magicIdRegMaybe HpLim                   = Just (FixedReg ILIT(REG_HpLim))
 748 #endif
 749 #ifdef REG_CurrentTSO
 750 magicIdRegMaybe CurrentTSO              = Just (FixedReg ILIT(REG_CurrentTSO))
 751 #endif
 752 #ifdef REG_CurrentNursery
 753 magicIdRegMaybe CurrentNursery          = Just (FixedReg ILIT(REG_CurrentNursery))
 754 #endif
 755 magicIdRegMaybe _                       = Nothing
 756 \end{code}
 757
 758 \begin{code}
 759 -------------------------------
 760 freeRegs :: [Reg]
 761 freeRegs
 762   = freeMappedRegs IF_ARCH_alpha( [0..63],
 763                    IF_ARCH_i386(  [0..13],
 764                    IF_ARCH_sparc( [0..63],)))
 765
 766 -------------------------------
 767 callClobberedRegs :: [Reg]
 768 callClobberedRegs
 769   = freeMappedRegs
 770 #if alpha_TARGET_ARCH
 771     [0, 1, 2, 3, 4, 5, 6, 7, 8,
 772      16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
 773      fReg 0, fReg 1, fReg 10, fReg 11, fReg 12, fReg 13, fReg 14, fReg 15,
 774      fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21, fReg 22, fReg 23,
 775      fReg 24, fReg 25, fReg 26, fReg 27, fReg 28, fReg 29, fReg 30]
 776 #endif {- alpha_TARGET_ARCH -}
 777 #if i386_TARGET_ARCH
 778     [{-none-}]
 779 #endif {- i386_TARGET_ARCH -}
 780 #if sparc_TARGET_ARCH
 781     ( oReg 7 :
 782       [oReg i | i <- [0..5]] ++
 783       [gReg i | i <- [1..7]] ++
 784       [fReg i | i <- [0..31]] )
 785 #endif {- sparc_TARGET_ARCH -}
 786
 787 -------------------------------
 788 argRegs :: Int -> [Reg]
 789
 790 argRegs 0 = []
 791 #if i386_TARGET_ARCH
 792 argRegs _ = panic "MachRegs.argRegs: doesn't work on I386"
 793 #else
 794 #if alpha_TARGET_ARCH
 795 argRegs 1 = freeMappedRegs [16, fReg 16]
 796 argRegs 2 = freeMappedRegs [16, 17, fReg 16, fReg 17]
 797 argRegs 3 = freeMappedRegs [16, 17, 18, fReg 16, fReg 17, fReg 18]
 798 argRegs 4 = freeMappedRegs [16, 17, 18, 19, fReg 16, fReg 17, fReg 18, fReg 19]
 799 argRegs 5 = freeMappedRegs [16, 17, 18, 19, 20, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20]
 800 argRegs 6 = freeMappedRegs [16, 17, 18, 19, 20, 21, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21]
 801 #endif {- alpha_TARGET_ARCH -}
 802 #if sparc_TARGET_ARCH
 803 argRegs 1 = freeMappedRegs (map oReg [0])
 804 argRegs 2 = freeMappedRegs (map oReg [0,1])
 805 argRegs 3 = freeMappedRegs (map oReg [0,1,2])
 806 argRegs 4 = freeMappedRegs (map oReg [0,1,2,3])
 807 argRegs 5 = freeMappedRegs (map oReg [0,1,2,3,4])
 808 argRegs 6 = freeMappedRegs (map oReg [0,1,2,3,4,5])
 809 #endif {- sparc_TARGET_ARCH -}
 810 argRegs _ = panic "MachRegs.argRegs: don't know about >6 arguments!"
 811 #endif {- i386_TARGET_ARCH -}
 812
 813 -------------------------------
 814
 815 #if alpha_TARGET_ARCH
 816 allArgRegs :: [(Reg, Reg)]
 817
 818 allArgRegs = [(realReg i, realReg (fReg i)) | i <- [16..21]]
 819 #endif {- alpha_TARGET_ARCH -}
 820
 821 #if sparc_TARGET_ARCH
 822 allArgRegs :: [Reg]
 823
 824 allArgRegs = map realReg [oReg i | i <- [0..5]]
 825 #endif {- sparc_TARGET_ARCH -}
 826
 827 -------------------------------
 828 freeMappedRegs :: [Int] -> [Reg]
 829
 830 freeMappedRegs nums
 831   = foldr free [] nums
 832   where
 833     free IBOX(i) acc
 834       = if _IS_TRUE_(freeReg i) then (MappedReg i) : acc else acc
 835 \end{code}
 836
 837 \begin{code}
 838 freeReg :: FAST_INT -> FAST_BOOL
 839
 840 #if alpha_TARGET_ARCH
 841 freeReg ILIT(26) = _FALSE_  -- return address (ra)
 842 freeReg ILIT(28) = _FALSE_  -- reserved for the assembler (at)
 843 freeReg ILIT(29) = _FALSE_  -- global pointer (gp)
 844 freeReg ILIT(30) = _FALSE_  -- stack pointer (sp)
 845 freeReg ILIT(31) = _FALSE_  -- always zero (zeroh)
 846 freeReg ILIT(63) = _FALSE_  -- always zero (f31)
 847 #endif
 848
 849 #if i386_TARGET_ARCH
 850 freeReg ILIT(esp) = _FALSE_  -- %esp is the C stack pointer
 851 #endif
 852
 853 #if sparc_TARGET_ARCH
 854 freeReg ILIT(g0) = _FALSE_  --  %g0 is always 0.
 855 freeReg ILIT(g5) = _FALSE_  --  %g5 is reserved (ABI).
 856 freeReg ILIT(g6) = _FALSE_  --  %g6 is reserved (ABI).
 857 freeReg ILIT(g7) = _FALSE_  --  %g7 is reserved (ABI).
 858 freeReg ILIT(i6) = _FALSE_  --  %i6 is our frame pointer.
 859 freeReg ILIT(o6) = _FALSE_  --  %o6 is our stack pointer.
 860 #endif
 861
 862 #ifdef REG_Base
 863 freeReg ILIT(REG_Base) = _FALSE_
 864 #endif
 865 #ifdef REG_R1
 866 freeReg ILIT(REG_R1)   = _FALSE_
 867 #endif
 868 #ifdef REG_R2
 869 freeReg ILIT(REG_R2)   = _FALSE_
 870 #endif
 871 #ifdef REG_R3
 872 freeReg ILIT(REG_R3)   = _FALSE_
 873 #endif
 874 #ifdef REG_R4
 875 freeReg ILIT(REG_R4)   = _FALSE_
 876 #endif
 877 #ifdef REG_R5
 878 freeReg ILIT(REG_R5)   = _FALSE_
 879 #endif
 880 #ifdef REG_R6
 881 freeReg ILIT(REG_R6)   = _FALSE_
 882 #endif
 883 #ifdef REG_R7
 884 freeReg ILIT(REG_R7)   = _FALSE_
 885 #endif
 886 #ifdef REG_R8
 887 freeReg ILIT(REG_R8)   = _FALSE_
 888 #endif
 889 #ifdef REG_F1
 890 freeReg ILIT(REG_F1) = _FALSE_
 891 #endif
 892 #ifdef REG_F2
 893 freeReg ILIT(REG_F2) = _FALSE_
 894 #endif
 895 #ifdef REG_F3
 896 freeReg ILIT(REG_F3) = _FALSE_
 897 #endif
 898 #ifdef REG_F4
 899 freeReg ILIT(REG_F4) = _FALSE_
 900 #endif
 901 #ifdef REG_D1
 902 freeReg ILIT(REG_D1) = _FALSE_
 903 #endif
 904 #ifdef REG_D2
 905 freeReg ILIT(REG_D2) = _FALSE_
 906 #endif
 907 #ifdef REG_Sp
 908 freeReg ILIT(REG_Sp)   = _FALSE_
 909 #endif
 910 #ifdef REG_Su
 911 freeReg ILIT(REG_Su)   = _FALSE_
 912 #endif
 913 #ifdef REG_SpLim
 914 freeReg ILIT(REG_SpLim) = _FALSE_
 915 #endif
 916 #ifdef REG_Hp
 917 freeReg ILIT(REG_Hp)   = _FALSE_
 918 #endif
 919 #ifdef REG_HpLim
 920 freeReg ILIT(REG_HpLim) = _FALSE_
 921 #endif
 922 freeReg n
 923   -- we hang onto two double regs for dedicated
 924   -- use; this is not necessary on Alphas and
 925   -- may not be on other non-SPARCs.
 926 #ifdef REG_D1
 927   | n _EQ_ (ILIT(REG_D1) _ADD_ ILIT(1)) = _FALSE_
 928 #endif
 929 #ifdef REG_D2
 930   | n _EQ_ (ILIT(REG_D2) _ADD_ ILIT(1)) = _FALSE_
 931 #endif
 932   | otherwise = _TRUE_
 933 \end{code}