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