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         dblImmLit,
  29         extractMappedRegNos,
  30         freeMappedRegs,
  31         freeReg, freeRegs,
  32         getNewRegNCG,
  33         magicIdRegMaybe,
  34         mkReg,
  35         realReg,
  36         reservedRegs,
  37         saveLoc,
  38         spRel,
  39         stgReg,
  40         strImmLit
  41
  42 #if alpha_TARGET_ARCH
  43         , allArgRegs
  44         , fits8Bits
  45         , fReg
  46         , gp, pv, ra, sp, t9, t10, t11, t12, v0, f0, zeroh
  47 #endif
  48 #if i386_TARGET_ARCH
  49         , eax, ebx, ecx, edx, esi, esp
  50         , st0, st1, st2, st3, st4, st5, st6, st7
  51 #endif
  52 #if sparc_TARGET_ARCH
  53         , allArgRegs
  54         , fits13Bits
  55         , fPair, fpRel, gReg, iReg, lReg, oReg, largeOffsetError
  56         , fp, g0, o0, f0
  57
  58 #endif
  59     ) where
  60
  61 #include "HsVersions.h"
  62
  63 import AbsCSyn          ( MagicId(..) )
  64 import AbsCUtils        ( magicIdPrimRep )
  65 import CLabel           ( CLabel )
  66 import PrimOp           ( PrimOp(..) )
  67 import PrimRep          ( PrimRep(..) )
  68 import Stix             ( sStLitLbl, StixTree(..), StixReg(..) )
  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   IF_ARCH_sparc(
  87   | LO Imm                  -- Possible restrictions...
  88   | HI Imm
  89   ,)
  90 strImmLit s = ImmLit (text s)
  91 dblImmLit r
  92   = strImmLit (
  93          IF_ARCH_alpha({-prepend nothing-}
  94         ,IF_ARCH_i386( '0' : 'd' :
  95         ,IF_ARCH_sparc('0' : 'r' :,)))
  96         showSDoc (rational r))
  97 \end{code}
  98
  99 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 100
 101 \begin{code}
 102 data MachRegsAddr
 103 #if alpha_TARGET_ARCH
 104   = AddrImm     Imm
 105   | AddrReg     Reg
 106   | AddrRegImm  Reg Imm
 107 #endif
 108
 109 #if i386_TARGET_ARCH
 110   = AddrBaseIndex       Base Index Displacement
 111   | ImmAddr             Imm Int
 112
 113 type Base         = Maybe Reg
 114 type Index        = Maybe (Reg, Int)    -- Int is 2, 4 or 8
 115 type Displacement = Imm
 116 #endif
 117
 118 #if sparc_TARGET_ARCH
 119   = AddrRegReg  Reg Reg
 120   | AddrRegImm  Reg Imm
 121 #endif
 122
 123 addrOffset :: MachRegsAddr -> Int -> Maybe MachRegsAddr
 124
 125 addrOffset addr off
 126   = case addr of
 127 #if alpha_TARGET_ARCH
 128       _ -> panic "MachMisc.addrOffset not defined for Alpha"
 129 #endif
 130 #if i386_TARGET_ARCH
 131       ImmAddr i off0      -> Just (ImmAddr i (off0 + off))
 132       AddrBaseIndex r i (ImmInt n) -> Just (AddrBaseIndex r i (ImmInt (n + off)))
 133       AddrBaseIndex r i (ImmInteger n)
 134         -> Just (AddrBaseIndex r i (ImmInt (fromInteger (n + toInteger off))))
 135       _ -> Nothing
 136 #endif
 137 #if sparc_TARGET_ARCH
 138       AddrRegImm r (ImmInt n)
 139        | fits13Bits n2 -> Just (AddrRegImm r (ImmInt n2))
 140        | otherwise     -> Nothing
 141        where n2 = n + off
 142
 143       AddrRegImm r (ImmInteger n)
 144        | fits13Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
 145        | otherwise     -> Nothing
 146        where n2 = n + toInteger off
 147
 148       AddrRegReg r (FixedReg ILIT(0))
 149        | fits13Bits off -> Just (AddrRegImm r (ImmInt off))
 150        | otherwise     -> Nothing
 151
 152       _ -> Nothing
 153
 154 #endif {-sparc-}
 155
 156 -----------------
 157 #if alpha_TARGET_ARCH
 158
 159 fits8Bits :: Integer -> Bool
 160 fits8Bits i = i >= -256 && i < 256
 161
 162 #endif
 163
 164 #if sparc_TARGET_ARCH
 165 {-# SPECIALIZE
 166     fits13Bits :: Int -> Bool
 167   #-}
 168 {-# SPECIALIZE
 169     fits13Bits :: Integer -> Bool
 170   #-}
 171
 172 fits13Bits :: Integral a => a -> Bool
 173 fits13Bits x = x >= -4096 && x < 4096
 174
 175 -----------------
 176 largeOffsetError i
 177   = 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")
 178
 179 #endif {-sparc-}
 180 \end{code}
 181
 182 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 183
 184 @stgReg@: we map STG registers onto appropriate Stix Trees.  First, we
 185 handle the two constants, @STK_STUB_closure@ and @vtbl_StdUpdFrame@.
 186 The rest are either in real machine registers or stored as offsets
 187 from BaseReg.
 188
 189 \begin{code}
 190 data RegLoc = Save StixTree | Always StixTree
 191 \end{code}
 192
 193 Trees for register save locations:
 194 \begin{code}
 195 saveLoc :: MagicId -> StixTree
 196
 197 saveLoc reg = case (stgReg reg) of {Always loc -> loc; Save loc -> loc}
 198 \end{code}
 199
 200 \begin{code}
 201 stgReg :: MagicId -> RegLoc
 202
 203 stgReg x
 204   = case (magicIdRegMaybe x) of
 205         Just _  -> Save   nonReg
 206         Nothing -> Always nonReg
 207   where
 208     offset = baseRegOffset x
 209
 210     baseLoc = case (magicIdRegMaybe BaseReg) of
 211       Just _  -> StReg (StixMagicId BaseReg)
 212       Nothing -> sStLitLbl SLIT("MainRegTable")
 213
 214     nonReg = case x of
 215       BaseReg           -> sStLitLbl SLIT("MainRegTable")
 216
 217       _ -> StInd (magicIdPrimRep x)
 218                  (StPrim IntAddOp [baseLoc,
 219                         StInt (toInteger (offset*BYTES_PER_WORD))])
 220 \end{code}
 221
 222 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 223
 224 @spRel@ gives us a stack relative addressing mode for volatile
 225 temporaries and for excess call arguments.  @fpRel@, where
 226 applicable, is the same but for the frame pointer.
 227
 228 \begin{code}
 229 spRel :: Int    -- desired stack offset in words, positive or negative
 230       -> MachRegsAddr
 231
 232 spRel n
 233 #if i386_TARGET_ARCH
 234   = AddrBaseIndex (Just esp) Nothing (ImmInt (n * BYTES_PER_WORD))
 235 #else
 236   = AddrRegImm sp (ImmInt (n * BYTES_PER_WORD))
 237 #endif
 238
 239 #if sparc_TARGET_ARCH
 240 fpRel :: Int -> MachRegsAddr
 241     -- Duznae work for offsets greater than 13 bits; we just hope for
 242     -- the best
 243 fpRel n
 244   = AddrRegImm fp (ImmInt (n * BYTES_PER_WORD))
 245 #endif
 246 \end{code}
 247
 248 %************************************************************************
 249 %*                                                                      *
 250 \subsection[Reg]{Real registers}
 251 %*                                                                      *
 252 %************************************************************************
 253
 254 Static Registers correspond to actual machine registers.  These should
 255 be avoided until the last possible moment.
 256
 257 Dynamic registers are allocated on the fly, usually to represent a single
 258 value in the abstract assembly code (i.e. dynamic registers are usually
 259 single assignment).  Ultimately, they are mapped to available machine
 260 registers before spitting out the code.
 261
 262 \begin{code}
 263 data Reg
 264   = FixedReg  FAST_INT          -- A pre-allocated machine register
 265
 266   | MappedReg FAST_INT          -- A dynamically allocated machine register
 267
 268   | MemoryReg Int PrimRep       -- A machine "register" actually held in
 269                                 -- a memory allocated table of
 270                                 -- registers which didn't fit in real
 271                                 -- registers.
 272
 273   | UnmappedReg Unique PrimRep  -- One of an infinite supply of registers,
 274                                 -- always mapped to one of the earlier
 275                                 -- two (?)  before we're done.
 276 mkReg :: Unique -> PrimRep -> Reg
 277 mkReg = UnmappedReg
 278
 279 getNewRegNCG :: PrimRep -> UniqSM Reg
 280 getNewRegNCG pk
 281   = getUniqueUs `thenUs` \ u ->
 282     returnUs (UnmappedReg u pk)
 283
 284 instance Text Reg where
 285     showsPrec _ (FixedReg i)    = showString "%"  . shows IBOX(i)
 286     showsPrec _ (MappedReg i)   = showString "%"  . shows IBOX(i)
 287     showsPrec _ (MemoryReg i _) = showString "%M"  . shows i
 288     showsPrec _ (UnmappedReg i _) = showString "%U" . shows i
 289
 290 #ifdef DEBUG
 291 instance Outputable Reg where
 292     ppr r = text (show r)
 293 #endif
 294
 295 cmpReg (FixedReg i)      (FixedReg i')      = cmp_ihash i i'
 296 cmpReg (MappedReg i)     (MappedReg i')     = cmp_ihash i i'
 297 cmpReg (MemoryReg i _)   (MemoryReg i' _)   = i `compare` i'
 298 cmpReg (UnmappedReg u _) (UnmappedReg u' _) = compare u u'
 299 cmpReg r1 r2
 300   = let tag1 = tagReg r1
 301         tag2 = tagReg r2
 302     in
 303         if tag1 _LT_ tag2 then LT else GT
 304     where
 305         tagReg (FixedReg _)      = (ILIT(1) :: FAST_INT)
 306         tagReg (MappedReg _)     = ILIT(2)
 307         tagReg (MemoryReg _ _)   = ILIT(3)
 308         tagReg (UnmappedReg _ _) = ILIT(4)
 309
 310 cmp_ihash :: FAST_INT -> FAST_INT -> Ordering
 311 cmp_ihash a1 a2 = if a1 _EQ_ a2 then EQ else if a1 _LT_ a2 then LT else GT
 312
 313 instance Eq Reg where
 314     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
 315     a /= b = case (a `compare` b) of { EQ -> False; _ -> True  }
 316
 317 instance Ord Reg where
 318     a <= b = case (a `compare` b) of { LT -> True;      EQ -> True;  GT -> False }
 319     a <  b = case (a `compare` b) of { LT -> True;      EQ -> False; GT -> False }
 320     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 321     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 322     compare a b = cmpReg a b
 323
 324 instance Uniquable Reg where
 325     getUnique (UnmappedReg u _) = u
 326     getUnique (FixedReg i)      = mkPseudoUnique1 IBOX(i)
 327     getUnique (MappedReg i)     = mkPseudoUnique2 IBOX(i)
 328     getUnique (MemoryReg i _)   = mkPseudoUnique3 i
 329 \end{code}
 330
 331 \begin{code}
 332 type RegNo = Int
 333
 334 realReg :: RegNo -> Reg
 335 realReg n@IBOX(i)
 336   = if _IS_TRUE_(freeReg i) then MappedReg i else FixedReg i
 337
 338 extractMappedRegNos :: [Reg] -> [RegNo]
 339
 340 extractMappedRegNos regs
 341   = foldr ex [] regs
 342   where
 343     ex (MappedReg i) acc = IBOX(i) : acc  -- we'll take it
 344     ex _             acc = acc            -- leave it out
 345 \end{code}
 346
 347 ** Machine-specific Reg stuff: **
 348
 349 The Alpha has 64 registers of interest; 32 integer registers and 32 floating
 350 point registers.  The mapping of STG registers to alpha machine registers
 351 is defined in StgRegs.h.  We are, of course, prepared for any eventuality.
 352 \begin{code}
 353 #if alpha_TARGET_ARCH
 354 fReg :: Int -> Int
 355 fReg x = (32 + x)
 356
 357 v0, f0, ra, pv, gp, sp, zeroh :: Reg
 358 v0    = realReg 0
 359 f0    = realReg (fReg 0)
 360 ra    = FixedReg ILIT(26)
 361 pv    = t12
 362 gp    = FixedReg ILIT(29)
 363 sp    = FixedReg ILIT(30)
 364 zeroh = FixedReg ILIT(31) -- "zero" is used in 1.3 (MonadZero method)
 365
 366 t9, t10, t11, t12 :: Reg
 367 t9  = realReg 23
 368 t10 = realReg 24
 369 t11 = realReg 25
 370 t12 = realReg 27
 371 #endif
 372 \end{code}
 373
 374 Intel x86 architecture:
 375 - All registers except 7 (esp) are available for use.
 376 - Only ebx, esi, edi and esp are available across a C call (they are callee-saves).
 377 - Registers 0-7 have 16-bit counterparts (ax, bx etc.)
 378 - Registers 0-3 have 8 bit counterparts (ah, bh etc.)
 379 - Registers 8-15 hold extended floating point values.
 380 \begin{code}
 381 #if i386_TARGET_ARCH
 382
 383 gReg,fReg :: Int -> Int
 384 gReg x = x
 385 fReg x = (8 + x)
 386
 387 st0, st1, st2, st3, st4, st5, st6, st7, eax, ebx, ecx, edx, esp :: Reg
 388 eax = realReg (gReg 0)
 389 ebx = realReg (gReg 1)
 390 ecx = realReg (gReg 2)
 391 edx = realReg (gReg 3)
 392 esi = realReg (gReg 4)
 393 edi = realReg (gReg 5)
 394 ebp = realReg (gReg 6)
 395 esp = realReg (gReg 7)
 396 st0 = realReg (fReg 0)
 397 st1 = realReg (fReg 1)
 398 st2 = realReg (fReg 2)
 399 st3 = realReg (fReg 3)
 400 st4 = realReg (fReg 4)
 401 st5 = realReg (fReg 5)
 402 st6 = realReg (fReg 6)
 403 st7 = realReg (fReg 7)
 404
 405 #endif
 406 \end{code}
 407
 408 The SPARC has 64 registers of interest; 32 integer registers and 32
 409 floating point registers.  The mapping of STG registers to SPARC
 410 machine registers is defined in StgRegs.h.  We are, of course,
 411 prepared for any eventuality.
 412
 413 \begin{code}
 414 #if sparc_TARGET_ARCH
 415
 416 gReg,lReg,iReg,oReg,fReg :: Int -> Int
 417 gReg x = x
 418 oReg x = (8 + x)
 419 lReg x = (16 + x)
 420 iReg x = (24 + x)
 421 fReg x = (32 + x)
 422
 423 fPair :: Reg -> Reg
 424 fPair (FixedReg i) = FixedReg (i _ADD_ ILIT(1))
 425 fPair (MappedReg i) = MappedReg (i _ADD_ ILIT(1))
 426
 427 g0, fp, sp, o0, f0 :: Reg
 428 g0 = case (gReg 0) of { IBOX(g0) -> FixedReg g0 }
 429 fp = case (iReg 6) of { IBOX(i6) -> FixedReg i6 }
 430 sp = case (oReg 6) of { IBOX(o6) -> FixedReg o6 }
 431 o0 = realReg  (oReg 0)
 432 f0 = realReg  (fReg 0)
 433
 434 #endif
 435 \end{code}
 436
 437 Redefine the literals used for machine-registers with non-numeric
 438 names in the header files.  Gag me with a spoon, eh?
 439 \begin{code}
 440 #if alpha_TARGET_ARCH
 441 #define f0 32
 442 #define f1 33
 443 #define f2 34
 444 #define f3 35
 445 #define f4 36
 446 #define f5 37
 447 #define f6 38
 448 #define f7 39
 449 #define f8 40
 450 #define f9 41
 451 #define f10 42
 452 #define f11 43
 453 #define f12 44
 454 #define f13 45
 455 #define f14 46
 456 #define f15 47
 457 #define f16 48
 458 #define f17 49
 459 #define f18 50
 460 #define f19 51
 461 #define f20 52
 462 #define f21 53
 463 #define f22 54
 464 #define f23 55
 465 #define f24 56
 466 #define f25 57
 467 #define f26 58
 468 #define f27 59
 469 #define f28 60
 470 #define f29 61
 471 #define f30 62
 472 #define f31 63
 473 #endif
 474 #if i386_TARGET_ARCH
 475 #define eax 0
 476 #define ebx 1
 477 #define ecx 2
 478 #define edx 3
 479 #define esi 4
 480 #define edi 5
 481 #define ebp 6
 482 #define esp 7
 483 #define st0 8
 484 #define st1 9
 485 #define st2 10
 486 #define st3 11
 487 #define st4 12
 488 #define st5 13
 489 #define st6 14
 490 #define st7 15
 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 (FloatReg  ILIT(1))    = OFFSET_F1
 572 baseRegOffset (FloatReg  ILIT(2))    = OFFSET_F2
 573 baseRegOffset (FloatReg  ILIT(3))    = OFFSET_F3
 574 baseRegOffset (FloatReg  ILIT(4))    = OFFSET_F4
 575 baseRegOffset (DoubleReg ILIT(1))    = OFFSET_D1
 576 baseRegOffset (DoubleReg ILIT(2))    = OFFSET_D2
 577 baseRegOffset Sp                     = OFFSET_Sp
 578 baseRegOffset Su                     = OFFSET_Su
 579 baseRegOffset SpLim                  = OFFSET_SpLim
 580 #ifdef OFFSET_Lng1
 581 baseRegOffset (LongReg _ ILIT(1))    = OFFSET_Lng1
 582 #endif
 583 #ifdef OFFSET_Lng2
 584 baseRegOffset (LongReg _ ILIT(2))    = OFFSET_Lng2
 585 #endif
 586 baseRegOffset Hp                     = OFFSET_Hp
 587 baseRegOffset HpLim                  = OFFSET_HpLim
 588 #ifdef DEBUG
 589 baseRegOffset BaseReg                = panic "baseRegOffset:BaseReg"
 590 baseRegOffset CurCostCentre          = panic "baseRegOffset:CurCostCentre"
 591 baseRegOffset VoidReg                = panic "baseRegOffset:VoidReg"
 592 #endif
 593 \end{code}
 594
 595 \begin{code}
 596 callerSaves :: MagicId -> Bool
 597
 598 #ifdef CALLER_SAVES_Base
 599 callerSaves BaseReg                     = True
 600 #endif
 601 #ifdef CALLER_SAVES_R1
 602 callerSaves (VanillaReg _ ILIT(1))      = True
 603 #endif
 604 #ifdef CALLER_SAVES_R2
 605 callerSaves (VanillaReg _ ILIT(2))      = True
 606 #endif
 607 #ifdef CALLER_SAVES_R3
 608 callerSaves (VanillaReg _ ILIT(3))      = True
 609 #endif
 610 #ifdef CALLER_SAVES_R4
 611 callerSaves (VanillaReg _ ILIT(4))      = True
 612 #endif
 613 #ifdef CALLER_SAVES_R5
 614 callerSaves (VanillaReg _ ILIT(5))      = True
 615 #endif
 616 #ifdef CALLER_SAVES_R6
 617 callerSaves (VanillaReg _ ILIT(6))      = True
 618 #endif
 619 #ifdef CALLER_SAVES_R7
 620 callerSaves (VanillaReg _ ILIT(7))      = True
 621 #endif
 622 #ifdef CALLER_SAVES_R8
 623 callerSaves (VanillaReg _ ILIT(8))      = True
 624 #endif
 625 #ifdef CALLER_SAVES_F1
 626 callerSaves (FloatReg ILIT(1))          = True
 627 #endif
 628 #ifdef CALLER_SAVES_F2
 629 callerSaves (FloatReg ILIT(2))          = True
 630 #endif
 631 #ifdef CALLER_SAVES_F3
 632 callerSaves (FloatReg ILIT(3))          = True
 633 #endif
 634 #ifdef CALLER_SAVES_F4
 635 callerSaves (FloatReg ILIT(4))          = True
 636 #endif
 637 #ifdef CALLER_SAVES_D1
 638 callerSaves (DoubleReg ILIT(1))         = True
 639 #endif
 640 #ifdef CALLER_SAVES_D2
 641 callerSaves (DoubleReg ILIT(2))         = True
 642 #endif
 643 #ifdef CALLER_SAVES_L1
 644 callerSaves (LongReg _ ILIT(1))         = True
 645 #endif
 646 #ifdef CALLER_SAVES_Sp
 647 callerSaves Sp                          = True
 648 #endif
 649 #ifdef CALLER_SAVES_Su
 650 callerSaves Su                          = True
 651 #endif
 652 #ifdef CALLER_SAVES_SpLim
 653 callerSaves SpLim                       = True
 654 #endif
 655 #ifdef CALLER_SAVES_Hp
 656 callerSaves Hp                          = True
 657 #endif
 658 #ifdef CALLER_SAVES_HpLim
 659 callerSaves HpLim                       = True
 660 #endif
 661 callerSaves _                           = False
 662 \end{code}
 663
 664 \begin{code}
 665 magicIdRegMaybe :: MagicId -> Maybe Reg
 666
 667 #ifdef REG_Base
 668 magicIdRegMaybe BaseReg                 = Just (FixedReg ILIT(REG_Base))
 669 #endif
 670 #ifdef REG_R1
 671 magicIdRegMaybe (VanillaReg _ ILIT(1))  = Just (FixedReg ILIT(REG_R1))
 672 #endif
 673 #ifdef REG_R2
 674 magicIdRegMaybe (VanillaReg _ ILIT(2))  = Just (FixedReg ILIT(REG_R2))
 675 #endif
 676 #ifdef REG_R3
 677 magicIdRegMaybe (VanillaReg _ ILIT(3))  = Just (FixedReg ILIT(REG_R3))
 678 #endif
 679 #ifdef REG_R4
 680 magicIdRegMaybe (VanillaReg _ ILIT(4))  = Just (FixedReg ILIT(REG_R4))
 681 #endif
 682 #ifdef REG_R5
 683 magicIdRegMaybe (VanillaReg _ ILIT(5))  = Just (FixedReg ILIT(REG_R5))
 684 #endif
 685 #ifdef REG_R6
 686 magicIdRegMaybe (VanillaReg _ ILIT(6))  = Just (FixedReg ILIT(REG_R6))
 687 #endif
 688 #ifdef REG_R7
 689 magicIdRegMaybe (VanillaReg _ ILIT(7))  = Just (FixedReg ILIT(REG_R7))
 690 #endif
 691 #ifdef REG_R8
 692 magicIdRegMaybe (VanillaReg _ ILIT(8))  = Just (FixedReg ILIT(REG_R8))
 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..15],
 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 alpha_TARGET_ARCH
 803 argRegs 1 = freeMappedRegs [16, fReg 16]
 804 argRegs 2 = freeMappedRegs [16, 17, fReg 16, fReg 17]
 805 argRegs 3 = freeMappedRegs [16, 17, 18, fReg 16, fReg 17, fReg 18]
 806 argRegs 4 = freeMappedRegs [16, 17, 18, 19, fReg 16, fReg 17, fReg 18, fReg 19]
 807 argRegs 5 = freeMappedRegs [16, 17, 18, 19, 20, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20]
 808 argRegs 6 = freeMappedRegs [16, 17, 18, 19, 20, 21, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21]
 809 #endif {- alpha_TARGET_ARCH -}
 810 #if i386_TARGET_ARCH
 811 argRegs _ = panic "MachRegs.argRegs: doesn't work on I386"
 812 #endif {- i386_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
 823 -------------------------------
 824
 825 #if alpha_TARGET_ARCH
 826 allArgRegs :: [(Reg, Reg)]
 827
 828 allArgRegs = [(realReg i, realReg (fReg i)) | i <- [16..21]]
 829 #endif {- alpha_TARGET_ARCH -}
 830
 831 #if sparc_TARGET_ARCH
 832 allArgRegs :: [Reg]
 833
 834 allArgRegs = map realReg [oReg i | i <- [0..5]]
 835 #endif {- sparc_TARGET_ARCH -}
 836
 837 -------------------------------
 838 freeMappedRegs :: [Int] -> [Reg]
 839
 840 freeMappedRegs nums
 841   = foldr free [] nums
 842   where
 843     free IBOX(i) acc
 844       = if _IS_TRUE_(freeReg i) then (MappedReg i) : acc else acc
 845 \end{code}
 846
 847 \begin{code}
 848 freeReg :: FAST_INT -> FAST_BOOL
 849
 850 #if alpha_TARGET_ARCH
 851 freeReg ILIT(26) = _FALSE_  -- return address (ra)
 852 freeReg ILIT(28) = _FALSE_  -- reserved for the assembler (at)
 853 freeReg ILIT(29) = _FALSE_  -- global pointer (gp)
 854 freeReg ILIT(30) = _FALSE_  -- stack pointer (sp)
 855 freeReg ILIT(31) = _FALSE_  -- always zero (zeroh)
 856 freeReg ILIT(63) = _FALSE_  -- always zero (f31)
 857 #endif
 858
 859 #if i386_TARGET_ARCH
 860 freeReg ILIT(esp) = _FALSE_  -- %esp is the C stack pointer
 861 #endif
 862
 863 #if sparc_TARGET_ARCH
 864 freeReg ILIT(g0) = _FALSE_  --  %g0 is always 0.
 865 freeReg ILIT(g5) = _FALSE_  --  %g5 is reserved (ABI).
 866 freeReg ILIT(g6) = _FALSE_  --  %g6 is reserved (ABI).
 867 freeReg ILIT(g7) = _FALSE_  --  %g7 is reserved (ABI).
 868 freeReg ILIT(i6) = _FALSE_  --  %i6 is our frame pointer.
 869 freeReg ILIT(o6) = _FALSE_  --  %o6 is our stack pointer.
 870 #endif
 871
 872 #ifdef REG_Base
 873 freeReg ILIT(REG_Base) = _FALSE_
 874 #endif
 875 #ifdef REG_R1
 876 freeReg ILIT(REG_R1)   = _FALSE_
 877 #endif
 878 #ifdef REG_R2
 879 freeReg ILIT(REG_R2)   = _FALSE_
 880 #endif
 881 #ifdef REG_R3
 882 freeReg ILIT(REG_R3)   = _FALSE_
 883 #endif
 884 #ifdef REG_R4
 885 freeReg ILIT(REG_R4)   = _FALSE_
 886 #endif
 887 #ifdef REG_R5
 888 freeReg ILIT(REG_R5)   = _FALSE_
 889 #endif
 890 #ifdef REG_R6
 891 freeReg ILIT(REG_R6)   = _FALSE_
 892 #endif
 893 #ifdef REG_R7
 894 freeReg ILIT(REG_R7)   = _FALSE_
 895 #endif
 896 #ifdef REG_R8
 897 freeReg ILIT(REG_R8)   = _FALSE_
 898 #endif
 899 #ifdef REG_F1
 900 freeReg ILIT(REG_F1) = _FALSE_
 901 #endif
 902 #ifdef REG_F2
 903 freeReg ILIT(REG_F2) = _FALSE_
 904 #endif
 905 #ifdef REG_F3
 906 freeReg ILIT(REG_F3) = _FALSE_
 907 #endif
 908 #ifdef REG_F4
 909 freeReg ILIT(REG_F4) = _FALSE_
 910 #endif
 911 #ifdef REG_D1
 912 freeReg ILIT(REG_D1) = _FALSE_
 913 #endif
 914 #ifdef REG_D2
 915 freeReg ILIT(REG_D2) = _FALSE_
 916 #endif
 917 #ifdef REG_Sp
 918 freeReg ILIT(REG_Sp)   = _FALSE_
 919 #endif
 920 #ifdef REG_Su
 921 freeReg ILIT(REG_Su)   = _FALSE_
 922 #endif
 923 #ifdef REG_SpLim
 924 freeReg ILIT(REG_SpLim) = _FALSE_
 925 #endif
 926 #ifdef REG_Hp
 927 freeReg ILIT(REG_Hp)   = _FALSE_
 928 #endif
 929 #ifdef REG_HpLim
 930 freeReg ILIT(REG_HpLim) = _FALSE_
 931 #endif
 932 freeReg n
 933   -- we hang onto two double regs for dedicated
 934   -- use; this is not necessary on Alphas and
 935   -- may not be on other non-SPARCs.
 936 #ifdef REG_D1
 937   | n _EQ_ (ILIT(REG_D1) _ADD_ ILIT(1)) = _FALSE_
 938 #endif
 939 #ifdef REG_D2
 940   | n _EQ_ (ILIT(REG_D2) _ADD_ ILIT(1)) = _FALSE_
 941 #endif
 942   | otherwise = _TRUE_
 943 \end{code}