ghc/compiler/nativeGen/SparcCode.lhs

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