ghc/compiler/nativeGen/AlphaCode.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1995
   3 %
   4
   5 \section[AlphaCode]{The Native (Alpha) Machine Code}
   6
   7 \begin{code}
   8 #include "HsVersions.h"
   9
  10 module AlphaCode (
  11         Addr(..),Cond(..),Imm(..),RI(..),Size(..),
  12         AlphaCode(..),AlphaInstr(..),AlphaRegs,
  13         strImmLab,
  14
  15         printLabeledCodes,
  16
  17         baseRegOffset, stgRegMap, callerSaves,
  18
  19         kindToSize,
  20
  21         v0, f0, sp, ra, pv, gp, zero, argRegs,
  22
  23         freeRegs, reservedRegs
  24
  25         -- and, for self-sufficiency ...
  26     ) where
  27
  28 IMPORT_Trace
  29
  30 import AbsCSyn      ( MagicId(..) )
  31 import AsmRegAlloc  ( MachineCode(..), MachineRegisters(..), FutureLive(..),
  32                       Reg(..), RegUsage(..), RegLiveness(..)
  33                     )
  34 import BitSet
  35 import CLabel   ( CLabel, pprCLabel, externallyVisibleCLabel, charToC )
  36 import CgCompInfo   ( mAX_Double_REG, mAX_Float_REG, mAX_Vanilla_REG )
  37 import FiniteMap
  38 import Maybes       ( Maybe(..), maybeToBool )
  39 import OrdList      ( OrdList, mkUnitList, flattenOrdList )
  40 import Outputable
  41 import PrimRep      ( PrimRep(..) )
  42 import UniqSet
  43 import Stix
  44 import Unpretty
  45 import Util
  46 \end{code}
  47
  48 %************************************************************************
  49 %*                                                                      *
  50 \subsection[AlphaReg]{The Native (Alpha) Machine Register Table}
  51 %*                                                                      *
  52 %************************************************************************
  53
  54 The alpha has 64 registers of interest; 32 integer registers and 32 floating
  55 point registers.  The mapping of STG registers to alpha machine registers
  56 is defined in StgRegs.h.  We are, of course, prepared for any eventuality.
  57
  58 \begin{code}
  59
  60 fReg :: Int -> Int
  61 fReg x = (32 + x)
  62
  63 v0, f0, ra, pv, gp, sp, zero :: Reg
  64 v0   = realReg 0
  65 f0   = realReg (fReg 0)
  66 ra   = FixedReg ILIT(26)
  67 pv   = t12
  68 gp   = FixedReg ILIT(29)
  69 sp   = FixedReg ILIT(30)
  70 zero = FixedReg ILIT(31)
  71
  72 t9, t10, t11, t12 :: Reg
  73 t9  = realReg 23
  74 t10 = realReg 24
  75 t11 = realReg 25
  76 t12 = realReg 27
  77
  78 argRegs :: [(Reg, Reg)]
  79 argRegs = [(realReg i, realReg (fReg i)) | i <- [16..21]]
  80
  81 realReg :: Int -> Reg
  82 realReg n@IBOX(i) = if _IS_TRUE_(freeReg i) then MappedReg i else FixedReg i
  83
  84 \end{code}
  85
  86 %************************************************************************
  87 %*                                                                      *
  88 \subsection[TheAlphaCode]{The datatype for alpha assembly language}
  89 %*                                                                      *
  90 %************************************************************************
  91
  92 Here is a definition of the Alpha assembly language.
  93
  94 \begin{code}
  95
  96 data Imm = ImmInt Int
  97          | ImmInteger Integer         -- Sigh.
  98          | ImmCLbl CLabel             -- AbstractC Label (with baggage)
  99          | ImmLab  Unpretty           -- Simple string label
 100          deriving ()
 101
 102 strImmLab s = ImmLab (uppStr s)
 103
 104 data Addr = AddrImm Imm
 105           | AddrReg Reg
 106           | AddrRegImm Reg Imm
 107           deriving ()
 108
 109 data Cond = EQ                        -- For CMP and BI
 110           | LT                        -- For CMP and BI
 111           | LE                        -- For CMP and BI
 112           | ULT                       -- For CMP only
 113           | ULE                       -- For CMP only
 114           | NE                        -- For BI only
 115           | GT                        -- For BI only
 116           | GE                        -- For BI only
 117           | ALWAYS                    -- For BI (same as BR)
 118           | NEVER                     -- For BI (null instruction)
 119           deriving ()
 120
 121 data RI = RIReg Reg
 122         | RIImm Imm
 123         deriving ()
 124
 125 data Size = B
 126           | BU
 127           | W
 128           | WU
 129           | L
 130           | Q
 131           | FF
 132           | DF
 133           | GF
 134           | SF
 135           | TF
 136           deriving ()
 137
 138 data AlphaInstr =
 139
 140 -- Loads and stores.
 141
 142                 LD            Size Reg Addr -- size, dst, src
 143               | LDA           Reg Addr      -- dst, src
 144               | LDAH          Reg Addr      -- dst, src
 145               | LDGP          Reg Addr      -- dst, src
 146               | LDI           Size Reg Imm  -- size, dst, src
 147               | ST            Size Reg Addr -- size, src, dst
 148
 149 -- Int Arithmetic.
 150
 151               | CLR           Reg                   -- dst
 152               | ABS           Size RI Reg           -- size, src, dst
 153               | NEG           Size Bool RI Reg      -- size, overflow, src, dst
 154               | ADD           Size Bool Reg RI Reg  -- size, overflow, src, src, dst
 155               | SADD          Size Size Reg RI Reg  -- size, scale, src, src, dst
 156               | SUB           Size Bool Reg RI Reg  -- size, overflow, src, src, dst
 157               | SSUB          Size Size Reg RI Reg  -- size, scale, src, src, dst
 158               | MUL           Size Bool Reg RI Reg  -- size, overflow, src, src, dst
 159               | DIV           Size Bool Reg RI Reg  -- size, unsigned, src, src, dst
 160               | REM           Size Bool Reg RI Reg  -- size, unsigned, src, src, dst
 161
 162 -- Simple bit-twiddling.
 163
 164               | NOT           RI Reg
 165               | AND           Reg RI Reg
 166               | ANDNOT        Reg RI Reg
 167               | OR            Reg RI Reg
 168               | ORNOT         Reg RI Reg
 169               | XOR           Reg RI Reg
 170               | XORNOT        Reg RI Reg
 171               | SLL           Reg RI Reg
 172               | SRL           Reg RI Reg
 173               | SRA           Reg RI Reg
 174
 175               | ZAP           Reg RI Reg
 176               | ZAPNOT        Reg RI Reg
 177
 178               | NOP
 179
 180 -- Comparison
 181
 182               | CMP           Cond Reg RI Reg
 183
 184 -- Float Arithmetic.
 185
 186               | FCLR          Reg
 187               | FABS          Reg Reg
 188               | FNEG          Size Reg Reg
 189               | FADD          Size Reg Reg Reg
 190               | FDIV          Size Reg Reg Reg
 191               | FMUL          Size Reg Reg Reg
 192               | FSUB          Size Reg Reg Reg
 193               | CVTxy         Size Size Reg Reg
 194               | FCMP          Size Cond Reg Reg Reg
 195               | FMOV          Reg Reg
 196
 197 -- Jumping around.
 198
 199               | BI            Cond Reg Imm
 200               | BF            Cond Reg Imm
 201               | BR            Imm
 202               | JMP           Reg Addr Int
 203               | BSR           Imm Int
 204               | JSR           Reg Addr Int
 205
 206 -- Pseudo-ops.
 207
 208               | LABEL CLabel
 209               | FUNBEGIN CLabel
 210               | FUNEND CLabel
 211               | COMMENT FAST_STRING
 212               | SEGMENT CodeSegment
 213               | ASCII Bool String   -- needs backslash conversion?
 214               | DATA Size [Imm]
 215
 216 type AlphaCode  = OrdList AlphaInstr
 217
 218 \end{code}
 219
 220 %************************************************************************
 221 %*                                                                      *
 222 \subsection[TheAlphaPretty]{Pretty-printing the Alpha Assembly Language}
 223 %*                                                                      *
 224 %************************************************************************
 225
 226 \begin{code}
 227
 228 printLabeledCodes :: PprStyle -> [AlphaInstr] -> Unpretty
 229 printLabeledCodes sty codes = uppAboves (map (pprAlphaInstr sty) codes)
 230
 231 \end{code}
 232
 233 Printing the pieces...
 234
 235 \begin{code}
 236
 237 pprReg :: Reg -> Unpretty
 238
 239 pprReg (FixedReg i) = pprAlphaReg i
 240 pprReg (MappedReg i) = pprAlphaReg i
 241 pprReg other = uppStr (show other)   -- should only happen when debugging
 242
 243 pprAlphaReg :: FAST_INT -> Unpretty
 244 pprAlphaReg i = uppPStr
 245     (case i of {
 246         ILIT( 0) -> SLIT("$0");   ILIT( 1) -> SLIT("$1");
 247         ILIT( 2) -> SLIT("$2");   ILIT( 3) -> SLIT("$3");
 248         ILIT( 4) -> SLIT("$4");   ILIT( 5) -> SLIT("$5");
 249         ILIT( 6) -> SLIT("$6");   ILIT( 7) -> SLIT("$7");
 250         ILIT( 8) -> SLIT("$8");   ILIT( 9) -> SLIT("$9");
 251         ILIT(10) -> SLIT("$10");  ILIT(11) -> SLIT("$11");
 252         ILIT(12) -> SLIT("$12");  ILIT(13) -> SLIT("$13");
 253         ILIT(14) -> SLIT("$14");  ILIT(15) -> SLIT("$15");
 254         ILIT(16) -> SLIT("$16");  ILIT(17) -> SLIT("$17");
 255         ILIT(18) -> SLIT("$18");  ILIT(19) -> SLIT("$19");
 256         ILIT(20) -> SLIT("$20");  ILIT(21) -> SLIT("$21");
 257         ILIT(22) -> SLIT("$22");  ILIT(23) -> SLIT("$23");
 258         ILIT(24) -> SLIT("$24");  ILIT(25) -> SLIT("$25");
 259         ILIT(26) -> SLIT("$26");  ILIT(27) -> SLIT("$27");
 260         ILIT(28) -> SLIT("$28");  ILIT(29) -> SLIT("$29");
 261         ILIT(30) -> SLIT("$30");  ILIT(31) -> SLIT("$31");
 262         ILIT(32) -> SLIT("$f0");  ILIT(33) -> SLIT("$f1");
 263         ILIT(34) -> SLIT("$f2");  ILIT(35) -> SLIT("$f3");
 264         ILIT(36) -> SLIT("$f4");  ILIT(37) -> SLIT("$f5");
 265         ILIT(38) -> SLIT("$f6");  ILIT(39) -> SLIT("$f7");
 266         ILIT(40) -> SLIT("$f8");  ILIT(41) -> SLIT("$f9");
 267         ILIT(42) -> SLIT("$f10"); ILIT(43) -> SLIT("$f11");
 268         ILIT(44) -> SLIT("$f12"); ILIT(45) -> SLIT("$f13");
 269         ILIT(46) -> SLIT("$f14"); ILIT(47) -> SLIT("$f15");
 270         ILIT(48) -> SLIT("$f16"); ILIT(49) -> SLIT("$f17");
 271         ILIT(50) -> SLIT("$f18"); ILIT(51) -> SLIT("$f19");
 272         ILIT(52) -> SLIT("$f20"); ILIT(53) -> SLIT("$f21");
 273         ILIT(54) -> SLIT("$f22"); ILIT(55) -> SLIT("$f23");
 274         ILIT(56) -> SLIT("$f24"); ILIT(57) -> SLIT("$f25");
 275         ILIT(58) -> SLIT("$f26"); ILIT(59) -> SLIT("$f27");
 276         ILIT(60) -> SLIT("$f28"); ILIT(61) -> SLIT("$f29");
 277         ILIT(62) -> SLIT("$f30"); ILIT(63) -> SLIT("$f31");
 278         _ -> SLIT("very naughty alpha register")
 279     })
 280
 281 pprCond :: Cond -> Unpretty
 282 pprCond EQ  = uppPStr SLIT("eq")
 283 pprCond LT  = uppPStr SLIT("lt")
 284 pprCond LE  = uppPStr SLIT("le")
 285 pprCond ULT = uppPStr SLIT("ult")
 286 pprCond ULE = uppPStr SLIT("ule")
 287 pprCond NE  = uppPStr SLIT("ne")
 288 pprCond GT  = uppPStr SLIT("gt")
 289 pprCond GE  = uppPStr SLIT("ge")
 290
 291 pprImm :: PprStyle -> Imm -> Unpretty
 292
 293 pprImm sty (ImmInt i) = uppInt i
 294 pprImm sty (ImmInteger i) = uppInteger i
 295
 296 pprImm sty (ImmCLbl l) = pprCLabel sty l
 297
 298 pprImm sty (ImmLab s) = s
 299
 300 pprAddr :: PprStyle -> Addr -> Unpretty
 301 pprAddr sty (AddrReg reg) = uppBesides [uppLparen, pprReg reg, uppRparen]
 302
 303 pprAddr sty (AddrImm imm) = pprImm sty imm
 304
 305 pprAddr sty (AddrRegImm r1 imm) =
 306     uppBesides [
 307         pprImm sty imm,
 308         uppLparen,
 309         pprReg r1,
 310         uppRparen
 311     ]
 312
 313 pprRI :: PprStyle -> RI -> Unpretty
 314 pprRI sty (RIReg r) = pprReg r
 315 pprRI sty (RIImm r) = pprImm sty r
 316
 317 pprRegRIReg :: PprStyle -> FAST_STRING -> Reg -> RI -> Reg -> Unpretty
 318 pprRegRIReg sty name reg1 ri reg2 =
 319     uppBesides [
 320         uppChar '\t',
 321         uppPStr name,
 322         uppChar '\t',
 323         pprReg reg1,
 324         uppComma,
 325         pprRI sty ri,
 326         uppComma,
 327         pprReg reg2
 328     ]
 329
 330 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Unpretty
 331 pprSizeRegRegReg name size reg1 reg2 reg3 =
 332     uppBesides [
 333         uppChar '\t',
 334         uppPStr name,
 335         pprSize size,
 336         uppChar '\t',
 337         pprReg reg1,
 338         uppComma,
 339         pprReg reg2,
 340         uppComma,
 341         pprReg reg3
 342     ]
 343
 344 pprSize :: Size -> Unpretty
 345 pprSize x = uppPStr
 346     (case x of
 347          B  -> SLIT("b")
 348          BU -> SLIT("bu")
 349          W  -> SLIT("w")
 350          WU -> SLIT("wu")
 351          L  -> SLIT("l")
 352          Q  -> SLIT("q")
 353          FF -> SLIT("f")
 354          DF -> SLIT("d")
 355          GF -> SLIT("g")
 356          SF -> SLIT("s")
 357          TF -> SLIT("t")
 358     )
 359
 360 pprAlphaInstr :: PprStyle -> AlphaInstr -> Unpretty
 361
 362 pprAlphaInstr sty (LD size reg addr) =
 363     uppBesides [
 364         uppPStr SLIT("\tld"),
 365         pprSize size,
 366         uppChar '\t',
 367         pprReg reg,
 368         uppComma,
 369         pprAddr sty addr
 370     ]
 371
 372 pprAlphaInstr sty (LDA reg addr) =
 373     uppBesides [
 374         uppPStr SLIT("\tlda\t"),
 375         pprReg reg,
 376         uppComma,
 377         pprAddr sty addr
 378     ]
 379
 380 pprAlphaInstr sty (LDAH reg addr) =
 381     uppBesides [
 382         uppPStr SLIT("\tldah\t"),
 383         pprReg reg,
 384         uppComma,
 385         pprAddr sty addr
 386     ]
 387
 388 pprAlphaInstr sty (LDGP reg addr) =
 389     uppBesides [
 390         uppPStr SLIT("\tldgp\t"),
 391         pprReg reg,
 392         uppComma,
 393         pprAddr sty addr
 394     ]
 395
 396 pprAlphaInstr sty (LDI size reg imm) =
 397     uppBesides [
 398         uppPStr SLIT("\tldi"),
 399         pprSize size,
 400         uppChar '\t',
 401         pprReg reg,
 402         uppComma,
 403         pprImm sty imm
 404     ]
 405
 406 pprAlphaInstr sty (ST size reg addr) =
 407     uppBesides [
 408         uppPStr SLIT("\tst"),
 409         pprSize size,
 410         uppChar '\t',
 411         pprReg reg,
 412         uppComma,
 413         pprAddr sty addr
 414     ]
 415
 416 pprAlphaInstr sty (CLR reg) =
 417     uppBesides [
 418         uppPStr SLIT("\tclr\t"),
 419         pprReg reg
 420     ]
 421
 422 pprAlphaInstr sty (ABS size ri reg) =
 423     uppBesides [
 424         uppPStr SLIT("\tabs"),
 425         pprSize size,
 426         uppChar '\t',
 427         pprRI sty ri,
 428         uppComma,
 429         pprReg reg
 430     ]
 431
 432 pprAlphaInstr sty (NEG size ov ri reg) =
 433     uppBesides [
 434         uppPStr SLIT("\tneg"),
 435         pprSize size,
 436         if ov then uppPStr SLIT("v\t") else uppChar '\t',
 437         pprRI sty ri,
 438         uppComma,
 439         pprReg reg
 440     ]
 441
 442 pprAlphaInstr sty (ADD size ov reg1 ri reg2) =
 443     uppBesides [
 444         uppPStr SLIT("\tadd"),
 445         pprSize size,
 446         if ov then uppPStr SLIT("v\t") else uppChar '\t',
 447         pprReg reg1,
 448         uppComma,
 449         pprRI sty ri,
 450         uppComma,
 451         pprReg reg2
 452     ]
 453
 454 pprAlphaInstr sty (SADD size scale reg1 ri reg2) =
 455     uppBesides [
 456         uppPStr (case scale of {L -> SLIT("\ts4"); Q -> SLIT("\ts8")}),
 457         uppPStr SLIT("add"),
 458         pprSize size,
 459         uppChar '\t',
 460         pprReg reg1,
 461         uppComma,
 462         pprRI sty ri,
 463         uppComma,
 464         pprReg reg2
 465     ]
 466
 467 pprAlphaInstr sty (SUB size ov reg1 ri reg2) =
 468     uppBesides [
 469         uppPStr SLIT("\tsub"),
 470         pprSize size,
 471         if ov then uppPStr SLIT("v\t") else uppChar '\t',
 472         pprReg reg1,
 473         uppComma,
 474         pprRI sty ri,
 475         uppComma,
 476         pprReg reg2
 477     ]
 478
 479 pprAlphaInstr sty (SSUB size scale reg1 ri reg2) =
 480     uppBesides [
 481         uppPStr (case scale of {L -> SLIT("\ts4"); Q -> SLIT("\ts8")}),
 482         uppPStr SLIT("sub"),
 483         pprSize size,
 484         uppChar '\t',
 485         pprReg reg1,
 486         uppComma,
 487         pprRI sty ri,
 488         uppComma,
 489         pprReg reg2
 490     ]
 491
 492 pprAlphaInstr sty (MUL size ov reg1 ri reg2) =
 493     uppBesides [
 494         uppPStr SLIT("\tmul"),
 495         pprSize size,
 496         if ov then uppPStr SLIT("v\t") else uppChar '\t',
 497         pprReg reg1,
 498         uppComma,
 499         pprRI sty ri,
 500         uppComma,
 501         pprReg reg2
 502     ]
 503
 504 pprAlphaInstr sty (DIV size uns reg1 ri reg2) =
 505     uppBesides [
 506         uppPStr SLIT("\tdiv"),
 507         pprSize size,
 508         if uns then uppPStr SLIT("u\t") else uppChar '\t',
 509         pprReg reg1,
 510         uppComma,
 511         pprRI sty ri,
 512         uppComma,
 513         pprReg reg2
 514     ]
 515
 516 pprAlphaInstr sty (REM size uns reg1 ri reg2) =
 517     uppBesides [
 518         uppPStr SLIT("\trem"),
 519         pprSize size,
 520         if uns then uppPStr SLIT("u\t") else uppChar '\t',
 521         pprReg reg1,
 522         uppComma,
 523         pprRI sty ri,
 524         uppComma,
 525         pprReg reg2
 526     ]
 527
 528 pprAlphaInstr sty (NOT ri reg) =
 529     uppBesides [
 530         uppPStr SLIT("\tnot"),
 531         uppChar '\t',
 532         pprRI sty ri,
 533         uppComma,
 534         pprReg reg
 535     ]
 536
 537 pprAlphaInstr sty (AND reg1 ri reg2) = pprRegRIReg sty SLIT("and") reg1 ri reg2
 538 pprAlphaInstr sty (ANDNOT reg1 ri reg2) = pprRegRIReg sty SLIT("andnot") reg1 ri reg2
 539 pprAlphaInstr sty (OR reg1 ri reg2) = pprRegRIReg sty SLIT("or") reg1 ri reg2
 540 pprAlphaInstr sty (ORNOT reg1 ri reg2) = pprRegRIReg sty SLIT("ornot") reg1 ri reg2
 541 pprAlphaInstr sty (XOR reg1 ri reg2) = pprRegRIReg sty SLIT("xor") reg1 ri reg2
 542 pprAlphaInstr sty (XORNOT reg1 ri reg2) = pprRegRIReg sty SLIT("xornot") reg1 ri reg2
 543
 544 pprAlphaInstr sty (SLL reg1 ri reg2) = pprRegRIReg sty SLIT("sll") reg1 ri reg2
 545 pprAlphaInstr sty (SRL reg1 ri reg2) = pprRegRIReg sty SLIT("srl") reg1 ri reg2
 546 pprAlphaInstr sty (SRA reg1 ri reg2) = pprRegRIReg sty SLIT("sra") reg1 ri reg2
 547
 548 pprAlphaInstr sty (ZAP reg1 ri reg2) = pprRegRIReg sty SLIT("zap") reg1 ri reg2
 549 pprAlphaInstr sty (ZAPNOT reg1 ri reg2) = pprRegRIReg sty SLIT("zapnot") reg1 ri reg2
 550
 551 pprAlphaInstr sty (NOP) = uppPStr SLIT("\tnop")
 552
 553 pprAlphaInstr sty (CMP cond reg1 ri reg2) =
 554     uppBesides [
 555         uppPStr SLIT("\tcmp"),
 556         pprCond cond,
 557         uppChar '\t',
 558         pprReg reg1,
 559         uppComma,
 560         pprRI sty ri,
 561         uppComma,
 562         pprReg reg2
 563     ]
 564
 565 pprAlphaInstr sty (FCLR reg) =
 566     uppBesides [
 567         uppPStr SLIT("\tfclr\t"),
 568         pprReg reg
 569     ]
 570
 571 pprAlphaInstr sty (FABS reg1 reg2) =
 572     uppBesides [
 573         uppPStr SLIT("\tfabs\t"),
 574         pprReg reg1,
 575         uppComma,
 576         pprReg reg2
 577     ]
 578
 579 pprAlphaInstr sty (FNEG size reg1 reg2) =
 580     uppBesides [
 581         uppPStr SLIT("\tneg"),
 582         pprSize size,
 583         uppChar '\t',
 584         pprReg reg1,
 585         uppComma,
 586         pprReg reg2
 587     ]
 588
 589 pprAlphaInstr sty (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
 590 pprAlphaInstr sty (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
 591 pprAlphaInstr sty (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
 592 pprAlphaInstr sty (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
 593
 594 pprAlphaInstr sty (CVTxy size1 size2 reg1 reg2) =
 595     uppBesides [
 596         uppPStr SLIT("\tcvt"),
 597         pprSize size1,
 598         case size2 of {Q -> uppPStr SLIT("qc"); _ -> pprSize size2},
 599         uppChar '\t',
 600         pprReg reg1,
 601         uppComma,
 602         pprReg reg2
 603     ]
 604
 605 pprAlphaInstr sty (FCMP size cond reg1 reg2 reg3) =
 606     uppBesides [
 607         uppPStr SLIT("\tcmp"),
 608         pprSize size,
 609         pprCond cond,
 610         uppChar '\t',
 611         pprReg reg1,
 612         uppComma,
 613         pprReg reg2,
 614         uppComma,
 615         pprReg reg3
 616     ]
 617
 618 pprAlphaInstr sty (FMOV reg1 reg2) =
 619     uppBesides [
 620         uppPStr SLIT("\tfmov\t"),
 621         pprReg reg1,
 622         uppComma,
 623         pprReg reg2
 624     ]
 625
 626 pprAlphaInstr sty (BI ALWAYS reg lab) = pprAlphaInstr sty (BR lab)
 627
 628 pprAlphaInstr sty (BI NEVER reg lab) = uppNil
 629
 630 pprAlphaInstr sty (BI cond reg lab) =
 631     uppBesides [
 632         uppPStr SLIT("\tb"),
 633         pprCond cond,
 634         uppChar '\t',
 635         pprReg reg,
 636         uppComma,
 637         pprImm sty lab
 638     ]
 639
 640 pprAlphaInstr sty (BF cond reg lab) =
 641     uppBesides [
 642         uppPStr SLIT("\tfb"),
 643         pprCond cond,
 644         uppChar '\t',
 645         pprReg reg,
 646         uppComma,
 647         pprImm sty lab
 648     ]
 649
 650 pprAlphaInstr sty (BR lab) =
 651     uppBeside (uppPStr SLIT("\tbr\t")) (pprImm sty lab)
 652
 653 pprAlphaInstr sty (JMP reg addr hint) =
 654     uppBesides [
 655         uppPStr SLIT("\tjmp\t"),
 656         pprReg reg,
 657         uppComma,
 658         pprAddr sty addr,
 659         uppComma,
 660         uppInt hint
 661     ]
 662
 663 pprAlphaInstr sty (BSR imm n) =
 664     uppBeside (uppPStr SLIT("\tbsr\t")) (pprImm sty imm)
 665
 666 pprAlphaInstr sty (JSR reg addr n) =
 667     uppBesides [
 668         uppPStr SLIT("\tjsr\t"),
 669         pprReg reg,
 670         uppComma,
 671         pprAddr sty addr
 672     ]
 673
 674 pprAlphaInstr sty (LABEL clab) =
 675     uppBesides [
 676         if (externallyVisibleCLabel clab) then
 677             uppBesides [uppPStr SLIT("\t.globl\t"), pprLab, uppChar '\n']
 678         else
 679             uppNil,
 680         pprLab,
 681         uppChar ':'
 682     ]
 683     where pprLab = pprCLabel sty clab
 684
 685 pprAlphaInstr sty (FUNBEGIN clab) =
 686     uppBesides [
 687         if (externallyVisibleCLabel clab) then
 688             uppBesides [uppPStr SLIT("\t.globl\t"), pprLab, uppChar '\n']
 689         else
 690             uppNil,
 691         uppPStr SLIT("\t.ent "),
 692         pprLab,
 693         uppChar '\n',
 694         pprLab,
 695         pp_ldgp,
 696         pprLab,
 697         pp_frame
 698     ]
 699     where
 700         pprLab = pprCLabel sty clab
 701 #ifdef USE_FAST_STRINGS
 702         pp_ldgp  = uppPStr (_packCString (A# ":\n\tldgp $29,0($27)\n"#))
 703         pp_frame = uppPStr (_packCString (A# "..ng:\n\t.frame $30,4240,$26,0\n\t.prologue 1"#))
 704 #else
 705         pp_ldgp  = uppStr ":\n\tldgp $29,0($27)\n"
 706         pp_frame = uppStr "..ng:\n\t.frame $30,4240,$26,0\n\t.prologue 1"
 707 #endif
 708
 709 pprAlphaInstr sty (FUNEND clab) =
 710     uppBeside (uppPStr SLIT("\t.align 4\n\t.end ")) (pprCLabel sty clab)
 711
 712 pprAlphaInstr sty (COMMENT s) = uppBeside (uppPStr SLIT("\t# ")) (uppPStr s)
 713
 714 pprAlphaInstr sty (SEGMENT TextSegment)
 715     = uppPStr SLIT("\t.text\n\t.align 3")
 716
 717 pprAlphaInstr sty (SEGMENT DataSegment)
 718     = uppPStr SLIT("\t.data\n\t.align 3")
 719
 720 pprAlphaInstr sty (ASCII False str) =
 721     uppBesides [
 722         uppStr "\t.asciz \"",
 723         uppStr str,
 724         uppChar '"'
 725     ]
 726
 727 pprAlphaInstr sty (ASCII True str) = uppBeside (uppStr "\t.ascii \"") (asciify str 60)
 728     where
 729         asciify :: String -> Int -> Unpretty
 730         asciify [] _ = uppStr ("\\0\"")
 731         asciify s n | n <= 0 = uppBeside (uppStr "\"\n\t.ascii \"") (asciify s 60)
 732         asciify ('\\':cs) n = uppBeside (uppStr "\\\\") (asciify cs (n-1))
 733         asciify ('\"':cs) n = uppBeside (uppStr "\\\"") (asciify cs (n-1))
 734         asciify (c:cs) n | isPrint c = uppBeside (uppChar c) (asciify cs (n-1))
 735         asciify [c] _ = uppBeside (uppStr (charToC c)) (uppStr ("\\0\""))
 736         asciify (c:(cs@(d:_))) n | isDigit d =
 737                                         uppBeside (uppStr (charToC c)) (asciify cs 0)
 738                                  | otherwise =
 739                                         uppBeside (uppStr (charToC c)) (asciify cs (n-1))
 740
 741 pprAlphaInstr sty (DATA s xs) = uppInterleave (uppChar '\n') (map pp_item xs)
 742     where pp_item x = case s of
 743             B  -> uppBeside (uppPStr SLIT("\t.byte\t")) (pprImm sty x)
 744             BU -> uppBeside (uppPStr SLIT("\t.byte\t")) (pprImm sty x)
 745             W  -> uppBeside (uppPStr SLIT("\t.word\t")) (pprImm sty x)
 746             WU -> uppBeside (uppPStr SLIT("\t.word\t")) (pprImm sty x)
 747             L  -> uppBeside (uppPStr SLIT("\t.long\t")) (pprImm sty x)
 748             Q  -> uppBeside (uppPStr SLIT("\t.quad\t")) (pprImm sty x)
 749             FF -> uppBeside (uppPStr SLIT("\t.f_floating\t")) (pprImm sty x)
 750             DF -> uppBeside (uppPStr SLIT("\t.d_floating\t")) (pprImm sty x)
 751             GF -> uppBeside (uppPStr SLIT("\t.g_floating\t")) (pprImm sty x)
 752             SF -> uppBeside (uppPStr SLIT("\t.s_floating\t")) (pprImm sty x)
 753             TF -> uppBeside (uppPStr SLIT("\t.t_floating\t")) (pprImm sty x)
 754
 755 \end{code}
 756
 757 %************************************************************************
 758 %*                                                                      *
 759 \subsection[Schedule]{Register allocation information}
 760 %*                                                                      *
 761 %************************************************************************
 762
 763 \begin{code}
 764
 765 data AlphaRegs = SRegs BitSet BitSet
 766
 767 instance MachineRegisters AlphaRegs where
 768     mkMRegs xs = SRegs (mkBS ints) (mkBS floats')
 769       where
 770         (ints, floats) = partition (< 32) xs
 771         floats' = map (subtract 32) floats
 772
 773     possibleMRegs FloatRep (SRegs _ floats) = [ x + 32 | x <- listBS floats]
 774     possibleMRegs DoubleRep (SRegs _ floats) = [ x + 32 | x <- listBS floats]
 775     possibleMRegs _ (SRegs ints _) = listBS ints
 776
 777     useMReg (SRegs ints floats) n =
 778         if n _LT_ ILIT(32) then SRegs (ints `minusBS` singletonBS IBOX(n)) floats
 779         else SRegs ints (floats `minusBS` singletonBS (IBOX(n _SUB_ ILIT(32))))
 780
 781     useMRegs (SRegs ints floats) xs =
 782         SRegs (ints `minusBS` ints')
 783               (floats `minusBS` floats')
 784       where
 785         SRegs ints' floats' = mkMRegs xs
 786
 787     freeMReg (SRegs ints floats) n =
 788         if n _LT_ ILIT(32) then SRegs (ints `unionBS` singletonBS IBOX(n)) floats
 789         else SRegs ints (floats `unionBS` singletonBS (IBOX(n _SUB_ ILIT(32))))
 790
 791     freeMRegs (SRegs ints floats) xs =
 792         SRegs (ints `unionBS` ints')
 793               (floats `unionBS` floats')
 794       where
 795         SRegs ints' floats' = mkMRegs xs
 796
 797 instance MachineCode AlphaInstr where
 798     regUsage = alphaRegUsage
 799     regLiveness = alphaRegLiveness
 800     patchRegs = alphaPatchRegs
 801
 802     -- We spill just below the frame pointer, leaving two words per spill location.
 803     spillReg dyn (MemoryReg i pk) = mkUnitList (ST (kindToSize pk) dyn (spRel i))
 804     loadReg (MemoryReg i pk) dyn = mkUnitList (LD (kindToSize pk) dyn (spRel i))
 805
 806 spRel :: Int -> Addr
 807 spRel n = AddrRegImm sp (ImmInt (n * 8))
 808
 809 kindToSize :: PrimRep -> Size
 810 kindToSize PtrRep           = Q
 811 kindToSize CodePtrRep       = Q
 812 kindToSize DataPtrRep       = Q
 813 kindToSize RetRep           = Q
 814 kindToSize CostCentreRep   = Q
 815 kindToSize CharRep          = BU
 816 kindToSize IntRep           = Q
 817 kindToSize WordRep          = Q
 818 kindToSize AddrRep          = Q
 819 kindToSize FloatRep         = TF
 820 kindToSize DoubleRep        = TF
 821 kindToSize ArrayRep         = Q
 822 kindToSize ByteArrayRep    = Q
 823 kindToSize StablePtrRep    = Q
 824 kindToSize MallocPtrRep    = Q
 825
 826 \end{code}
 827
 828 @alphaRegUsage@ returns the sets of src and destination registers used by
 829 a particular instruction.  Machine registers that are pre-allocated
 830 to stgRegs are filtered out, because they are uninteresting from a
 831 register allocation standpoint.  (We wouldn't want them to end up on
 832 the free list!)
 833
 834 \begin{code}
 835
 836 alphaRegUsage :: AlphaInstr -> RegUsage
 837 alphaRegUsage instr = case instr of
 838     LD B reg addr       -> usage (regAddr addr, [reg, t9])
 839     LD BU reg addr      -> usage (regAddr addr, [reg, t9])
 840     LD W reg addr       -> usage (regAddr addr, [reg, t9])
 841     LD WU reg addr      -> usage (regAddr addr, [reg, t9])
 842     LD sz reg addr      -> usage (regAddr addr, [reg])
 843     LDA reg addr        -> usage (regAddr addr, [reg])
 844     LDAH reg addr       -> usage (regAddr addr, [reg])
 845     LDGP reg addr       -> usage (regAddr addr, [reg])
 846     LDI sz reg imm      -> usage ([], [reg])
 847     ST B reg addr       -> usage (reg : regAddr addr, [t9, t10])
 848     ST W reg addr       -> usage (reg : regAddr addr, [t9, t10])
 849     ST sz reg addr      -> usage (reg : regAddr addr, [])
 850     CLR reg             -> usage ([], [reg])
 851     ABS sz ri reg       -> usage (regRI ri, [reg])
 852     NEG sz ov ri reg    -> usage (regRI ri, [reg])
 853     ADD sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 854     SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 855     SUB sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 856     SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
 857     MUL sz ov r1 ar r2  -> usage (r1 : regRI ar, [r2])
 858     DIV sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
 859     REM sz un r1 ar r2  -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
 860     NOT ri reg          -> usage (regRI ri, [reg])
 861     AND r1 ar r2        -> usage (r1 : regRI ar, [r2])
 862     ANDNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 863     OR r1 ar r2         -> usage (r1 : regRI ar, [r2])
 864     ORNOT r1 ar r2      -> usage (r1 : regRI ar, [r2])
 865     XOR r1 ar r2        -> usage (r1 : regRI ar, [r2])
 866     XORNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 867     SLL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 868     SRL r1 ar r2        -> usage (r1 : regRI ar, [r2])
 869     SRA r1 ar r2        -> usage (r1 : regRI ar, [r2])
 870     ZAP r1 ar r2        -> usage (r1 : regRI ar, [r2])
 871     ZAPNOT r1 ar r2     -> usage (r1 : regRI ar, [r2])
 872     CMP co r1 ar r2     -> usage (r1 : regRI ar, [r2])
 873     FCLR reg            -> usage ([], [reg])
 874     FABS r1 r2          -> usage ([r1], [r2])
 875     FNEG sz r1 r2       -> usage ([r1], [r2])
 876     FADD sz r1 r2 r3    -> usage ([r1, r2], [r3])
 877     FDIV sz r1 r2 r3    -> usage ([r1, r2], [r3])
 878     FMUL sz r1 r2 r3    -> usage ([r1, r2], [r3])
 879     FSUB sz r1 r2 r3    -> usage ([r1, r2], [r3])
 880     CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
 881     FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
 882     FMOV r1 r2          -> usage ([r1], [r2])
 883
 884
 885     -- We assume that all local jumps will be BI/BF/BR.  JMP must be out-of-line.
 886     BI cond reg lbl     -> usage ([reg], [])
 887     BF cond reg lbl     -> usage ([reg], [])
 888     JMP reg addr hint   -> RU (mkUniqSet (filter interesting (regAddr addr))) freeSet
 889
 890     BSR _ n             -> RU (argSet n) callClobberedSet
 891     JSR reg addr n      -> RU (argSet n) callClobberedSet
 892
 893     _                   -> noUsage
 894
 895   where
 896     usage (src, dst) = RU (mkUniqSet (filter interesting src))
 897                           (mkUniqSet (filter interesting dst))
 898
 899     interesting (FixedReg _) = False
 900     interesting _ = True
 901
 902     regAddr (AddrReg r1)      = [r1]
 903     regAddr (AddrRegImm r1 _) = [r1]
 904     regAddr (AddrImm _)       = []
 905
 906     regRI (RIReg r) = [r]
 907     regRI  _    = []
 908
 909 freeRegs :: [Reg]
 910 freeRegs = freeMappedRegs [0..63]
 911
 912 freeMappedRegs :: [Int] -> [Reg]
 913
 914 freeMappedRegs nums
 915   = foldr free [] nums
 916   where
 917     free IBOX(i) acc
 918       = if _IS_TRUE_(freeReg i) then (MappedReg i) : acc else acc
 919
 920 freeSet :: UniqSet Reg
 921 freeSet = mkUniqSet freeRegs
 922
 923 noUsage :: RegUsage
 924 noUsage = RU emptyUniqSet emptyUniqSet
 925
 926 -- Color me CAF-like
 927 argSet :: Int -> UniqSet Reg
 928 argSet 0 = emptyUniqSet
 929 argSet 1 = mkUniqSet (freeMappedRegs [16, fReg 16])
 930 argSet 2 = mkUniqSet (freeMappedRegs [16, 17, fReg 16, fReg 17])
 931 argSet 3 = mkUniqSet (freeMappedRegs [16, 17, 18, fReg 16, fReg 17, fReg 18])
 932 argSet 4 = mkUniqSet (freeMappedRegs [16, 17, 18, 19, fReg 16, fReg 17, fReg 18, fReg 19])
 933 argSet 5 = mkUniqSet (freeMappedRegs [16, 17, 18, 19, 20, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20])
 934 argSet 6 = mkUniqSet (freeMappedRegs [16, 17, 18, 19, 20, 21, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21])
 935
 936 callClobberedSet :: UniqSet Reg
 937 callClobberedSet = mkUniqSet callClobberedRegs
 938   where
 939     callClobberedRegs
 940       = freeMappedRegs
 941           [0, 1, 2, 3, 4, 5, 6, 7, 8,
 942            16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
 943            fReg 0, fReg 1, fReg 10, fReg 11, fReg 12, fReg 13, fReg 14, fReg 15,
 944            fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21, fReg 22, fReg 23,
 945            fReg 24, fReg 25, fReg 26, fReg 27, fReg 28, fReg 29, fReg 30]
 946
 947 \end{code}
 948
 949 @alphaRegLiveness@ takes future liveness information and modifies it according to
 950 the semantics of branches and labels.  (An out-of-line branch clobbers the liveness
 951 passed back by the following instruction; a forward local branch passes back the
 952 liveness from the target label; a conditional branch merges the liveness from the
 953 target and the liveness from its successor; a label stashes away the current liveness
 954 in the future liveness environment).
 955
 956 \begin{code}
 957 alphaRegLiveness :: AlphaInstr -> RegLiveness -> RegLiveness
 958 alphaRegLiveness instr info@(RL live future@(FL all env)) = case instr of
 959
 960     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
 961
 962     BR (ImmCLbl lbl)     -> RL (lookup lbl) future
 963     BI _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionUniqSets` live) future
 964     BF _ _ (ImmCLbl lbl) -> RL (lookup lbl `unionUniqSets` live) future
 965     JMP _ _ _            -> RL emptyUniqSet future
 966     BSR _ _              -> RL live future
 967     JSR _ _ _            -> RL live future
 968     LABEL lbl            -> RL live (FL (all `unionUniqSets` live) (addToFM env lbl live))
 969     _                    -> info
 970
 971   where
 972     lookup lbl = case lookupFM env lbl of
 973         Just regs -> regs
 974         Nothing -> trace ("Missing " ++ (uppShow 80 (pprCLabel (PprForAsm (\_->False) False id) lbl)) ++
 975                           " in future?") emptyUniqSet
 976
 977 \end{code}
 978
 979 @alphaPatchRegs@ takes an instruction (possibly with
 980 MemoryReg/UnmappedReg registers) and changes all register references
 981 according to the supplied environment.
 982
 983 \begin{code}
 984
 985 alphaPatchRegs :: AlphaInstr -> (Reg -> Reg) -> AlphaInstr
 986 alphaPatchRegs instr env = case instr of
 987     LD sz reg addr -> LD sz (env reg) (fixAddr addr)
 988     LDA reg addr -> LDA (env reg) (fixAddr addr)
 989     LDAH reg addr -> LDAH (env reg) (fixAddr addr)
 990     LDGP reg addr -> LDGP (env reg) (fixAddr addr)
 991     LDI sz reg imm -> LDI sz (env reg) imm
 992     ST sz reg addr -> ST sz (env reg) (fixAddr addr)
 993     CLR reg -> CLR (env reg)
 994     ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
 995     NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
 996     ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
 997     SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
 998     SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
 999     SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
1000     MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
1001     DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
1002     REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
1003     NOT ar reg -> NOT (fixRI ar) (env reg)
1004     AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
1005     ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
1006     OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
1007     ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
1008     XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
1009     XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
1010     SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
1011     SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
1012     SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
1013     ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
1014     ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
1015     CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
1016     FCLR reg -> FCLR (env reg)
1017     FABS r1 r2 -> FABS (env r1) (env r2)
1018     FNEG s r1 r2 -> FNEG s (env r1) (env r2)
1019     FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
1020     FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
1021     FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
1022     FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
1023     CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
1024     FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
1025     FMOV r1 r2 -> FMOV (env r1) (env r2)
1026     BI cond reg lbl -> BI cond (env reg) lbl
1027     BF cond reg lbl -> BF cond (env reg) lbl
1028     JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
1029     JSR reg addr i -> JSR (env reg) (fixAddr addr) i
1030     _ -> instr
1031
1032   where
1033     fixAddr (AddrReg r1)       = AddrReg (env r1)
1034     fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
1035     fixAddr other              = other
1036
1037     fixRI (RIReg r) = RIReg (env r)
1038     fixRI other = other
1039
1040 \end{code}
1041
1042 If you value your sanity, do not venture below this line.
1043
1044 \begin{code}
1045
1046 -- platform.h is generate and tells us what the target architecture is
1047 #include "../../includes/platform.h"
1048 #include "../../includes/MachRegs.h"
1049 #include "../../includes/alpha-dec-osf1.h"
1050
1051 -- Redefine the literals used for Alpha floating point register names
1052 -- in the header files.  Gag me with a spoon, eh?
1053
1054 #define f0 32
1055 #define f1 33
1056 #define f2 34
1057 #define f3 35
1058 #define f4 36
1059 #define f5 37
1060 #define f6 38
1061 #define f7 39
1062 #define f8 40
1063 #define f9 41
1064 #define f10 42
1065 #define f11 43
1066 #define f12 44
1067 #define f13 45
1068 #define f14 46
1069 #define f15 47
1070 #define f16 48
1071 #define f17 49
1072 #define f18 50
1073 #define f19 51
1074 #define f20 52
1075 #define f21 53
1076 #define f22 54
1077 #define f23 55
1078 #define f24 56
1079 #define f25 57
1080 #define f26 58
1081 #define f27 59
1082 #define f28 60
1083 #define f29 61
1084 #define f30 62
1085 #define f31 63
1086
1087 baseRegOffset :: MagicId -> Int
1088 baseRegOffset StkOReg                = OFFSET_StkO
1089 baseRegOffset (VanillaReg _ ILIT(1)) = OFFSET_R1
1090 baseRegOffset (VanillaReg _ ILIT(2)) = OFFSET_R2
1091 baseRegOffset (VanillaReg _ ILIT(3)) = OFFSET_R3
1092 baseRegOffset (VanillaReg _ ILIT(4)) = OFFSET_R4
1093 baseRegOffset (VanillaReg _ ILIT(5)) = OFFSET_R5
1094 baseRegOffset (VanillaReg _ ILIT(6)) = OFFSET_R6
1095 baseRegOffset (VanillaReg _ ILIT(7)) = OFFSET_R7
1096 baseRegOffset (VanillaReg _ ILIT(8)) = OFFSET_R8
1097 baseRegOffset (FloatReg ILIT(1))     = OFFSET_Flt1
1098 baseRegOffset (FloatReg ILIT(2))     = OFFSET_Flt2
1099 baseRegOffset (FloatReg ILIT(3))     = OFFSET_Flt3
1100 baseRegOffset (FloatReg ILIT(4))     = OFFSET_Flt4
1101 baseRegOffset (DoubleReg ILIT(1))     = OFFSET_Dbl1
1102 baseRegOffset (DoubleReg ILIT(2))     = OFFSET_Dbl2
1103 baseRegOffset TagReg                 = OFFSET_Tag
1104 baseRegOffset RetReg                 = OFFSET_Ret
1105 baseRegOffset SpA                    = OFFSET_SpA
1106 baseRegOffset SuA                    = OFFSET_SuA
1107 baseRegOffset SpB                    = OFFSET_SpB
1108 baseRegOffset SuB                    = OFFSET_SuB
1109 baseRegOffset Hp                     = OFFSET_Hp
1110 baseRegOffset HpLim                  = OFFSET_HpLim
1111 baseRegOffset LivenessReg            = OFFSET_Liveness
1112 --baseRegOffset ActivityReg          = OFFSET_Activity
1113 #ifdef DEBUG
1114 baseRegOffset BaseReg                = panic "baseRegOffset:BaseReg"
1115 baseRegOffset StdUpdRetVecReg        = panic "baseRegOffset:StgUpdRetVecReg"
1116 baseRegOffset StkStubReg             = panic "baseRegOffset:StkStubReg"
1117 baseRegOffset CurCostCentre          = panic "baseRegOffset:CurCostCentre"
1118 baseRegOffset VoidReg                = panic "baseRegOffset:VoidReg"
1119 #endif
1120
1121 callerSaves :: MagicId -> Bool
1122 #ifdef CALLER_SAVES_Base
1123 callerSaves BaseReg             = True
1124 #endif
1125 #ifdef CALLER_SAVES_StkO
1126 callerSaves StkOReg             = True
1127 #endif
1128 #ifdef CALLER_SAVES_R1
1129 callerSaves (VanillaReg _ ILIT(1))      = True
1130 #endif
1131 #ifdef CALLER_SAVES_R2
1132 callerSaves (VanillaReg _ ILIT(2))    = True
1133 #endif
1134 #ifdef CALLER_SAVES_R3
1135 callerSaves (VanillaReg _ ILIT(3))    = True
1136 #endif
1137 #ifdef CALLER_SAVES_R4
1138 callerSaves (VanillaReg _ ILIT(4))    = True
1139 #endif
1140 #ifdef CALLER_SAVES_R5
1141 callerSaves (VanillaReg _ ILIT(5))    = True
1142 #endif
1143 #ifdef CALLER_SAVES_R6
1144 callerSaves (VanillaReg _ ILIT(6))    = True
1145 #endif
1146 #ifdef CALLER_SAVES_R7
1147 callerSaves (VanillaReg _ ILIT(7))      = True
1148 #endif
1149 #ifdef CALLER_SAVES_R8
1150 callerSaves (VanillaReg _ ILIT(8))    = True
1151 #endif
1152 #ifdef CALLER_SAVES_FltReg1
1153 callerSaves (FloatReg ILIT(1))          = True
1154 #endif
1155 #ifdef CALLER_SAVES_FltReg2
1156 callerSaves (FloatReg ILIT(2))          = True
1157 #endif
1158 #ifdef CALLER_SAVES_FltReg3
1159 callerSaves (FloatReg ILIT(3))          = True
1160 #endif
1161 #ifdef CALLER_SAVES_FltReg4
1162 callerSaves (FloatReg ILIT(4))          = True
1163 #endif
1164 #ifdef CALLER_SAVES_DblReg1
1165 callerSaves (DoubleReg ILIT(1))         = True
1166 #endif
1167 #ifdef CALLER_SAVES_DblReg2
1168 callerSaves (DoubleReg ILIT(2))         = True
1169 #endif
1170 #ifdef CALLER_SAVES_Tag
1171 callerSaves TagReg              = True
1172 #endif
1173 #ifdef CALLER_SAVES_Ret
1174 callerSaves RetReg              = True
1175 #endif
1176 #ifdef CALLER_SAVES_SpA
1177 callerSaves SpA                 = True
1178 #endif
1179 #ifdef CALLER_SAVES_SuA
1180 callerSaves SuA                 = True
1181 #endif
1182 #ifdef CALLER_SAVES_SpB
1183 callerSaves SpB                 = True
1184 #endif
1185 #ifdef CALLER_SAVES_SuB
1186 callerSaves SuB                 = True
1187 #endif
1188 #ifdef CALLER_SAVES_Hp
1189 callerSaves Hp                  = True
1190 #endif
1191 #ifdef CALLER_SAVES_HpLim
1192 callerSaves HpLim               = True
1193 #endif
1194 #ifdef CALLER_SAVES_Liveness
1195 callerSaves LivenessReg         = True
1196 #endif
1197 #ifdef CALLER_SAVES_Activity
1198 --callerSaves ActivityReg               = True
1199 #endif
1200 #ifdef CALLER_SAVES_StdUpdRetVec
1201 callerSaves StdUpdRetVecReg     = True
1202 #endif
1203 #ifdef CALLER_SAVES_StkStub
1204 callerSaves StkStubReg          = True
1205 #endif
1206 callerSaves _                   = False
1207
1208 stgRegMap :: MagicId -> Maybe Reg
1209 #ifdef REG_Base
1210 stgRegMap BaseReg          = Just (FixedReg ILIT(REG_Base))
1211 #endif
1212 #ifdef REG_StkO
1213 stgRegMap StkOReg          = Just (FixedReg ILIT(REG_StkOReg))
1214 #endif
1215 #ifdef REG_R1
1216 stgRegMap (VanillaReg _ ILIT(1)) = Just (FixedReg ILIT(REG_R1))
1217 #endif
1218 #ifdef REG_R2
1219 stgRegMap (VanillaReg _ ILIT(2)) = Just (FixedReg ILIT(REG_R2))
1220 #endif
1221 #ifdef REG_R3
1222 stgRegMap (VanillaReg _ ILIT(3)) = Just (FixedReg ILIT(REG_R3))
1223 #endif
1224 #ifdef REG_R4
1225 stgRegMap (VanillaReg _ ILIT(4)) = Just (FixedReg ILIT(REG_R4))
1226 #endif
1227 #ifdef REG_R5
1228 stgRegMap (VanillaReg _ ILIT(5)) = Just (FixedReg ILIT(REG_R5))
1229 #endif
1230 #ifdef REG_R6
1231 stgRegMap (VanillaReg _ ILIT(6)) = Just (FixedReg ILIT(REG_R6))
1232 #endif
1233 #ifdef REG_R7
1234 stgRegMap (VanillaReg _ ILIT(7)) = Just (FixedReg ILIT(REG_R7))
1235 #endif
1236 #ifdef REG_R8
1237 stgRegMap (VanillaReg _ ILIT(8)) = Just (FixedReg ILIT(REG_R8))
1238 #endif
1239 #ifdef REG_Flt1
1240 stgRegMap (FloatReg ILIT(1))       = Just (FixedReg ILIT(REG_Flt1))
1241 #endif
1242 #ifdef REG_Flt2
1243 stgRegMap (FloatReg ILIT(2))       = Just (FixedReg ILIT(REG_Flt2))
1244 #endif
1245 #ifdef REG_Flt3
1246 stgRegMap (FloatReg ILIT(3))       = Just (FixedReg ILIT(REG_Flt3))
1247 #endif
1248 #ifdef REG_Flt4
1249 stgRegMap (FloatReg ILIT(4))       = Just (FixedReg ILIT(REG_Flt4))
1250 #endif
1251 #ifdef REG_Dbl1
1252 stgRegMap (DoubleReg ILIT(1))      = Just (FixedReg ILIT(REG_Dbl1))
1253 #endif
1254 #ifdef REG_Dbl2
1255 stgRegMap (DoubleReg ILIT(2))      = Just (FixedReg ILIT(REG_Dbl2))
1256 #endif
1257 #ifdef REG_Tag
1258 stgRegMap TagReg           = Just (FixedReg ILIT(REG_TagReg))
1259 #endif
1260 #ifdef REG_Ret
1261 stgRegMap RetReg           = Just (FixedReg ILIT(REG_Ret))
1262 #endif
1263 #ifdef REG_SpA
1264 stgRegMap SpA              = Just (FixedReg ILIT(REG_SpA))
1265 #endif
1266 #ifdef REG_SuA
1267 stgRegMap SuA              = Just (FixedReg ILIT(REG_SuA))
1268 #endif
1269 #ifdef REG_SpB
1270 stgRegMap SpB              = Just (FixedReg ILIT(REG_SpB))
1271 #endif
1272 #ifdef REG_SuB
1273 stgRegMap SuB              = Just (FixedReg ILIT(REG_SuB))
1274 #endif
1275 #ifdef REG_Hp
1276 stgRegMap Hp               = Just (FixedReg ILIT(REG_Hp))
1277 #endif
1278 #ifdef REG_HpLim
1279 stgRegMap HpLim            = Just (FixedReg ILIT(REG_HpLim))
1280 #endif
1281 #ifdef REG_Liveness
1282 stgRegMap LivenessReg      = Just (FixedReg ILIT(REG_Liveness))
1283 #endif
1284 #ifdef REG_Activity
1285 --stgRegMap ActivityReg    = Just (FixedReg ILIT(REG_Activity))
1286 #endif
1287 #ifdef REG_StdUpdRetVec
1288 stgRegMap StdUpdRetVecReg  = Just (FixedReg ILIT(REG_StdUpdRetVec))
1289 #endif
1290 #ifdef REG_StkStub
1291 stgRegMap StkStubReg       = Just (FixedReg ILIT(REG_StkStub))
1292 #endif
1293 stgRegMap _                = Nothing
1294
1295 \end{code}
1296
1297 Here is the list of registers we can use in register allocation.
1298
1299 With a per-instruction clobber list, we might be able to get some of
1300 these back, but it's probably not worth the hassle.
1301
1302 \begin{code}
1303
1304 freeReg :: FAST_INT -> FAST_BOOL
1305
1306 freeReg ILIT(26) = _FALSE_  -- return address (ra)
1307 freeReg ILIT(28) = _FALSE_  -- reserved for the assembler (at)
1308 freeReg ILIT(29) = _FALSE_  -- global pointer (gp)
1309 freeReg ILIT(30) = _FALSE_  -- stack pointer (sp)
1310 freeReg ILIT(31) = _FALSE_  -- always zero (zero)
1311 freeReg ILIT(63) = _FALSE_  -- always zero (f31)
1312
1313 #ifdef REG_Base
1314 freeReg ILIT(REG_Base) = _FALSE_
1315 #endif
1316 #ifdef REG_StkO
1317 freeReg ILIT(REG_StkO) = _FALSE_
1318 #endif
1319 #ifdef REG_R1
1320 freeReg ILIT(REG_R1) = _FALSE_
1321 #endif
1322 #ifdef REG_R2
1323 freeReg ILIT(REG_R2) = _FALSE_
1324 #endif
1325 #ifdef REG_R3
1326 freeReg ILIT(REG_R3) = _FALSE_
1327 #endif
1328 #ifdef REG_R4
1329 freeReg ILIT(REG_R4) = _FALSE_
1330 #endif
1331 #ifdef REG_R5
1332 freeReg ILIT(REG_R5) = _FALSE_
1333 #endif
1334 #ifdef REG_R6
1335 freeReg ILIT(REG_R6) = _FALSE_
1336 #endif
1337 #ifdef REG_R7
1338 freeReg ILIT(REG_R7) = _FALSE_
1339 #endif
1340 #ifdef REG_R8
1341 freeReg ILIT(REG_R8) = _FALSE_
1342 #endif
1343 #ifdef REG_Flt1
1344 freeReg ILIT(REG_Flt1) = _FALSE_
1345 #endif
1346 #ifdef REG_Flt2
1347 freeReg ILIT(REG_Flt2) = _FALSE_
1348 #endif
1349 #ifdef REG_Flt3
1350 freeReg ILIT(REG_Flt3) = _FALSE_
1351 #endif
1352 #ifdef REG_Flt4
1353 freeReg ILIT(REG_Flt4) = _FALSE_
1354 #endif
1355 #ifdef REG_Dbl1
1356 freeReg ILIT(REG_Dbl1) = _FALSE_
1357 #endif
1358 #ifdef REG_Dbl2
1359 freeReg ILIT(REG_Dbl2) = _FALSE_
1360 #endif
1361 #ifdef REG_Tag
1362 freeReg ILIT(REG_Tag) = _FALSE_
1363 #endif
1364 #ifdef REG_Ret
1365 freeReg ILIT(REG_Ret) = _FALSE_
1366 #endif
1367 #ifdef REG_SpA
1368 freeReg ILIT(REG_SpA) = _FALSE_
1369 #endif
1370 #ifdef REG_SuA
1371 freeReg ILIT(REG_SuA) = _FALSE_
1372 #endif
1373 #ifdef REG_SpB
1374 freeReg ILIT(REG_SpB) = _FALSE_
1375 #endif
1376 #ifdef REG_SuB
1377 freeReg ILIT(REG_SuB) = _FALSE_
1378 #endif
1379 #ifdef REG_Hp
1380 freeReg ILIT(REG_Hp) = _FALSE_
1381 #endif
1382 #ifdef REG_HpLim
1383 freeReg ILIT(REG_HpLim) = _FALSE_
1384 #endif
1385 #ifdef REG_Liveness
1386 freeReg ILIT(REG_Liveness) = _FALSE_
1387 #endif
1388 #ifdef REG_Activity
1389 --freeReg ILIT(REG_Activity) = _FALSE_
1390 #endif
1391 #ifdef REG_StdUpdRetVec
1392 freeReg ILIT(REG_StdUpdRetVec) = _FALSE_
1393 #endif
1394 #ifdef REG_StkStub
1395 freeReg ILIT(REG_StkStub) = _FALSE_
1396 #endif
1397 freeReg _ = _TRUE_
1398
1399 reservedRegs :: [Int]
1400 reservedRegs = [NCG_Reserved_I1, NCG_Reserved_I2, NCG_Reserved_F1, NCG_Reserved_F2]
1401
1402 \end{code}