ghc/compiler/nativeGen/MachRegs.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996
   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 "HsVersions.h"
  14 #include "nativeGen/NCG.h"
  15
  16 module MachRegs (
  17
  18         Reg(..),
  19         Imm(..),
  20         Addr(..),
  21         RegLoc(..),
  22         SYN_IE(RegNo),
  23
  24         addrOffset,
  25         argRegs,
  26         baseRegOffset,
  27         callClobberedRegs,
  28         callerSaves,
  29         dblImmLit,
  30         extractMappedRegNos,
  31         freeMappedRegs,
  32         freeReg, freeRegs,
  33         getNewRegNCG,
  34         magicIdRegMaybe,
  35         mkReg,
  36         realReg,
  37         reservedRegs,
  38         saveLoc,
  39         spRel,
  40         stgReg,
  41         strImmLit
  42
  43 #if alpha_TARGET_ARCH
  44         , allArgRegs
  45         , fits8Bits
  46         , fReg
  47         , gp, pv, ra, sp, t9, t10, t11, t12, v0, f0, zeroh
  48 #endif
  49 #if i386_TARGET_ARCH
  50         , eax, ebx, ecx, edx, esi, esp
  51         , st0, st1, st2, st3, st4, st5, st6, st7
  52 #endif
  53 #if sparc_TARGET_ARCH
  54         , allArgRegs
  55         , fits13Bits
  56         , fPair, fpRel, gReg, iReg, lReg, oReg, largeOffsetError
  57         , fp, g0, o0, f0
  58
  59 #endif
  60     ) where
  61
  62 #if __GLASGOW_HASKELL__ >= 202
  63 import GlaExts hiding (Addr)
  64 import FastString
  65 #else
  66 IMP_Ubiq(){-uitous-}
  67 #endif
  68
  69 import AbsCSyn          ( MagicId(..) )
  70 import AbsCUtils        ( magicIdPrimRep )
  71 import CLabel           ( CLabel )
  72 import Outputable       ( Outputable(..) )
  73 import Pretty           ( Doc, text, rational )
  74 import PrimOp           ( PrimOp(..) )
  75 import PrimRep          ( PrimRep(..) )
  76 import Stix             ( sStLitLbl, StixTree(..), StixReg(..),
  77                           CodeSegment
  78                         )
  79 import Unique           ( mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
  80                           Unique{-instance Ord3-}
  81                         )
  82 import UniqSupply       ( getUnique, returnUs, thenUs, SYN_IE(UniqSM) )
  83 import UniqFM           ( Uniquable(..) )
  84 import Util             ( panic, Ord3(..) )
  85 \end{code}
  86
  87 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  88
  89 \begin{code}
  90 data Imm
  91   = ImmInt      Int
  92   | ImmInteger  Integer     -- Sigh.
  93   | ImmCLbl     CLabel      -- AbstractC Label (with baggage)
  94   | ImmLab      Doc    -- Simple string label (underscore-able)
  95   | ImmLit      Doc    -- Simple string
  96   IF_ARCH_sparc(
  97   | LO Imm                  -- Possible restrictions...
  98   | HI Imm
  99   ,)
 100
 101 strImmLit s = ImmLit (text s)
 102 dblImmLit r
 103   = strImmLit (
 104          IF_ARCH_alpha({-prepend nothing-}
 105         ,IF_ARCH_i386( '0' : 'd' :
 106         ,IF_ARCH_sparc('0' : 'r' :,)))
 107         show (rational r))
 108 \end{code}
 109
 110 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 111
 112 \begin{code}
 113 data Addr
 114 #if alpha_TARGET_ARCH
 115   = AddrImm     Imm
 116   | AddrReg     Reg
 117   | AddrRegImm  Reg Imm
 118 #endif
 119
 120 #if i386_TARGET_ARCH
 121   = Addr        Base Index Displacement
 122   | ImmAddr     Imm Int
 123
 124 type Base         = Maybe Reg
 125 type Index        = Maybe (Reg, Int)    -- Int is 2, 4 or 8
 126 type Displacement = Imm
 127 #endif
 128
 129 #if sparc_TARGET_ARCH
 130   = AddrRegReg  Reg Reg
 131   | AddrRegImm  Reg Imm
 132 #endif
 133
 134 addrOffset :: Addr -> Int -> Maybe Addr
 135
 136 addrOffset addr off
 137   = case addr of
 138 #if alpha_TARGET_ARCH
 139       _ -> panic "MachMisc.addrOffset not defined for Alpha"
 140 #endif
 141 #if i386_TARGET_ARCH
 142       ImmAddr i off0      -> Just (ImmAddr i (off0 + off))
 143       Addr r i (ImmInt n) -> Just (Addr r i (ImmInt (n + off)))
 144       Addr r i (ImmInteger n)
 145         -> Just (Addr r i (ImmInt (fromInteger (n + toInteger off))))
 146       _ -> Nothing
 147 #endif
 148 #if sparc_TARGET_ARCH
 149       AddrRegImm r (ImmInt n)
 150        | fits13Bits n2 -> Just (AddrRegImm r (ImmInt n2))
 151        | otherwise     -> Nothing
 152        where n2 = n + off
 153
 154       AddrRegImm r (ImmInteger n)
 155        | fits13Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
 156        | otherwise     -> Nothing
 157        where n2 = n + toInteger off
 158
 159       AddrRegReg r (FixedReg ILIT(0))
 160        | fits13Bits off -> Just (AddrRegImm r (ImmInt off))
 161        | otherwise     -> Nothing
 162
 163       _ -> Nothing
 164
 165 #endif {-sparc-}
 166
 167 -----------------
 168 #if alpha_TARGET_ARCH
 169
 170 fits8Bits :: Integer -> Bool
 171 fits8Bits i = i >= -256 && i < 256
 172
 173 #endif
 174
 175 #if sparc_TARGET_ARCH
 176 {-# SPECIALIZE
 177     fits13Bits :: Int -> Bool
 178   #-}
 179 {-# SPECIALIZE
 180     fits13Bits :: Integer -> Bool
 181   #-}
 182
 183 fits13Bits :: Integral a => a -> Bool
 184 fits13Bits x = x >= -4096 && x < 4096
 185
 186 -----------------
 187 largeOffsetError i
 188   = 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")
 189
 190 #endif {-sparc-}
 191 \end{code}
 192
 193 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 194
 195 @stgReg@: we map STG registers onto appropriate Stix Trees.  First, we
 196 handle the two constants, @STK_STUB_closure@ and @vtbl_StdUpdFrame@.
 197 The rest are either in real machine registers or stored as offsets
 198 from BaseReg.
 199
 200 \begin{code}
 201 data RegLoc = Save StixTree | Always StixTree
 202 \end{code}
 203
 204 Trees for register save locations:
 205 \begin{code}
 206 saveLoc :: MagicId -> StixTree
 207
 208 saveLoc reg = case (stgReg reg) of {Always loc -> loc; Save loc -> loc}
 209 \end{code}
 210
 211 \begin{code}
 212 stgReg :: MagicId -> RegLoc
 213
 214 stgReg x
 215   = case (magicIdRegMaybe x) of
 216         Just _  -> Save   nonReg
 217         Nothing -> Always nonReg
 218   where
 219     offset = baseRegOffset x
 220
 221     baseLoc = case (magicIdRegMaybe BaseReg) of
 222       Just _  -> StReg (StixMagicId BaseReg)
 223       Nothing -> sStLitLbl SLIT("MainRegTable")
 224
 225     nonReg = case x of
 226       StkStubReg        -> sStLitLbl SLIT("STK_STUB_closure")
 227       StdUpdRetVecReg   -> sStLitLbl SLIT("vtbl_StdUpdFrame")
 228       BaseReg           -> sStLitLbl SLIT("MainRegTable")
 229         -- these Hp&HpLim cases perhaps should
 230         -- not be here for i386 (???) WDP 96/03
 231       Hp                -> StInd PtrRep (sStLitLbl SLIT("StorageMgrInfo"))
 232       HpLim             -> StInd PtrRep (sStLitLbl
 233                                 (_PK_ ("StorageMgrInfo+" ++ BYTES_PER_WORD_STR)))
 234       TagReg            -> StInd IntRep (StPrim IntSubOp [infoptr,
 235                                 StInt (1*BYTES_PER_WORD)])
 236                         where
 237                             r2      = VanillaReg PtrRep ILIT(2)
 238                             infoptr = case (stgReg r2) of
 239                                           Always t -> t
 240                                           Save   _ -> StReg (StixMagicId r2)
 241       _ -> StInd (magicIdPrimRep x)
 242                  (StPrim IntAddOp [baseLoc,
 243                         StInt (toInteger (offset*BYTES_PER_WORD))])
 244 \end{code}
 245
 246 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 247
 248 @spRel@ gives us a stack relative addressing mode for volatile
 249 temporaries and for excess call arguments.  @fpRel@, where
 250 applicable, is the same but for the frame pointer.
 251
 252 \begin{code}
 253 spRel :: Int    -- desired stack offset in words, positive or negative
 254       -> Addr
 255
 256 spRel n
 257 #if i386_TARGET_ARCH
 258   = Addr (Just esp) Nothing (ImmInt (n * BYTES_PER_WORD))
 259 #else
 260   = AddrRegImm sp (ImmInt (n * BYTES_PER_WORD))
 261 #endif
 262
 263 #if sparc_TARGET_ARCH
 264 fpRel :: Int -> Addr
 265     -- Duznae work for offsets greater than 13 bits; we just hope for
 266     -- the best
 267 fpRel n
 268   = AddrRegImm fp (ImmInt (n * BYTES_PER_WORD))
 269 #endif
 270 \end{code}
 271
 272 %************************************************************************
 273 %*                                                                      *
 274 \subsection[Reg]{Real registers}
 275 %*                                                                      *
 276 %************************************************************************
 277
 278 Static Registers correspond to actual machine registers.  These should
 279 be avoided until the last possible moment.
 280
 281 Dynamic registers are allocated on the fly, usually to represent a single
 282 value in the abstract assembly code (i.e. dynamic registers are usually
 283 single assignment).  Ultimately, they are mapped to available machine
 284 registers before spitting out the code.
 285
 286 \begin{code}
 287 data Reg
 288   = FixedReg  FAST_INT          -- A pre-allocated machine register
 289
 290   | MappedReg FAST_INT          -- A dynamically allocated machine register
 291
 292   | MemoryReg Int PrimRep       -- A machine "register" actually held in
 293                                 -- a memory allocated table of
 294                                 -- registers which didn't fit in real
 295                                 -- registers.
 296
 297   | UnmappedReg Unique PrimRep  -- One of an infinite supply of registers,
 298                                 -- always mapped to one of the earlier
 299                                 -- two (?)  before we're done.
 300
 301 mkReg :: Unique -> PrimRep -> Reg
 302 mkReg = UnmappedReg
 303
 304 getNewRegNCG :: PrimRep -> UniqSM Reg
 305 getNewRegNCG pk
 306   = getUnique   `thenUs` \ u ->
 307     returnUs (UnmappedReg u pk)
 308
 309 instance Text Reg where
 310     showsPrec _ (FixedReg i)    = showString "%"  . shows IBOX(i)
 311     showsPrec _ (MappedReg i)   = showString "%"  . shows IBOX(i)
 312     showsPrec _ (MemoryReg i _) = showString "%M"  . shows i
 313     showsPrec _ (UnmappedReg i _) = showString "%U" . shows i
 314
 315 #ifdef DEBUG
 316 instance Outputable Reg where
 317     ppr sty r = text (show r)
 318 #endif
 319
 320 cmpReg (FixedReg i)      (FixedReg i')      = cmp_ihash i i'
 321 cmpReg (MappedReg i)     (MappedReg i')     = cmp_ihash i i'
 322 cmpReg (MemoryReg i _)   (MemoryReg i' _)   = cmp_i i i'
 323 cmpReg (UnmappedReg u _) (UnmappedReg u' _) = cmp u u'
 324 cmpReg r1 r2
 325   = let tag1 = tagReg r1
 326         tag2 = tagReg r2
 327     in
 328         if tag1 _LT_ tag2 then LT_ else GT_
 329     where
 330         tagReg (FixedReg _)      = (ILIT(1) :: FAST_INT)
 331         tagReg (MappedReg _)     = ILIT(2)
 332         tagReg (MemoryReg _ _)   = ILIT(3)
 333         tagReg (UnmappedReg _ _) = ILIT(4)
 334
 335 cmp_i :: Int -> Int -> TAG_
 336 cmp_i a1 a2 = if a1 == a2 then EQ_ else if a1 < a2 then LT_ else GT_
 337
 338 cmp_ihash :: FAST_INT -> FAST_INT -> TAG_
 339 cmp_ihash a1 a2 = if a1 _EQ_ a2 then EQ_ else if a1 _LT_ a2 then LT_ else GT_
 340
 341 instance Ord3 Reg where
 342     cmp = cmpReg
 343
 344 instance Eq Reg where
 345     a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
 346     a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True  }
 347
 348 instance Ord Reg where
 349     a <= b = case (a `cmp` b) of { LT_ -> True; EQ_ -> True;  GT__ -> False }
 350     a <  b = case (a `cmp` b) of { LT_ -> True; EQ_ -> False; GT__ -> False }
 351     a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
 352     a >  b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
 353     _tagCmp a b = case (a `cmp` b) of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
 354
 355 instance Uniquable Reg where
 356     uniqueOf (UnmappedReg u _) = u
 357     uniqueOf (FixedReg i)      = mkPseudoUnique1 IBOX(i)
 358     uniqueOf (MappedReg i)     = mkPseudoUnique2 IBOX(i)
 359     uniqueOf (MemoryReg i _)   = mkPseudoUnique3 i
 360 \end{code}
 361
 362 \begin{code}
 363 type RegNo = Int
 364
 365 realReg :: RegNo -> Reg
 366 realReg n@IBOX(i)
 367   = if _IS_TRUE_(freeReg i) then MappedReg i else FixedReg i
 368
 369 extractMappedRegNos :: [Reg] -> [RegNo]
 370
 371 extractMappedRegNos regs
 372   = foldr ex [] regs
 373   where
 374     ex (MappedReg i) acc = IBOX(i) : acc  -- we'll take it
 375     ex _             acc = acc            -- leave it out
 376 \end{code}
 377
 378 ** Machine-specific Reg stuff: **
 379
 380 The Alpha has 64 registers of interest; 32 integer registers and 32 floating
 381 point registers.  The mapping of STG registers to alpha machine registers
 382 is defined in StgRegs.h.  We are, of course, prepared for any eventuality.
 383 \begin{code}
 384 #if alpha_TARGET_ARCH
 385 fReg :: Int -> Int
 386 fReg x = (32 + x)
 387
 388 v0, f0, ra, pv, gp, sp, zeroh :: Reg
 389 v0    = realReg 0
 390 f0    = realReg (fReg 0)
 391 ra    = FixedReg ILIT(26)
 392 pv    = t12
 393 gp    = FixedReg ILIT(29)
 394 sp    = FixedReg ILIT(30)
 395 zeroh = FixedReg ILIT(31) -- "zero" is used in 1.3 (MonadZero method)
 396
 397 t9, t10, t11, t12 :: Reg
 398 t9  = realReg 23
 399 t10 = realReg 24
 400 t11 = realReg 25
 401 t12 = realReg 27
 402 #endif
 403 \end{code}
 404
 405 Intel x86 architecture:
 406 - All registers except 7 (esp) are available for use.
 407 - Only ebx, esi, edi and esp are available across a C call (they are callee-saves).
 408 - Registers 0-7 have 16-bit counterparts (ax, bx etc.)
 409 - Registers 0-3 have 8 bit counterparts (ah, bh etc.)
 410 - Registers 8-15 hold extended floating point values.
 411 \begin{code}
 412 #if i386_TARGET_ARCH
 413
 414 gReg,fReg :: Int -> Int
 415 gReg x = x
 416 fReg x = (8 + x)
 417
 418 st0, st1, st2, st3, st4, st5, st6, st7, eax, ebx, ecx, edx, esp :: Reg
 419 eax = case (gReg 0) of { IBOX(g0) -> FixedReg g0 }
 420 ebx = case (gReg 1) of { IBOX(g1) -> FixedReg g1 }
 421 ecx = case (gReg 2) of { IBOX(g2) -> FixedReg g2 }
 422 edx = case (gReg 3) of { IBOX(g3) -> FixedReg g3 }
 423 esi = case (gReg 4) of { IBOX(g4) -> FixedReg g4 }
 424 edi = case (gReg 5) of { IBOX(g5) -> FixedReg g5 }
 425 ebp = case (gReg 6) of { IBOX(g6) -> FixedReg g6 }
 426 esp = case (gReg 7) of { IBOX(g7) -> FixedReg g7 }
 427 st0 = realReg  (fReg 0)
 428 st1 = realReg  (fReg 1)
 429 st2 = realReg  (fReg 2)
 430 st3 = realReg  (fReg 3)
 431 st4 = realReg  (fReg 4)
 432 st5 = realReg  (fReg 5)
 433 st6 = realReg  (fReg 6)
 434 st7 = realReg  (fReg 7)
 435
 436 #endif
 437 \end{code}
 438
 439 The SPARC has 64 registers of interest; 32 integer registers and 32
 440 floating point registers.  The mapping of STG registers to SPARC
 441 machine registers is defined in StgRegs.h.  We are, of course,
 442 prepared for any eventuality.
 443
 444 \begin{code}
 445 #if sparc_TARGET_ARCH
 446
 447 gReg,lReg,iReg,oReg,fReg :: Int -> Int
 448 gReg x = x
 449 oReg x = (8 + x)
 450 lReg x = (16 + x)
 451 iReg x = (24 + x)
 452 fReg x = (32 + x)
 453
 454 fPair :: Reg -> Reg
 455 fPair (FixedReg i) = FixedReg (i _ADD_ ILIT(1))
 456 fPair (MappedReg i) = MappedReg (i _ADD_ ILIT(1))
 457
 458 g0, fp, sp, o0, f0 :: Reg
 459 g0 = case (gReg 0) of { IBOX(g0) -> FixedReg g0 }
 460 fp = case (iReg 6) of { IBOX(i6) -> FixedReg i6 }
 461 sp = case (oReg 6) of { IBOX(o6) -> FixedReg o6 }
 462 o0 = realReg  (oReg 0)
 463 f0 = realReg  (fReg 0)
 464
 465 #endif
 466 \end{code}
 467
 468 Redefine the literals used for machine-registers with non-numeric
 469 names in the header files.  Gag me with a spoon, eh?
 470 \begin{code}
 471 #if alpha_TARGET_ARCH
 472 #define f0 32
 473 #define f1 33
 474 #define f2 34
 475 #define f3 35
 476 #define f4 36
 477 #define f5 37
 478 #define f6 38
 479 #define f7 39
 480 #define f8 40
 481 #define f9 41
 482 #define f10 42
 483 #define f11 43
 484 #define f12 44
 485 #define f13 45
 486 #define f14 46
 487 #define f15 47
 488 #define f16 48
 489 #define f17 49
 490 #define f18 50
 491 #define f19 51
 492 #define f20 52
 493 #define f21 53
 494 #define f22 54
 495 #define f23 55
 496 #define f24 56
 497 #define f25 57
 498 #define f26 58
 499 #define f27 59
 500 #define f28 60
 501 #define f29 61
 502 #define f30 62
 503 #define f31 63
 504 #endif
 505 #if i386_TARGET_ARCH
 506 #define eax 0
 507 #define ebx 1
 508 #define ecx 2
 509 #define edx 3
 510 #define esi 4
 511 #define edi 5
 512 #define ebp 6
 513 #define esp 7
 514 #define st0 8
 515 #define st1 9
 516 #define st2 10
 517 #define st3 11
 518 #define st4 12
 519 #define st5 13
 520 #define st6 14
 521 #define st7 15
 522 #endif
 523 #if sparc_TARGET_ARCH
 524 #define g0 0
 525 #define g1 1
 526 #define g2 2
 527 #define g3 3
 528 #define g4 4
 529 #define g5 5
 530 #define g6 6
 531 #define g7 7
 532 #define o0 8
 533 #define o1 9
 534 #define o2 10
 535 #define o3 11
 536 #define o4 12
 537 #define o5 13
 538 #define o6 14
 539 #define o7 15
 540 #define l0 16
 541 #define l1 17
 542 #define l2 18
 543 #define l3 19
 544 #define l4 20
 545 #define l5 21
 546 #define l6 22
 547 #define l7 23
 548 #define i0 24
 549 #define i1 25
 550 #define i2 26
 551 #define i3 27
 552 #define i4 28
 553 #define i5 29
 554 #define i6 30
 555 #define i7 31
 556 #define f0 32
 557 #define f1 33
 558 #define f2 34
 559 #define f3 35
 560 #define f4 36
 561 #define f5 37
 562 #define f6 38
 563 #define f7 39
 564 #define f8 40
 565 #define f9 41
 566 #define f10 42
 567 #define f11 43
 568 #define f12 44
 569 #define f13 45
 570 #define f14 46
 571 #define f15 47
 572 #define f16 48
 573 #define f17 49
 574 #define f18 50
 575 #define f19 51
 576 #define f20 52
 577 #define f21 53
 578 #define f22 54
 579 #define f23 55
 580 #define f24 56
 581 #define f25 57
 582 #define f26 58
 583 #define f27 59
 584 #define f28 60
 585 #define f29 61
 586 #define f30 62
 587 #define f31 63
 588 #endif
 589 \end{code}
 590
 591 \begin{code}
 592 baseRegOffset :: MagicId -> Int
 593
 594 baseRegOffset StkOReg                = OFFSET_StkO
 595 baseRegOffset (VanillaReg _ ILIT(1)) = OFFSET_R1
 596 baseRegOffset (VanillaReg _ ILIT(2)) = OFFSET_R2
 597 baseRegOffset (VanillaReg _ ILIT(3)) = OFFSET_R3
 598 baseRegOffset (VanillaReg _ ILIT(4)) = OFFSET_R4
 599 baseRegOffset (VanillaReg _ ILIT(5)) = OFFSET_R5
 600 baseRegOffset (VanillaReg _ ILIT(6)) = OFFSET_R6
 601 baseRegOffset (VanillaReg _ ILIT(7)) = OFFSET_R7
 602 baseRegOffset (VanillaReg _ ILIT(8)) = OFFSET_R8
 603 baseRegOffset (FloatReg  ILIT(1))    = OFFSET_Flt1
 604 baseRegOffset (FloatReg  ILIT(2))    = OFFSET_Flt2
 605 baseRegOffset (FloatReg  ILIT(3))    = OFFSET_Flt3
 606 baseRegOffset (FloatReg  ILIT(4))    = OFFSET_Flt4
 607 baseRegOffset (DoubleReg ILIT(1))    = OFFSET_Dbl1
 608 baseRegOffset (DoubleReg ILIT(2))    = OFFSET_Dbl2
 609 baseRegOffset TagReg                 = OFFSET_Tag
 610 baseRegOffset RetReg                 = OFFSET_Ret
 611 baseRegOffset SpA                    = OFFSET_SpA
 612 baseRegOffset SuA                    = OFFSET_SuA
 613 baseRegOffset SpB                    = OFFSET_SpB
 614 baseRegOffset SuB                    = OFFSET_SuB
 615 baseRegOffset Hp                     = OFFSET_Hp
 616 baseRegOffset HpLim                  = OFFSET_HpLim
 617 baseRegOffset LivenessReg            = OFFSET_Liveness
 618 #ifdef DEBUG
 619 baseRegOffset BaseReg                = panic "baseRegOffset:BaseReg"
 620 baseRegOffset StdUpdRetVecReg        = panic "baseRegOffset:StgUpdRetVecReg"
 621 baseRegOffset StkStubReg             = panic "baseRegOffset:StkStubReg"
 622 baseRegOffset CurCostCentre          = panic "baseRegOffset:CurCostCentre"
 623 baseRegOffset VoidReg                = panic "baseRegOffset:VoidReg"
 624 #endif
 625 \end{code}
 626
 627 \begin{code}
 628 callerSaves :: MagicId -> Bool
 629
 630 #ifdef CALLER_SAVES_Base
 631 callerSaves BaseReg                     = True
 632 #endif
 633 #ifdef CALLER_SAVES_StkO
 634 callerSaves StkOReg                     = True
 635 #endif
 636 #ifdef CALLER_SAVES_R1
 637 callerSaves (VanillaReg _ ILIT(1))      = True
 638 #endif
 639 #ifdef CALLER_SAVES_R2
 640 callerSaves (VanillaReg _ ILIT(2))      = True
 641 #endif
 642 #ifdef CALLER_SAVES_R3
 643 callerSaves (VanillaReg _ ILIT(3))      = True
 644 #endif
 645 #ifdef CALLER_SAVES_R4
 646 callerSaves (VanillaReg _ ILIT(4))      = True
 647 #endif
 648 #ifdef CALLER_SAVES_R5
 649 callerSaves (VanillaReg _ ILIT(5))      = True
 650 #endif
 651 #ifdef CALLER_SAVES_R6
 652 callerSaves (VanillaReg _ ILIT(6))      = True
 653 #endif
 654 #ifdef CALLER_SAVES_R7
 655 callerSaves (VanillaReg _ ILIT(7))      = True
 656 #endif
 657 #ifdef CALLER_SAVES_R8
 658 callerSaves (VanillaReg _ ILIT(8))      = True
 659 #endif
 660 #ifdef CALLER_SAVES_FltReg1
 661 callerSaves (FloatReg ILIT(1))          = True
 662 #endif
 663 #ifdef CALLER_SAVES_FltReg2
 664 callerSaves (FloatReg ILIT(2))          = True
 665 #endif
 666 #ifdef CALLER_SAVES_FltReg3
 667 callerSaves (FloatReg ILIT(3))          = True
 668 #endif
 669 #ifdef CALLER_SAVES_FltReg4
 670 callerSaves (FloatReg ILIT(4))          = True
 671 #endif
 672 #ifdef CALLER_SAVES_DblReg1
 673 callerSaves (DoubleReg ILIT(1))         = True
 674 #endif
 675 #ifdef CALLER_SAVES_DblReg2
 676 callerSaves (DoubleReg ILIT(2))         = True
 677 #endif
 678 #ifdef CALLER_SAVES_Tag
 679 callerSaves TagReg                      = True
 680 #endif
 681 #ifdef CALLER_SAVES_Ret
 682 callerSaves RetReg                      = True
 683 #endif
 684 #ifdef CALLER_SAVES_SpA
 685 callerSaves SpA                         = True
 686 #endif
 687 #ifdef CALLER_SAVES_SuA
 688 callerSaves SuA                         = True
 689 #endif
 690 #ifdef CALLER_SAVES_SpB
 691 callerSaves SpB                         = True
 692 #endif
 693 #ifdef CALLER_SAVES_SuB
 694 callerSaves SuB                         = True
 695 #endif
 696 #ifdef CALLER_SAVES_Hp
 697 callerSaves Hp                          = True
 698 #endif
 699 #ifdef CALLER_SAVES_HpLim
 700 callerSaves HpLim                       = True
 701 #endif
 702 #ifdef CALLER_SAVES_Liveness
 703 callerSaves LivenessReg                 = True
 704 #endif
 705 #ifdef CALLER_SAVES_StdUpdRetVec
 706 callerSaves StdUpdRetVecReg             = True
 707 #endif
 708 #ifdef CALLER_SAVES_StkStub
 709 callerSaves StkStubReg                  = True
 710 #endif
 711 callerSaves _                           = False
 712 \end{code}
 713
 714 \begin{code}
 715 magicIdRegMaybe :: MagicId -> Maybe Reg
 716
 717 #ifdef REG_Base
 718 magicIdRegMaybe BaseReg                 = Just (FixedReg ILIT(REG_Base))
 719 #endif
 720 #ifdef REG_StkO
 721 magicIdRegMaybe StkOReg                 = Just (FixedReg ILIT(REG_StkOReg))
 722 #endif
 723 #ifdef REG_R1
 724 magicIdRegMaybe (VanillaReg _ ILIT(1))  = Just (FixedReg ILIT(REG_R1))
 725 #endif
 726 #ifdef REG_R2
 727 magicIdRegMaybe (VanillaReg _ ILIT(2))  = Just (FixedReg ILIT(REG_R2))
 728 #endif
 729 #ifdef REG_R3
 730 magicIdRegMaybe (VanillaReg _ ILIT(3))  = Just (FixedReg ILIT(REG_R3))
 731 #endif
 732 #ifdef REG_R4
 733 magicIdRegMaybe (VanillaReg _ ILIT(4))  = Just (FixedReg ILIT(REG_R4))
 734 #endif
 735 #ifdef REG_R5
 736 magicIdRegMaybe (VanillaReg _ ILIT(5))  = Just (FixedReg ILIT(REG_R5))
 737 #endif
 738 #ifdef REG_R6
 739 magicIdRegMaybe (VanillaReg _ ILIT(6))  = Just (FixedReg ILIT(REG_R6))
 740 #endif
 741 #ifdef REG_R7
 742 magicIdRegMaybe (VanillaReg _ ILIT(7))  = Just (FixedReg ILIT(REG_R7))
 743 #endif
 744 #ifdef REG_R8
 745 magicIdRegMaybe (VanillaReg _ ILIT(8))  = Just (FixedReg ILIT(REG_R8))
 746 #endif
 747 #ifdef REG_Flt1
 748 magicIdRegMaybe (FloatReg ILIT(1))      = Just (FixedReg ILIT(REG_Flt1))
 749 #endif
 750 #ifdef REG_Flt2
 751 magicIdRegMaybe (FloatReg ILIT(2))      = Just (FixedReg ILIT(REG_Flt2))
 752 #endif
 753 #ifdef REG_Flt3
 754 magicIdRegMaybe (FloatReg ILIT(3))      = Just (FixedReg ILIT(REG_Flt3))
 755 #endif
 756 #ifdef REG_Flt4
 757 magicIdRegMaybe (FloatReg ILIT(4))      = Just (FixedReg ILIT(REG_Flt4))
 758 #endif
 759 #ifdef REG_Dbl1
 760 magicIdRegMaybe (DoubleReg ILIT(1))     = Just (FixedReg ILIT(REG_Dbl1))
 761 #endif
 762 #ifdef REG_Dbl2
 763 magicIdRegMaybe (DoubleReg ILIT(2))     = Just (FixedReg ILIT(REG_Dbl2))
 764 #endif
 765 #ifdef REG_Tag
 766 magicIdRegMaybe TagReg                  = Just (FixedReg ILIT(REG_TagReg))
 767 #endif
 768 #ifdef REG_Ret
 769 magicIdRegMaybe RetReg                  = Just (FixedReg ILIT(REG_Ret))
 770 #endif
 771 #ifdef REG_SpA
 772 magicIdRegMaybe SpA                     = Just (FixedReg ILIT(REG_SpA))
 773 #endif
 774 #ifdef REG_SuA
 775 magicIdRegMaybe SuA                     = Just (FixedReg ILIT(REG_SuA))
 776 #endif
 777 #ifdef REG_SpB
 778 magicIdRegMaybe SpB                     = Just (FixedReg ILIT(REG_SpB))
 779 #endif
 780 #ifdef REG_SuB
 781 magicIdRegMaybe SuB                     = Just (FixedReg ILIT(REG_SuB))
 782 #endif
 783 #ifdef REG_Hp
 784 magicIdRegMaybe Hp                      = Just (FixedReg ILIT(REG_Hp))
 785 #endif
 786 #ifdef REG_HpLim
 787 magicIdRegMaybe HpLim                   = Just (FixedReg ILIT(REG_HpLim))
 788 #endif
 789 #ifdef REG_Liveness
 790 magicIdRegMaybe LivenessReg             = Just (FixedReg ILIT(REG_Liveness))
 791 #endif
 792 #ifdef REG_StdUpdRetVec
 793 magicIdRegMaybe StdUpdRetVecReg         = Just (FixedReg ILIT(REG_StdUpdRetVec))
 794 #endif
 795 #ifdef REG_StkStub
 796 magicIdRegMaybe StkStubReg              = Just (FixedReg ILIT(REG_StkStub))
 797 #endif
 798 magicIdRegMaybe _                       = Nothing
 799 \end{code}
 800
 801 %************************************************************************
 802 %*                                                                      *
 803 \subsection{Free, reserved, call-clobbered, and argument registers}
 804 %*                                                                      *
 805 %************************************************************************
 806
 807 @freeRegs@ is the list of registers we can use in register allocation.
 808 @freeReg@ (below) says if a particular register is free.
 809
 810 With a per-instruction clobber list, we might be able to get some of
 811 these back, but it's probably not worth the hassle.
 812
 813 @callClobberedRegs@ ... the obvious.
 814
 815 @argRegs@: assuming a call with N arguments, what registers will be
 816 used to hold arguments?  (NB: it doesn't know whether the arguments
 817 are integer or floating-point...)
 818
 819 \begin{code}
 820 reservedRegs :: [RegNo]
 821 reservedRegs
 822 #if alpha_TARGET_ARCH
 823   = [NCG_Reserved_I1, NCG_Reserved_I2,
 824      NCG_Reserved_F1, NCG_Reserved_F2]
 825 #endif
 826 #if i386_TARGET_ARCH
 827   = [{-certainly cannot afford any!-}]
 828 #endif
 829 #if sparc_TARGET_ARCH
 830   = [NCG_Reserved_I1, NCG_Reserved_I2,
 831      NCG_Reserved_F1, NCG_Reserved_F2,
 832      NCG_Reserved_D1, NCG_Reserved_D2]
 833 #endif
 834
 835 -------------------------------
 836 freeRegs :: [Reg]
 837 freeRegs
 838   = freeMappedRegs IF_ARCH_alpha( [0..63],
 839                    IF_ARCH_i386(  [0..15],
 840                    IF_ARCH_sparc( [0..63],)))
 841
 842 -------------------------------
 843 callClobberedRegs :: [Reg]
 844 callClobberedRegs
 845   = freeMappedRegs
 846 #if alpha_TARGET_ARCH
 847     [0, 1, 2, 3, 4, 5, 6, 7, 8,
 848      16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
 849      fReg 0, fReg 1, fReg 10, fReg 11, fReg 12, fReg 13, fReg 14, fReg 15,
 850      fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21, fReg 22, fReg 23,
 851      fReg 24, fReg 25, fReg 26, fReg 27, fReg 28, fReg 29, fReg 30]
 852 #endif {- alpha_TARGET_ARCH -}
 853 #if i386_TARGET_ARCH
 854     [{-none-}]
 855 #endif {- i386_TARGET_ARCH -}
 856 #if sparc_TARGET_ARCH
 857     ( oReg 7 :
 858       [oReg i | i <- [0..5]] ++
 859       [gReg i | i <- [1..7]] ++
 860       [fReg i | i <- [0..31]] )
 861 #endif {- sparc_TARGET_ARCH -}
 862
 863 -------------------------------
 864 argRegs :: Int -> [Reg]
 865
 866 argRegs 0 = []
 867 #if alpha_TARGET_ARCH
 868 argRegs 1 = freeMappedRegs [16, fReg 16]
 869 argRegs 2 = freeMappedRegs [16, 17, fReg 16, fReg 17]
 870 argRegs 3 = freeMappedRegs [16, 17, 18, fReg 16, fReg 17, fReg 18]
 871 argRegs 4 = freeMappedRegs [16, 17, 18, 19, fReg 16, fReg 17, fReg 18, fReg 19]
 872 argRegs 5 = freeMappedRegs [16, 17, 18, 19, 20, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20]
 873 argRegs 6 = freeMappedRegs [16, 17, 18, 19, 20, 21, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21]
 874 #endif {- alpha_TARGET_ARCH -}
 875 #if i386_TARGET_ARCH
 876 argRegs _ = panic "MachRegs.argRegs: doesn't work on I386"
 877 #endif {- i386_TARGET_ARCH -}
 878 #if sparc_TARGET_ARCH
 879 argRegs 1 = freeMappedRegs (map oReg [0])
 880 argRegs 2 = freeMappedRegs (map oReg [0,1])
 881 argRegs 3 = freeMappedRegs (map oReg [0,1,2])
 882 argRegs 4 = freeMappedRegs (map oReg [0,1,2,3])
 883 argRegs 5 = freeMappedRegs (map oReg [0,1,2,3,4])
 884 argRegs 6 = freeMappedRegs (map oReg [0,1,2,3,4,5])
 885 #endif {- sparc_TARGET_ARCH -}
 886 argRegs _ = panic "MachRegs.argRegs: don't know about >6 arguments!"
 887
 888 -------------------------------
 889
 890 #if alpha_TARGET_ARCH
 891 allArgRegs :: [(Reg, Reg)]
 892
 893 allArgRegs = [(realReg i, realReg (fReg i)) | i <- [16..21]]
 894 #endif {- alpha_TARGET_ARCH -}
 895
 896 #if sparc_TARGET_ARCH
 897 allArgRegs :: [Reg]
 898
 899 allArgRegs = map realReg [oReg i | i <- [0..5]]
 900 #endif {- sparc_TARGET_ARCH -}
 901
 902 -------------------------------
 903 freeMappedRegs :: [Int] -> [Reg]
 904
 905 freeMappedRegs nums
 906   = foldr free [] nums
 907   where
 908     free IBOX(i) acc
 909       = if _IS_TRUE_(freeReg i) then (MappedReg i) : acc else acc
 910 \end{code}
 911
 912 \begin{code}
 913 freeReg :: FAST_INT -> FAST_BOOL
 914
 915 #if alpha_TARGET_ARCH
 916 freeReg ILIT(26) = _FALSE_  -- return address (ra)
 917 freeReg ILIT(28) = _FALSE_  -- reserved for the assembler (at)
 918 freeReg ILIT(29) = _FALSE_  -- global pointer (gp)
 919 freeReg ILIT(30) = _FALSE_  -- stack pointer (sp)
 920 freeReg ILIT(31) = _FALSE_  -- always zero (zeroh)
 921 freeReg ILIT(63) = _FALSE_  -- always zero (f31)
 922 #endif
 923
 924 #if i386_TARGET_ARCH
 925 freeReg ILIT(esp) = _FALSE_  -- %esp is the C stack pointer
 926 #endif
 927
 928 #if sparc_TARGET_ARCH
 929 freeReg ILIT(g0) = _FALSE_  --  %g0 is always 0.
 930 freeReg ILIT(g5) = _FALSE_  --  %g5 is reserved (ABI).
 931 freeReg ILIT(g6) = _FALSE_  --  %g6 is reserved (ABI).
 932 freeReg ILIT(g7) = _FALSE_  --  %g7 is reserved (ABI).
 933 freeReg ILIT(i6) = _FALSE_  --  %i6 is our frame pointer.
 934 freeReg ILIT(o6) = _FALSE_  --  %o6 is our stack pointer.
 935 #endif
 936
 937 #ifdef REG_Base
 938 freeReg ILIT(REG_Base) = _FALSE_
 939 #endif
 940 #ifdef REG_StkO
 941 freeReg ILIT(REG_StkO) = _FALSE_
 942 #endif
 943 #ifdef REG_R1
 944 freeReg ILIT(REG_R1)   = _FALSE_
 945 #endif
 946 #ifdef REG_R2
 947 freeReg ILIT(REG_R2)   = _FALSE_
 948 #endif
 949 #ifdef REG_R3
 950 freeReg ILIT(REG_R3)   = _FALSE_
 951 #endif
 952 #ifdef REG_R4
 953 freeReg ILIT(REG_R4)   = _FALSE_
 954 #endif
 955 #ifdef REG_R5
 956 freeReg ILIT(REG_R5)   = _FALSE_
 957 #endif
 958 #ifdef REG_R6
 959 freeReg ILIT(REG_R6)   = _FALSE_
 960 #endif
 961 #ifdef REG_R7
 962 freeReg ILIT(REG_R7)   = _FALSE_
 963 #endif
 964 #ifdef REG_R8
 965 freeReg ILIT(REG_R8)   = _FALSE_
 966 #endif
 967 #ifdef REG_Flt1
 968 freeReg ILIT(REG_Flt1) = _FALSE_
 969 #endif
 970 #ifdef REG_Flt2
 971 freeReg ILIT(REG_Flt2) = _FALSE_
 972 #endif
 973 #ifdef REG_Flt3
 974 freeReg ILIT(REG_Flt3) = _FALSE_
 975 #endif
 976 #ifdef REG_Flt4
 977 freeReg ILIT(REG_Flt4) = _FALSE_
 978 #endif
 979 #ifdef REG_Dbl1
 980 freeReg ILIT(REG_Dbl1) = _FALSE_
 981 #endif
 982 #ifdef REG_Dbl2
 983 freeReg ILIT(REG_Dbl2) = _FALSE_
 984 #endif
 985 #ifdef REG_Tag
 986 freeReg ILIT(REG_Tag)  = _FALSE_
 987 #endif
 988 #ifdef REG_Ret
 989 freeReg ILIT(REG_Ret)  = _FALSE_
 990 #endif
 991 #ifdef REG_SpA
 992 freeReg ILIT(REG_SpA)  = _FALSE_
 993 #endif
 994 #ifdef REG_SuA
 995 freeReg ILIT(REG_SuA)  = _FALSE_
 996 #endif
 997 #ifdef REG_SpB
 998 freeReg ILIT(REG_SpB)  = _FALSE_
 999 #endif
1000 #ifdef REG_SuB
1001 freeReg ILIT(REG_SuB)  = _FALSE_
1002 #endif
1003 #ifdef REG_Hp
1004 freeReg ILIT(REG_Hp)   = _FALSE_
1005 #endif
1006 #ifdef REG_HpLim
1007 freeReg ILIT(REG_HpLim) = _FALSE_
1008 #endif
1009 #ifdef REG_Liveness
1010 freeReg ILIT(REG_Liveness) = _FALSE_
1011 #endif
1012 #ifdef REG_StdUpdRetVec
1013 freeReg ILIT(REG_StdUpdRetVec) = _FALSE_
1014 #endif
1015 #ifdef REG_StkStub
1016 freeReg ILIT(REG_StkStub) = _FALSE_
1017 #endif
1018 freeReg _ = _TRUE_
1019 freeReg n
1020   -- we hang onto two double regs for dedicated
1021   -- use; this is not necessary on Alphas and
1022   -- may not be on other non-SPARCs.
1023 #ifdef REG_Dbl1
1024   | n _EQ_ (ILIT(REG_Dbl1) _ADD_ ILIT(1)) = _FALSE_
1025 #endif
1026 #ifdef REG_Dbl2
1027   | n _EQ_ (ILIT(REG_Dbl2) _ADD_ ILIT(1)) = _FALSE_
1028 #endif
1029   | otherwise = _TRUE_
1030 \end{code}