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