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