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         freeMappedRegs,
  30         freeReg, freeRegs,
  31         getNewRegNCG,
  32         magicIdRegMaybe,
  33         mkReg,
  34         realReg,
  35         reservedRegs,
  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 \end{code}
 340
 341 ** Machine-specific Reg stuff: **
 342
 343 The Alpha has 64 registers of interest; 32 integer registers and 32 floating
 344 point registers.  The mapping of STG registers to alpha machine registers
 345 is defined in StgRegs.h.  We are, of course, prepared for any eventuality.
 346 \begin{code}
 347 #if alpha_TARGET_ARCH
 348 fReg :: Int -> Int
 349 fReg x = (32 + x)
 350
 351 v0, f0, ra, pv, gp, sp, zeroh :: Reg
 352 v0    = realReg 0
 353 f0    = realReg (fReg 0)
 354 ra    = FixedReg ILIT(26)
 355 pv    = t12
 356 gp    = FixedReg ILIT(29)
 357 sp    = FixedReg ILIT(30)
 358 zeroh = FixedReg ILIT(31) -- "zero" is used in 1.3 (MonadZero method)
 359
 360 t9, t10, t11, t12 :: Reg
 361 t9  = realReg 23
 362 t10 = realReg 24
 363 t11 = realReg 25
 364 t12 = realReg 27
 365 #endif
 366 \end{code}
 367
 368 Intel x86 architecture:
 369 - All registers except 7 (esp) are available for use.
 370 - Only ebx, esi, edi and esp are available across a C call (they are callee-saves).
 371 - Registers 0-7 have 16-bit counterparts (ax, bx etc.)
 372 - Registers 0-3 have 8 bit counterparts (ah, bh etc.)
 373 - Registers 8-13 are fakes; we pretend x86 has 6 conventionally-addressable
 374   fp registers, and 3-operand insns for them, and we translate this into
 375   real stack-based x86 fp code after register allocation.
 376
 377 \begin{code}
 378 #if i386_TARGET_ARCH
 379
 380 gReg,fReg :: Int -> Int
 381 gReg x = x
 382 fReg x = (8 + x)
 383
 384 fake0, fake1, fake2, fake3, fake4, fake5, eax, ebx, ecx, edx, esp :: Reg
 385 eax = realReg (gReg 0)
 386 ebx = realReg (gReg 1)
 387 ecx = realReg (gReg 2)
 388 edx = realReg (gReg 3)
 389 esi = realReg (gReg 4)
 390 edi = realReg (gReg 5)
 391 ebp = realReg (gReg 6)
 392 esp = realReg (gReg 7)
 393 fake0 = realReg (fReg 0)
 394 fake1 = realReg (fReg 1)
 395 fake2 = realReg (fReg 2)
 396 fake3 = realReg (fReg 3)
 397 fake4 = realReg (fReg 4)
 398 fake5 = realReg (fReg 5)
 399 #endif
 400 \end{code}
 401
 402 The SPARC has 64 registers of interest; 32 integer registers and 32
 403 floating point registers.  The mapping of STG registers to SPARC
 404 machine registers is defined in StgRegs.h.  We are, of course,
 405 prepared for any eventuality.
 406
 407 \begin{code}
 408 #if sparc_TARGET_ARCH
 409
 410 gReg,lReg,iReg,oReg,fReg :: Int -> Int
 411 gReg x = x
 412 oReg x = (8 + x)
 413 lReg x = (16 + x)
 414 iReg x = (24 + x)
 415 fReg x = (32 + x)
 416
 417 fPair :: Reg -> Reg
 418 fPair (FixedReg i) = FixedReg (i _ADD_ ILIT(1))
 419 fPair (MappedReg i) = MappedReg (i _ADD_ ILIT(1))
 420
 421 g0, fp, sp, o0, f0 :: Reg
 422 g0 = case (gReg 0) of { IBOX(g0) -> FixedReg g0 }
 423 fp = case (iReg 6) of { IBOX(i6) -> FixedReg i6 }
 424 sp = case (oReg 6) of { IBOX(o6) -> FixedReg o6 }
 425 o0 = realReg  (oReg 0)
 426 f0 = realReg  (fReg 0)
 427
 428 #endif
 429 \end{code}
 430
 431 Redefine the literals used for machine-registers with non-numeric
 432 names in the header files.  Gag me with a spoon, eh?
 433 \begin{code}
 434 #if alpha_TARGET_ARCH
 435 #define f0 32
 436 #define f1 33
 437 #define f2 34
 438 #define f3 35
 439 #define f4 36
 440 #define f5 37
 441 #define f6 38
 442 #define f7 39
 443 #define f8 40
 444 #define f9 41
 445 #define f10 42
 446 #define f11 43
 447 #define f12 44
 448 #define f13 45
 449 #define f14 46
 450 #define f15 47
 451 #define f16 48
 452 #define f17 49
 453 #define f18 50
 454 #define f19 51
 455 #define f20 52
 456 #define f21 53
 457 #define f22 54
 458 #define f23 55
 459 #define f24 56
 460 #define f25 57
 461 #define f26 58
 462 #define f27 59
 463 #define f28 60
 464 #define f29 61
 465 #define f30 62
 466 #define f31 63
 467 #endif
 468 #if i386_TARGET_ARCH
 469 #define eax 0
 470 #define ebx 1
 471 #define ecx 2
 472 #define edx 3
 473 #define esi 4
 474 #define edi 5
 475 #define ebp 6
 476 #define esp 7
 477 #define fake0 8
 478 #define fake1 9
 479 #define fake2 10
 480 #define fake3 11
 481 #define fake4 12
 482 #define fake5 13
 483 #endif
 484 #if sparc_TARGET_ARCH
 485 #define g0 0
 486 #define g1 1
 487 #define g2 2
 488 #define g3 3
 489 #define g4 4
 490 #define g5 5
 491 #define g6 6
 492 #define g7 7
 493 #define o0 8
 494 #define o1 9
 495 #define o2 10
 496 #define o3 11
 497 #define o4 12
 498 #define o5 13
 499 #define o6 14
 500 #define o7 15
 501 #define l0 16
 502 #define l1 17
 503 #define l2 18
 504 #define l3 19
 505 #define l4 20
 506 #define l5 21
 507 #define l6 22
 508 #define l7 23
 509 #define i0 24
 510 #define i1 25
 511 #define i2 26
 512 #define i3 27
 513 #define i4 28
 514 #define i5 29
 515 #define i6 30
 516 #define i7 31
 517 #define f0 32
 518 #define f1 33
 519 #define f2 34
 520 #define f3 35
 521 #define f4 36
 522 #define f5 37
 523 #define f6 38
 524 #define f7 39
 525 #define f8 40
 526 #define f9 41
 527 #define f10 42
 528 #define f11 43
 529 #define f12 44
 530 #define f13 45
 531 #define f14 46
 532 #define f15 47
 533 #define f16 48
 534 #define f17 49
 535 #define f18 50
 536 #define f19 51
 537 #define f20 52
 538 #define f21 53
 539 #define f22 54
 540 #define f23 55
 541 #define f24 56
 542 #define f25 57
 543 #define f26 58
 544 #define f27 59
 545 #define f28 60
 546 #define f29 61
 547 #define f30 62
 548 #define f31 63
 549 #endif
 550 \end{code}
 551
 552 \begin{code}
 553 baseRegOffset :: MagicId -> Int
 554
 555 baseRegOffset (VanillaReg _ ILIT(1)) = OFFSET_R1
 556 baseRegOffset (VanillaReg _ ILIT(2)) = OFFSET_R2
 557 baseRegOffset (VanillaReg _ ILIT(3)) = OFFSET_R3
 558 baseRegOffset (VanillaReg _ ILIT(4)) = OFFSET_R4
 559 baseRegOffset (VanillaReg _ ILIT(5)) = OFFSET_R5
 560 baseRegOffset (VanillaReg _ ILIT(6)) = OFFSET_R6
 561 baseRegOffset (VanillaReg _ ILIT(7)) = OFFSET_R7
 562 baseRegOffset (VanillaReg _ ILIT(8)) = OFFSET_R8
 563 baseRegOffset (VanillaReg _ ILIT(9)) = OFFSET_R9
 564 baseRegOffset (VanillaReg _ ILIT(10)) = OFFSET_R10
 565 baseRegOffset (FloatReg  ILIT(1))    = OFFSET_F1
 566 baseRegOffset (FloatReg  ILIT(2))    = OFFSET_F2
 567 baseRegOffset (FloatReg  ILIT(3))    = OFFSET_F3
 568 baseRegOffset (FloatReg  ILIT(4))    = OFFSET_F4
 569 baseRegOffset (DoubleReg ILIT(1))    = OFFSET_D1
 570 baseRegOffset (DoubleReg ILIT(2))    = OFFSET_D2
 571 baseRegOffset Sp                     = OFFSET_Sp
 572 baseRegOffset Su                     = OFFSET_Su
 573 baseRegOffset SpLim                  = OFFSET_SpLim
 574 #ifdef OFFSET_Lng1
 575 baseRegOffset (LongReg _ ILIT(1))    = OFFSET_Lng1
 576 #endif
 577 #ifdef OFFSET_Lng2
 578 baseRegOffset (LongReg _ ILIT(2))    = OFFSET_Lng2
 579 #endif
 580 baseRegOffset Hp                     = OFFSET_Hp
 581 baseRegOffset HpLim                  = OFFSET_HpLim
 582 #ifdef DEBUG
 583 baseRegOffset BaseReg                = panic "baseRegOffset:BaseReg"
 584 baseRegOffset CurCostCentre          = panic "baseRegOffset:CurCostCentre"
 585 baseRegOffset VoidReg                = panic "baseRegOffset:VoidReg"
 586 #endif
 587 \end{code}
 588
 589 \begin{code}
 590 callerSaves :: MagicId -> Bool
 591
 592 #ifdef CALLER_SAVES_Base
 593 callerSaves BaseReg                     = True
 594 #endif
 595 #ifdef CALLER_SAVES_R1
 596 callerSaves (VanillaReg _ ILIT(1))      = True
 597 #endif
 598 #ifdef CALLER_SAVES_R2
 599 callerSaves (VanillaReg _ ILIT(2))      = True
 600 #endif
 601 #ifdef CALLER_SAVES_R3
 602 callerSaves (VanillaReg _ ILIT(3))      = True
 603 #endif
 604 #ifdef CALLER_SAVES_R4
 605 callerSaves (VanillaReg _ ILIT(4))      = True
 606 #endif
 607 #ifdef CALLER_SAVES_R5
 608 callerSaves (VanillaReg _ ILIT(5))      = True
 609 #endif
 610 #ifdef CALLER_SAVES_R6
 611 callerSaves (VanillaReg _ ILIT(6))      = True
 612 #endif
 613 #ifdef CALLER_SAVES_R7
 614 callerSaves (VanillaReg _ ILIT(7))      = True
 615 #endif
 616 #ifdef CALLER_SAVES_R8
 617 callerSaves (VanillaReg _ ILIT(8))      = True
 618 #endif
 619 #ifdef CALLER_SAVES_F1
 620 callerSaves (FloatReg ILIT(1))          = True
 621 #endif
 622 #ifdef CALLER_SAVES_F2
 623 callerSaves (FloatReg ILIT(2))          = True
 624 #endif
 625 #ifdef CALLER_SAVES_F3
 626 callerSaves (FloatReg ILIT(3))          = True
 627 #endif
 628 #ifdef CALLER_SAVES_F4
 629 callerSaves (FloatReg ILIT(4))          = True
 630 #endif
 631 #ifdef CALLER_SAVES_D1
 632 callerSaves (DoubleReg ILIT(1))         = True
 633 #endif
 634 #ifdef CALLER_SAVES_D2
 635 callerSaves (DoubleReg ILIT(2))         = True
 636 #endif
 637 #ifdef CALLER_SAVES_L1
 638 callerSaves (LongReg _ ILIT(1))         = True
 639 #endif
 640 #ifdef CALLER_SAVES_Sp
 641 callerSaves Sp                          = True
 642 #endif
 643 #ifdef CALLER_SAVES_Su
 644 callerSaves Su                          = True
 645 #endif
 646 #ifdef CALLER_SAVES_SpLim
 647 callerSaves SpLim                       = True
 648 #endif
 649 #ifdef CALLER_SAVES_Hp
 650 callerSaves Hp                          = True
 651 #endif
 652 #ifdef CALLER_SAVES_HpLim
 653 callerSaves HpLim                       = True
 654 #endif
 655 callerSaves _                           = False
 656 \end{code}
 657
 658 \begin{code}
 659 magicIdRegMaybe :: MagicId -> Maybe Reg
 660
 661 #ifdef REG_Base
 662 magicIdRegMaybe BaseReg                 = Just (FixedReg ILIT(REG_Base))
 663 #endif
 664 #ifdef REG_R1
 665 magicIdRegMaybe (VanillaReg _ ILIT(1))  = Just (FixedReg ILIT(REG_R1))
 666 #endif
 667 #ifdef REG_R2
 668 magicIdRegMaybe (VanillaReg _ ILIT(2))  = Just (FixedReg ILIT(REG_R2))
 669 #endif
 670 #ifdef REG_R3
 671 magicIdRegMaybe (VanillaReg _ ILIT(3))  = Just (FixedReg ILIT(REG_R3))
 672 #endif
 673 #ifdef REG_R4
 674 magicIdRegMaybe (VanillaReg _ ILIT(4))  = Just (FixedReg ILIT(REG_R4))
 675 #endif
 676 #ifdef REG_R5
 677 magicIdRegMaybe (VanillaReg _ ILIT(5))  = Just (FixedReg ILIT(REG_R5))
 678 #endif
 679 #ifdef REG_R6
 680 magicIdRegMaybe (VanillaReg _ ILIT(6))  = Just (FixedReg ILIT(REG_R6))
 681 #endif
 682 #ifdef REG_R7
 683 magicIdRegMaybe (VanillaReg _ ILIT(7))  = Just (FixedReg ILIT(REG_R7))
 684 #endif
 685 #ifdef REG_R8
 686 magicIdRegMaybe (VanillaReg _ ILIT(8))  = Just (FixedReg ILIT(REG_R8))
 687 #endif
 688 #ifdef REG_R9
 689 magicIdRegMaybe (VanillaReg _ ILIT(9))  = Just (FixedReg ILIT(REG_R9))
 690 #endif
 691 #ifdef REG_R10
 692 magicIdRegMaybe (VanillaReg _ ILIT(10)) = Just (FixedReg ILIT(REG_R10))
 693 #endif
 694 #ifdef REG_F1
 695 magicIdRegMaybe (FloatReg ILIT(1))      = Just (FixedReg ILIT(REG_F1))
 696 #endif
 697 #ifdef REG_F2
 698 magicIdRegMaybe (FloatReg ILIT(2))      = Just (FixedReg ILIT(REG_F2))
 699 #endif
 700 #ifdef REG_F3
 701 magicIdRegMaybe (FloatReg ILIT(3))      = Just (FixedReg ILIT(REG_F3))
 702 #endif
 703 #ifdef REG_F4
 704 magicIdRegMaybe (FloatReg ILIT(4))      = Just (FixedReg ILIT(REG_F4))
 705 #endif
 706 #ifdef REG_D1
 707 magicIdRegMaybe (DoubleReg ILIT(1))     = Just (FixedReg ILIT(REG_D1))
 708 #endif
 709 #ifdef REG_D2
 710 magicIdRegMaybe (DoubleReg ILIT(2))     = Just (FixedReg ILIT(REG_D2))
 711 #endif
 712 #ifdef REG_Sp
 713 magicIdRegMaybe Sp                      = Just (FixedReg ILIT(REG_Sp))
 714 #endif
 715 #ifdef REG_Lng1
 716 magicIdRegMaybe (LongReg _ ILIT(1))     = Just (FixedReg ILIT(REG_Lng1))
 717 #endif
 718 #ifdef REG_Lng2
 719 magicIdRegMaybe (LongReg _ ILIT(2))     = Just (FixedReg ILIT(REG_Lng2))
 720 #endif
 721 #ifdef REG_Su
 722 magicIdRegMaybe Su                      = Just (FixedReg ILIT(REG_Su))
 723 #endif
 724 #ifdef REG_SpLim
 725 magicIdRegMaybe SpLim                   = Just (FixedReg ILIT(REG_SpLim))
 726 #endif
 727 #ifdef REG_Hp
 728 magicIdRegMaybe Hp                      = Just (FixedReg ILIT(REG_Hp))
 729 #endif
 730 #ifdef REG_HpLim
 731 magicIdRegMaybe HpLim                   = Just (FixedReg ILIT(REG_HpLim))
 732 #endif
 733 magicIdRegMaybe _                       = Nothing
 734 \end{code}
 735
 736 %************************************************************************
 737 %*                                                                      *
 738 \subsection{Free, reserved, call-clobbered, and argument registers}
 739 %*                                                                      *
 740 %************************************************************************
 741
 742 @freeRegs@ is the list of registers we can use in register allocation.
 743 @freeReg@ (below) says if a particular register is free.
 744
 745 With a per-instruction clobber list, we might be able to get some of
 746 these back, but it's probably not worth the hassle.
 747
 748 @callClobberedRegs@ ... the obvious.
 749
 750 @argRegs@: assuming a call with N arguments, what registers will be
 751 used to hold arguments?  (NB: it doesn't know whether the arguments
 752 are integer or floating-point...)
 753
 754 \begin{code}
 755 reservedRegs :: [RegNo]
 756 reservedRegs
 757 #if alpha_TARGET_ARCH
 758   = [NCG_Reserved_I1, NCG_Reserved_I2,
 759      NCG_Reserved_F1, NCG_Reserved_F2]
 760 #endif
 761 #if i386_TARGET_ARCH
 762   = [{-certainly cannot afford any!-}]
 763 #endif
 764 #if sparc_TARGET_ARCH
 765   = [NCG_Reserved_I1, NCG_Reserved_I2,
 766      NCG_Reserved_F1, NCG_Reserved_F2,
 767      NCG_Reserved_D1, NCG_Reserved_D2]
 768 #endif
 769
 770 -------------------------------
 771 freeRegs :: [Reg]
 772 freeRegs
 773   = freeMappedRegs IF_ARCH_alpha( [0..63],
 774                    IF_ARCH_i386(  [0..13],
 775                    IF_ARCH_sparc( [0..63],)))
 776
 777 -------------------------------
 778 callClobberedRegs :: [Reg]
 779 callClobberedRegs
 780   = freeMappedRegs
 781 #if alpha_TARGET_ARCH
 782     [0, 1, 2, 3, 4, 5, 6, 7, 8,
 783      16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
 784      fReg 0, fReg 1, fReg 10, fReg 11, fReg 12, fReg 13, fReg 14, fReg 15,
 785      fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21, fReg 22, fReg 23,
 786      fReg 24, fReg 25, fReg 26, fReg 27, fReg 28, fReg 29, fReg 30]
 787 #endif {- alpha_TARGET_ARCH -}
 788 #if i386_TARGET_ARCH
 789     [{-none-}]
 790 #endif {- i386_TARGET_ARCH -}
 791 #if sparc_TARGET_ARCH
 792     ( oReg 7 :
 793       [oReg i | i <- [0..5]] ++
 794       [gReg i | i <- [1..7]] ++
 795       [fReg i | i <- [0..31]] )
 796 #endif {- sparc_TARGET_ARCH -}
 797
 798 -------------------------------
 799 argRegs :: Int -> [Reg]
 800
 801 argRegs 0 = []
 802 #if i386_TARGET_ARCH
 803 argRegs _ = panic "MachRegs.argRegs: doesn't work on I386"
 804 #else
 805 #if alpha_TARGET_ARCH
 806 argRegs 1 = freeMappedRegs [16, fReg 16]
 807 argRegs 2 = freeMappedRegs [16, 17, fReg 16, fReg 17]
 808 argRegs 3 = freeMappedRegs [16, 17, 18, fReg 16, fReg 17, fReg 18]
 809 argRegs 4 = freeMappedRegs [16, 17, 18, 19, fReg 16, fReg 17, fReg 18, fReg 19]
 810 argRegs 5 = freeMappedRegs [16, 17, 18, 19, 20, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20]
 811 argRegs 6 = freeMappedRegs [16, 17, 18, 19, 20, 21, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21]
 812 #endif {- alpha_TARGET_ARCH -}
 813 #if sparc_TARGET_ARCH
 814 argRegs 1 = freeMappedRegs (map oReg [0])
 815 argRegs 2 = freeMappedRegs (map oReg [0,1])
 816 argRegs 3 = freeMappedRegs (map oReg [0,1,2])
 817 argRegs 4 = freeMappedRegs (map oReg [0,1,2,3])
 818 argRegs 5 = freeMappedRegs (map oReg [0,1,2,3,4])
 819 argRegs 6 = freeMappedRegs (map oReg [0,1,2,3,4,5])
 820 #endif {- sparc_TARGET_ARCH -}
 821 argRegs _ = panic "MachRegs.argRegs: don't know about >6 arguments!"
 822 #endif {- i386_TARGET_ARCH -}
 823
 824 -------------------------------
 825
 826 #if alpha_TARGET_ARCH
 827 allArgRegs :: [(Reg, Reg)]
 828
 829 allArgRegs = [(realReg i, realReg (fReg i)) | i <- [16..21]]
 830 #endif {- alpha_TARGET_ARCH -}
 831
 832 #if sparc_TARGET_ARCH
 833 allArgRegs :: [Reg]
 834
 835 allArgRegs = map realReg [oReg i | i <- [0..5]]
 836 #endif {- sparc_TARGET_ARCH -}
 837
 838 -------------------------------
 839 freeMappedRegs :: [Int] -> [Reg]
 840
 841 freeMappedRegs nums
 842   = foldr free [] nums
 843   where
 844     free IBOX(i) acc
 845       = if _IS_TRUE_(freeReg i) then (MappedReg i) : acc else acc
 846 \end{code}
 847
 848 \begin{code}
 849 freeReg :: FAST_INT -> FAST_BOOL
 850
 851 #if alpha_TARGET_ARCH
 852 freeReg ILIT(26) = _FALSE_  -- return address (ra)
 853 freeReg ILIT(28) = _FALSE_  -- reserved for the assembler (at)
 854 freeReg ILIT(29) = _FALSE_  -- global pointer (gp)
 855 freeReg ILIT(30) = _FALSE_  -- stack pointer (sp)
 856 freeReg ILIT(31) = _FALSE_  -- always zero (zeroh)
 857 freeReg ILIT(63) = _FALSE_  -- always zero (f31)
 858 #endif
 859
 860 #if i386_TARGET_ARCH
 861 freeReg ILIT(esp) = _FALSE_  -- %esp is the C stack pointer
 862 #endif
 863
 864 #if sparc_TARGET_ARCH
 865 freeReg ILIT(g0) = _FALSE_  --  %g0 is always 0.
 866 freeReg ILIT(g5) = _FALSE_  --  %g5 is reserved (ABI).
 867 freeReg ILIT(g6) = _FALSE_  --  %g6 is reserved (ABI).
 868 freeReg ILIT(g7) = _FALSE_  --  %g7 is reserved (ABI).
 869 freeReg ILIT(i6) = _FALSE_  --  %i6 is our frame pointer.
 870 freeReg ILIT(o6) = _FALSE_  --  %o6 is our stack pointer.
 871 #endif
 872
 873 #ifdef REG_Base
 874 freeReg ILIT(REG_Base) = _FALSE_
 875 #endif
 876 #ifdef REG_R1
 877 freeReg ILIT(REG_R1)   = _FALSE_
 878 #endif
 879 #ifdef REG_R2
 880 freeReg ILIT(REG_R2)   = _FALSE_
 881 #endif
 882 #ifdef REG_R3
 883 freeReg ILIT(REG_R3)   = _FALSE_
 884 #endif
 885 #ifdef REG_R4
 886 freeReg ILIT(REG_R4)   = _FALSE_
 887 #endif
 888 #ifdef REG_R5
 889 freeReg ILIT(REG_R5)   = _FALSE_
 890 #endif
 891 #ifdef REG_R6
 892 freeReg ILIT(REG_R6)   = _FALSE_
 893 #endif
 894 #ifdef REG_R7
 895 freeReg ILIT(REG_R7)   = _FALSE_
 896 #endif
 897 #ifdef REG_R8
 898 freeReg ILIT(REG_R8)   = _FALSE_
 899 #endif
 900 #ifdef REG_F1
 901 freeReg ILIT(REG_F1) = _FALSE_
 902 #endif
 903 #ifdef REG_F2
 904 freeReg ILIT(REG_F2) = _FALSE_
 905 #endif
 906 #ifdef REG_F3
 907 freeReg ILIT(REG_F3) = _FALSE_
 908 #endif
 909 #ifdef REG_F4
 910 freeReg ILIT(REG_F4) = _FALSE_
 911 #endif
 912 #ifdef REG_D1
 913 freeReg ILIT(REG_D1) = _FALSE_
 914 #endif
 915 #ifdef REG_D2
 916 freeReg ILIT(REG_D2) = _FALSE_
 917 #endif
 918 #ifdef REG_Sp
 919 freeReg ILIT(REG_Sp)   = _FALSE_
 920 #endif
 921 #ifdef REG_Su
 922 freeReg ILIT(REG_Su)   = _FALSE_
 923 #endif
 924 #ifdef REG_SpLim
 925 freeReg ILIT(REG_SpLim) = _FALSE_
 926 #endif
 927 #ifdef REG_Hp
 928 freeReg ILIT(REG_Hp)   = _FALSE_
 929 #endif
 930 #ifdef REG_HpLim
 931 freeReg ILIT(REG_HpLim) = _FALSE_
 932 #endif
 933 freeReg n
 934   -- we hang onto two double regs for dedicated
 935   -- use; this is not necessary on Alphas and
 936   -- may not be on other non-SPARCs.
 937 #ifdef REG_D1
 938   | n _EQ_ (ILIT(REG_D1) _ADD_ ILIT(1)) = _FALSE_
 939 #endif
 940 #ifdef REG_D2
 941   | n _EQ_ (ILIT(REG_D2) _ADD_ ILIT(1)) = _FALSE_
 942 #endif
 943   | otherwise = _TRUE_
 944 \end{code}