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