compiler/nativeGen/SPARC/Ppr.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Pretty-printing assembly language
   4 --
   5 -- (c) The University of Glasgow 1993-2005
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module SPARC.Ppr (
  10         pprNatCmmTop,
  11         pprBasicBlock,
  12         pprSectionHeader,
  13         pprData,
  14         pprInstr,
  15         pprUserReg,
  16         pprSize,
  17         pprImm,
  18         pprDataItem
  19 )
  20
  21 where
  22
  23 #include "HsVersions.h"
  24 #include "nativeGen/NCG.h"
  25
  26 import SPARC.Regs
  27 import SPARC.Instr
  28 import SPARC.Cond
  29 import SPARC.Imm
  30 import SPARC.AddrMode
  31 import SPARC.Base
  32 import Instruction
  33 import Reg
  34 import Size
  35 import PprBase
  36
  37 import BlockId
  38 import Cmm
  39 import CLabel
  40
  41 import Unique           ( pprUnique )
  42 import qualified Outputable
  43 import Outputable       (Outputable, panic)
  44 import Pretty
  45 import FastString
  46 import Data.Word
  47
  48 -- -----------------------------------------------------------------------------
  49 -- Printing this stuff out
  50
  51 pprNatCmmTop :: NatCmmTop Instr -> Doc
  52 pprNatCmmTop (CmmData section dats) =
  53   pprSectionHeader section $$ vcat (map pprData dats)
  54
  55  -- special case for split markers:
  56 pprNatCmmTop (CmmProc [] lbl _ (ListGraph [])) = pprLabel lbl
  57
  58 pprNatCmmTop (CmmProc info lbl _ (ListGraph blocks)) =
  59   pprSectionHeader Text $$
  60   (if null info then -- blocks guaranteed not null, so label needed
  61        pprLabel lbl
  62    else
  63 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
  64             pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
  65                 <> char ':' $$
  66 #endif
  67        vcat (map pprData info) $$
  68        pprLabel (entryLblToInfoLbl lbl)
  69   ) $$
  70   vcat (map pprBasicBlock blocks)
  71      -- above: Even the first block gets a label, because with branch-chain
  72      -- elimination, it might be the target of a goto.
  73 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
  74         -- If we are using the .subsections_via_symbols directive
  75         -- (available on recent versions of Darwin),
  76         -- we have to make sure that there is some kind of reference
  77         -- from the entry code to a label on the _top_ of of the info table,
  78         -- so that the linker will not think it is unreferenced and dead-strip
  79         -- it. That's why the label is called a DeadStripPreventer (_dsp).
  80   $$ if not (null info)
  81                     then text "\t.long "
  82                       <+> pprCLabel_asm (entryLblToInfoLbl lbl)
  83                       <+> char '-'
  84                       <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
  85                     else empty
  86 #endif
  87
  88
  89 pprBasicBlock :: NatBasicBlock Instr -> Doc
  90 pprBasicBlock (BasicBlock (BlockId id) instrs) =
  91   pprLabel (mkAsmTempLabel id) $$
  92   vcat (map pprInstr instrs)
  93
  94
  95 pprData :: CmmStatic -> Doc
  96 pprData (CmmAlign bytes)         = pprAlign bytes
  97 pprData (CmmDataLabel lbl)       = pprLabel lbl
  98 pprData (CmmString str)          = pprASCII str
  99 pprData (CmmUninitialised bytes) = ptext (sLit ".skip ") <> int bytes
 100 pprData (CmmStaticLit lit)       = pprDataItem lit
 101
 102 pprGloblDecl :: CLabel -> Doc
 103 pprGloblDecl lbl
 104   | not (externallyVisibleCLabel lbl) = empty
 105   | otherwise = ptext IF_ARCH_sparc((sLit ".global "),
 106                                     (sLit ".globl ")) <>
 107                 pprCLabel_asm lbl
 108
 109 pprTypeAndSizeDecl :: CLabel -> Doc
 110 #if linux_TARGET_OS
 111 pprTypeAndSizeDecl lbl
 112   | not (externallyVisibleCLabel lbl) = empty
 113   | otherwise = ptext (sLit ".type ") <>
 114                 pprCLabel_asm lbl <> ptext (sLit ", @object")
 115 #else
 116 pprTypeAndSizeDecl _
 117   = empty
 118 #endif
 119
 120 pprLabel :: CLabel -> Doc
 121 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
 122
 123
 124 pprASCII :: [Word8] -> Doc
 125 pprASCII str
 126   = vcat (map do1 str) $$ do1 0
 127     where
 128        do1 :: Word8 -> Doc
 129        do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
 130
 131 pprAlign :: Int -> Doc
 132 pprAlign bytes =
 133         ptext (sLit ".align ") <> int bytes
 134
 135
 136 -- -----------------------------------------------------------------------------
 137 -- pprInstr: print an 'Instr'
 138
 139 instance Outputable Instr where
 140     ppr  instr  = Outputable.docToSDoc $ pprInstr instr
 141
 142
 143 -- | Pretty print a register.
 144 --      This is an alias of pprReg for legacy reasons, should remove it.
 145 pprUserReg :: Reg -> Doc
 146 pprUserReg = pprReg
 147
 148
 149 -- | Pretty print a register.
 150 pprReg :: Reg -> Doc
 151 pprReg r
 152   = case r of
 153       RealReg i         -> pprReg_ofRegNo i
 154       VirtualRegI  u    -> text "%vI_"  <> asmSDoc (pprUnique u)
 155       VirtualRegHi u    -> text "%vHi_" <> asmSDoc (pprUnique u)
 156       VirtualRegF  u    -> text "%vF_"  <> asmSDoc (pprUnique u)
 157       VirtualRegD  u    -> text "%vD_"  <> asmSDoc (pprUnique u)
 158
 159
 160 -- | Pretty print a register name, based on this register number.
 161 --      The definition has been unfolded so we get a jump-table in the
 162 --      object code. This function is called quite a lot when emitting the asm file..
 163 --
 164 pprReg_ofRegNo :: Int -> Doc
 165 pprReg_ofRegNo i
 166  = ptext
 167     (case i of {
 168          0 -> sLit "%g0";   1 -> sLit "%g1";
 169          2 -> sLit "%g2";   3 -> sLit "%g3";
 170          4 -> sLit "%g4";   5 -> sLit "%g5";
 171          6 -> sLit "%g6";   7 -> sLit "%g7";
 172          8 -> sLit "%o0";   9 -> sLit "%o1";
 173         10 -> sLit "%o2";  11 -> sLit "%o3";
 174         12 -> sLit "%o4";  13 -> sLit "%o5";
 175         14 -> sLit "%o6";  15 -> sLit "%o7";
 176         16 -> sLit "%l0";  17 -> sLit "%l1";
 177         18 -> sLit "%l2";  19 -> sLit "%l3";
 178         20 -> sLit "%l4";  21 -> sLit "%l5";
 179         22 -> sLit "%l6";  23 -> sLit "%l7";
 180         24 -> sLit "%i0";  25 -> sLit "%i1";
 181         26 -> sLit "%i2";  27 -> sLit "%i3";
 182         28 -> sLit "%i4";  29 -> sLit "%i5";
 183         30 -> sLit "%i6";  31 -> sLit "%i7";
 184         32 -> sLit "%f0";  33 -> sLit "%f1";
 185         34 -> sLit "%f2";  35 -> sLit "%f3";
 186         36 -> sLit "%f4";  37 -> sLit "%f5";
 187         38 -> sLit "%f6";  39 -> sLit "%f7";
 188         40 -> sLit "%f8";  41 -> sLit "%f9";
 189         42 -> sLit "%f10"; 43 -> sLit "%f11";
 190         44 -> sLit "%f12"; 45 -> sLit "%f13";
 191         46 -> sLit "%f14"; 47 -> sLit "%f15";
 192         48 -> sLit "%f16"; 49 -> sLit "%f17";
 193         50 -> sLit "%f18"; 51 -> sLit "%f19";
 194         52 -> sLit "%f20"; 53 -> sLit "%f21";
 195         54 -> sLit "%f22"; 55 -> sLit "%f23";
 196         56 -> sLit "%f24"; 57 -> sLit "%f25";
 197         58 -> sLit "%f26"; 59 -> sLit "%f27";
 198         60 -> sLit "%f28"; 61 -> sLit "%f29";
 199         62 -> sLit "%f30"; 63 -> sLit "%f31";
 200         _  -> sLit "very naughty sparc register" })
 201
 202
 203 -- | Pretty print a size for an instruction suffix.
 204 pprSize :: Size -> Doc
 205 pprSize x
 206  = ptext
 207     (case x of
 208         II8     -> sLit "ub"
 209         II16    -> sLit "uh"
 210         II32    -> sLit ""
 211         II64    -> sLit "d"
 212         FF32    -> sLit ""
 213         FF64    -> sLit "d"
 214         _       -> panic "SPARC.Ppr.pprSize: no match")
 215
 216
 217 -- | Pretty print a size for an instruction suffix.
 218 --      eg LD is 32bit on sparc, but LDD is 64 bit.
 219 pprStSize :: Size -> Doc
 220 pprStSize x
 221  = ptext
 222     (case x of
 223         II8   -> sLit "b"
 224         II16  -> sLit "h"
 225         II32  -> sLit ""
 226         II64  -> sLit "x"
 227         FF32  -> sLit ""
 228         FF64  -> sLit "d"
 229         _       -> panic "SPARC.Ppr.pprSize: no match")
 230
 231
 232 -- | Pretty print a condition code.
 233 pprCond :: Cond -> Doc
 234 pprCond c
 235  = ptext
 236     (case c of
 237         ALWAYS  -> sLit ""
 238         NEVER   -> sLit "n"
 239         GEU     -> sLit "geu"
 240         LU      -> sLit "lu"
 241         EQQ     -> sLit "e"
 242         GTT     -> sLit "g"
 243         GE      -> sLit "ge"
 244         GU      -> sLit "gu"
 245         LTT     -> sLit "l"
 246         LE      -> sLit "le"
 247         LEU     -> sLit "leu"
 248         NE      -> sLit "ne"
 249         NEG     -> sLit "neg"
 250         POS     -> sLit "pos"
 251         VC      -> sLit "vc"
 252         VS      -> sLit "vs")
 253
 254
 255 -- | Pretty print an address mode.
 256 pprAddr :: AddrMode -> Doc
 257 pprAddr am
 258  = case am of
 259         AddrRegReg r1 (RealReg 0)
 260          -> pprReg r1
 261
 262         AddrRegReg r1 r2
 263          -> hcat [ pprReg r1, char '+', pprReg r2 ]
 264
 265         AddrRegImm r1 (ImmInt i)
 266          | i == 0               -> pprReg r1
 267          | not (fits13Bits i)   -> largeOffsetError i
 268          | otherwise            -> hcat [ pprReg r1, pp_sign, int i ]
 269          where
 270                 pp_sign = if i > 0 then char '+' else empty
 271
 272         AddrRegImm r1 (ImmInteger i)
 273          | i == 0               -> pprReg r1
 274          | not (fits13Bits i)   -> largeOffsetError i
 275          | otherwise            -> hcat [ pprReg r1, pp_sign, integer i ]
 276          where
 277                 pp_sign = if i > 0 then char '+' else empty
 278
 279         AddrRegImm r1 imm
 280          -> hcat [ pprReg r1, char '+', pprImm imm ]
 281
 282
 283 -- | Pretty print an immediate value.
 284 pprImm :: Imm -> Doc
 285 pprImm imm
 286  = case imm of
 287         ImmInt i        -> int i
 288         ImmInteger i    -> integer i
 289         ImmCLbl l       -> pprCLabel_asm l
 290         ImmIndex l i    -> pprCLabel_asm l <> char '+' <> int i
 291         ImmLit s        -> s
 292
 293         ImmConstantSum a b
 294          -> pprImm a <> char '+' <> pprImm b
 295
 296         ImmConstantDiff a b
 297          -> pprImm a <> char '-' <> lparen <> pprImm b <> rparen
 298
 299         LO i
 300          -> hcat [ text "%lo(", pprImm i, rparen ]
 301
 302         HI i
 303          -> hcat [ text "%hi(", pprImm i, rparen ]
 304
 305         -- these should have been converted to bytes and placed
 306         --      in the data section.
 307         ImmFloat _      -> ptext (sLit "naughty float immediate")
 308         ImmDouble _     -> ptext (sLit "naughty double immediate")
 309
 310
 311 -- | Pretty print a section \/ segment header.
 312 --      On SPARC all the data sections must be at least 8 byte aligned
 313 --      incase we store doubles in them.
 314 --
 315 pprSectionHeader :: Section -> Doc
 316 pprSectionHeader seg
 317  = case seg of
 318         Text                    -> ptext (sLit ".text\n\t.align 4")
 319         Data                    -> ptext (sLit ".data\n\t.align 8")
 320         ReadOnlyData            -> ptext (sLit ".text\n\t.align 8")
 321         RelocatableReadOnlyData -> ptext (sLit ".text\n\t.align 8")
 322         UninitialisedData       -> ptext (sLit ".bss\n\t.align 8")
 323         ReadOnlyData16          -> ptext (sLit ".data\n\t.align 16")
 324         OtherSection _          -> panic "PprMach.pprSectionHeader: unknown section"
 325
 326
 327 -- | Pretty print a data item.
 328 pprDataItem :: CmmLit -> Doc
 329 pprDataItem lit
 330   = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
 331     where
 332         imm = litToImm lit
 333
 334         ppr_item II8   _        = [ptext (sLit "\t.byte\t") <> pprImm imm]
 335         ppr_item II32  _        = [ptext (sLit "\t.long\t") <> pprImm imm]
 336
 337         ppr_item FF32  (CmmFloat r _)
 338          = let bs = floatToBytes (fromRational r)
 339            in  map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
 340
 341         ppr_item FF64 (CmmFloat r _)
 342          = let bs = doubleToBytes (fromRational r)
 343            in  map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
 344
 345         ppr_item II16  _        = [ptext (sLit "\t.short\t") <> pprImm imm]
 346         ppr_item II64  _        = [ptext (sLit "\t.quad\t") <> pprImm imm]
 347         ppr_item _ _            = panic "SPARC.Ppr.pprDataItem: no match"
 348
 349
 350 -- | Pretty print an instruction.
 351 pprInstr :: Instr -> Doc
 352
 353 -- nuke comments.
 354 pprInstr (COMMENT _)
 355         = empty
 356
 357 pprInstr (DELTA d)
 358         = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
 359
 360 -- Newblocks and LData should have been slurped out before producing the .s file.
 361 pprInstr (NEWBLOCK _)
 362         = panic "X86.Ppr.pprInstr: NEWBLOCK"
 363
 364 pprInstr (LDATA _ _)
 365         = panic "PprMach.pprInstr: LDATA"
 366
 367 {-
 368 pprInstr (SPILL reg slot)
 369  = hcat [
 370         ptext (sLit "\tSPILL"),
 371         char '\t',
 372         pprReg reg,
 373         comma,
 374         ptext (sLit "SLOT") <> parens (int slot)]
 375
 376 pprInstr (RELOAD slot reg)
 377  = hcat [
 378         ptext (sLit "\tRELOAD"),
 379         char '\t',
 380         ptext (sLit "SLOT") <> parens (int slot),
 381         comma,
 382         pprReg reg]
 383 -}
 384
 385 -- a clumsy hack for now, to handle possible double alignment problems
 386 -- even clumsier, to allow for RegReg regs that show when doing indexed
 387 -- reads (bytearrays).
 388
 389 -- Translate to the following:
 390 --    add g1,g2,g1
 391 --    ld  [g1],%fn
 392 --    ld  [g1+4],%f(n+1)
 393 --    sub g1,g2,g1           -- to restore g1
 394
 395 pprInstr (LD FF64 (AddrRegReg g1 g2) reg)
 396  = let Just regH        = fPair reg
 397    in vcat [
 398        hcat [ptext (sLit "\tadd\t"), pprReg g1, comma, pprReg g2, comma, pprReg g1],
 399        hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
 400        hcat [pp_ld_lbracket, pprReg g1, ptext (sLit "+4]"), comma, pprReg regH],
 401        hcat [ptext (sLit "\tsub\t"), pprReg g1, comma, pprReg g2, comma, pprReg g1]
 402     ]
 403
 404 -- Translate to
 405 --    ld  [addr],%fn
 406 --    ld  [addr+4],%f(n+1)
 407 pprInstr (LD FF64 addr reg)
 408  = let  Just addr2      = addrOffset addr 4
 409         Just regH       = fPair reg
 410    in   vcat [
 411                hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
 412                hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg regH]
 413             ]
 414
 415
 416 pprInstr (LD size addr reg)
 417  = hcat [
 418        ptext (sLit "\tld"),
 419        pprSize size,
 420        char '\t',
 421        lbrack,
 422        pprAddr addr,
 423        pp_rbracket_comma,
 424        pprReg reg
 425     ]
 426
 427 -- The same clumsy hack as above
 428 -- Translate to the following:
 429 --    add g1,g2,g1
 430 --    st  %fn,[g1]
 431 --    st  %f(n+1),[g1+4]
 432 --    sub g1,g2,g1           -- to restore g1
 433
 434 pprInstr (ST FF64 reg (AddrRegReg g1 g2))
 435  = let  Just regH       = fPair reg
 436    in vcat [
 437        hcat [ptext (sLit "\tadd\t"),    pprReg g1,  comma, pprReg g2, comma, pprReg g1],
 438        hcat [ptext (sLit "\tst\t"),     pprReg reg, pp_comma_lbracket,
 439              pprReg g1, rbrack],
 440        hcat [ptext (sLit "\tst\t"), pprReg regH, pp_comma_lbracket,
 441              pprReg g1, ptext (sLit "+4]")],
 442        hcat [ptext (sLit "\tsub\t"), pprReg g1, comma, pprReg g2, comma, pprReg g1]
 443     ]
 444
 445 -- Translate to
 446 --    st  %fn,[addr]
 447 --    st  %f(n+1),[addr+4]
 448 pprInstr (ST FF64 reg addr)
 449  = let  Just addr2      = addrOffset addr 4
 450         Just regH       = fPair reg
 451    in   vcat [
 452               hcat [ptext (sLit "\tst\t"), pprReg reg, pp_comma_lbracket,
 453                     pprAddr addr, rbrack],
 454               hcat [ptext (sLit "\tst\t"), pprReg regH, pp_comma_lbracket,
 455                     pprAddr addr2, rbrack]
 456             ]
 457
 458
 459 -- no distinction is made between signed and unsigned bytes on stores for the
 460 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
 461 -- so we call a special-purpose pprSize for ST..
 462 pprInstr (ST size reg addr)
 463   = hcat [
 464        ptext (sLit "\tst"),
 465        pprStSize size,
 466        char '\t',
 467        pprReg reg,
 468        pp_comma_lbracket,
 469        pprAddr addr,
 470        rbrack
 471     ]
 472
 473
 474 pprInstr (ADD x cc reg1 ri reg2)
 475         | not x && not cc && riZero ri
 476         = hcat [ ptext (sLit "\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
 477
 478         | otherwise
 479         = pprRegRIReg (if x then sLit "addx" else sLit "add") cc reg1 ri reg2
 480
 481
 482 pprInstr (SUB x cc reg1 ri reg2)
 483         | not x && cc && reg2 == g0
 484         = hcat [ ptext (sLit "\tcmp\t"), pprReg reg1, comma, pprRI ri ]
 485
 486         | not x && not cc && riZero ri
 487         = hcat [ ptext (sLit "\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
 488
 489         | otherwise
 490         = pprRegRIReg (if x then sLit "subx" else sLit "sub") cc reg1 ri reg2
 491
 492 pprInstr (AND  b reg1 ri reg2)  = pprRegRIReg (sLit "and")  b reg1 ri reg2
 493
 494 pprInstr (ANDN b reg1 ri reg2)  = pprRegRIReg (sLit "andn") b reg1 ri reg2
 495
 496 pprInstr (OR b reg1 ri reg2)
 497         | not b && reg1 == g0
 498         = let doit = hcat [ ptext (sLit "\tmov\t"), pprRI ri, comma, pprReg reg2 ]
 499           in  case ri of
 500                    RIReg rrr | rrr == reg2 -> empty
 501                    _                       -> doit
 502
 503         | otherwise
 504         = pprRegRIReg (sLit "or") b reg1 ri reg2
 505
 506 pprInstr (ORN b reg1 ri reg2)   = pprRegRIReg (sLit "orn") b reg1 ri reg2
 507
 508 pprInstr (XOR  b reg1 ri reg2)  = pprRegRIReg (sLit "xor")  b reg1 ri reg2
 509 pprInstr (XNOR b reg1 ri reg2)  = pprRegRIReg (sLit "xnor") b reg1 ri reg2
 510
 511 pprInstr (SLL reg1 ri reg2)     = pprRegRIReg (sLit "sll") False reg1 ri reg2
 512 pprInstr (SRL reg1 ri reg2)     = pprRegRIReg (sLit "srl") False reg1 ri reg2
 513 pprInstr (SRA reg1 ri reg2)     = pprRegRIReg (sLit "sra") False reg1 ri reg2
 514
 515 pprInstr (RDY rd)               = ptext (sLit "\trd\t%y,") <> pprReg rd
 516 pprInstr (WRY reg1 reg2)
 517         = ptext (sLit "\twr\t")
 518                 <> pprReg reg1
 519                 <> char ','
 520                 <> pprReg reg2
 521                 <> char ','
 522                 <> ptext (sLit "%y")
 523
 524 pprInstr (SMUL b reg1 ri reg2)  = pprRegRIReg (sLit "smul")  b reg1 ri reg2
 525 pprInstr (UMUL b reg1 ri reg2)  = pprRegRIReg (sLit "umul")  b reg1 ri reg2
 526 pprInstr (SDIV b reg1 ri reg2)  = pprRegRIReg (sLit "sdiv")  b reg1 ri reg2
 527 pprInstr (UDIV b reg1 ri reg2)  = pprRegRIReg (sLit "udiv")  b reg1 ri reg2
 528
 529 pprInstr (SETHI imm reg)
 530   = hcat [
 531         ptext (sLit "\tsethi\t"),
 532         pprImm imm,
 533         comma,
 534         pprReg reg
 535     ]
 536
 537 pprInstr NOP = ptext (sLit "\tnop")
 538
 539 pprInstr (FABS FF32 reg1 reg2)  = pprSizeRegReg (sLit "fabs") FF32 reg1 reg2
 540 pprInstr (FABS FF64 reg1 reg2)
 541  = let  Just reg1H      = fPair reg1
 542         Just reg2H      = fPair reg2
 543    in
 544     (<>) (pprSizeRegReg (sLit "fabs") FF32 reg1 reg2)
 545     (if (reg1 == reg2) then empty
 546      else (<>) (char '\n')
 547           (pprSizeRegReg (sLit "fmov") FF32 reg1H reg2H))
 548
 549 pprInstr (FABS _ _ _)
 550  =panic "SPARC.Ppr.pprInstr(FABS): no match"
 551
 552 pprInstr (FADD size reg1 reg2 reg3)
 553         = pprSizeRegRegReg (sLit "fadd") size reg1 reg2 reg3
 554
 555 pprInstr (FCMP e size reg1 reg2)
 556         = pprSizeRegReg (if e then sLit "fcmpe" else sLit "fcmp") size reg1 reg2
 557
 558 pprInstr (FDIV size reg1 reg2 reg3)
 559         = pprSizeRegRegReg (sLit "fdiv") size reg1 reg2 reg3
 560
 561 pprInstr (FMOV FF32 reg1 reg2)  = pprSizeRegReg (sLit "fmov") FF32 reg1 reg2
 562 pprInstr (FMOV FF64 reg1 reg2)  = pprSizeRegReg (sLit "fmov") FF64 reg1 reg2
 563
 564 pprInstr (FMOV _ _ _)
 565  =      panic "SPARC.Ppr.pprInstr(FMOV): no match"
 566
 567 {-
 568 pprInstr (FMOV FF64 reg1 reg2)
 569  = let  Just reg1H      = fPair reg1
 570         Just reg2H      = fPair reg2
 571    in
 572     (<>) (pprSizeRegReg (sLit "fmov") FF32 reg1 reg2)
 573     (if (reg1 == reg2) then empty
 574      else (<>) (char '\n')
 575           (pprSizeRegReg (sLit "fmov") FF32 reg1H reg2H))
 576 -}
 577
 578 pprInstr (FMUL size reg1 reg2 reg3)
 579         = pprSizeRegRegReg (sLit "fmul") size reg1 reg2 reg3
 580
 581 pprInstr (FNEG FF32 reg1 reg2)
 582         = pprSizeRegReg (sLit "fneg") FF32 reg1 reg2
 583
 584 pprInstr (FNEG FF64 reg1 reg2)
 585  = let  Just reg1H      = fPair reg1
 586         Just reg2H      = fPair reg2
 587    in
 588     (<>) (pprSizeRegReg (sLit "fneg") FF32 reg1 reg2)
 589     (if (reg1 == reg2) then empty
 590      else (<>) (char '\n')
 591           (pprSizeRegReg (sLit "fmov") FF32 reg1H reg2H))
 592
 593 pprInstr (FNEG _ _ _)
 594         = panic "SPARC.Ppr.pprInstr(FNEG): no match"
 595
 596 pprInstr (FSQRT size reg1 reg2)
 597         = pprSizeRegReg (sLit "fsqrt") size reg1 reg2
 598
 599 pprInstr (FSUB size reg1 reg2 reg3)
 600         = pprSizeRegRegReg (sLit "fsub") size reg1 reg2 reg3
 601
 602 pprInstr (FxTOy size1 size2 reg1 reg2)
 603   = hcat [
 604         ptext (sLit "\tf"),
 605         ptext
 606         (case size1 of
 607             II32  -> sLit "ito"
 608             FF32  -> sLit "sto"
 609             FF64  -> sLit "dto"
 610             _     -> panic "SPARC.Ppr.pprInstr.FxToY: no match"),
 611         ptext
 612         (case size2 of
 613             II32  -> sLit "i\t"
 614             II64  -> sLit "x\t"
 615             FF32  -> sLit "s\t"
 616             FF64  -> sLit "d\t"
 617             _     -> panic "SPARC.Ppr.pprInstr.FxToY: no match"),
 618         pprReg reg1, comma, pprReg reg2
 619     ]
 620
 621
 622 pprInstr (BI cond b (BlockId id))
 623   = hcat [
 624         ptext (sLit "\tb"), pprCond cond,
 625         if b then pp_comma_a else empty,
 626         char '\t',
 627         pprCLabel_asm (mkAsmTempLabel id)
 628     ]
 629
 630 pprInstr (BF cond b (BlockId id))
 631   = hcat [
 632         ptext (sLit "\tfb"), pprCond cond,
 633         if b then pp_comma_a else empty,
 634         char '\t',
 635         pprCLabel_asm (mkAsmTempLabel id)
 636     ]
 637
 638 pprInstr (JMP addr) = (<>) (ptext (sLit "\tjmp\t")) (pprAddr addr)
 639 pprInstr (JMP_TBL op _)  = pprInstr (JMP op)
 640
 641 pprInstr (CALL (Left imm) n _)
 642   = hcat [ ptext (sLit "\tcall\t"), pprImm imm, comma, int n ]
 643 pprInstr (CALL (Right reg) n _)
 644   = hcat [ ptext (sLit "\tcall\t"), pprReg reg, comma, int n ]
 645
 646
 647 -- | Pretty print a RI
 648 pprRI :: RI -> Doc
 649 pprRI (RIReg r) = pprReg r
 650 pprRI (RIImm r) = pprImm r
 651
 652
 653 -- | Pretty print a two reg instruction.
 654 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
 655 pprSizeRegReg name size reg1 reg2
 656   = hcat [
 657         char '\t',
 658         ptext name,
 659         (case size of
 660             FF32 -> ptext (sLit "s\t")
 661             FF64 -> ptext (sLit "d\t")
 662             _    -> panic "SPARC.Ppr.pprSizeRegReg: no match"),
 663
 664         pprReg reg1,
 665         comma,
 666         pprReg reg2
 667     ]
 668
 669
 670 -- | Pretty print a three reg instruction.
 671 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
 672 pprSizeRegRegReg name size reg1 reg2 reg3
 673   = hcat [
 674         char '\t',
 675         ptext name,
 676         (case size of
 677             FF32  -> ptext (sLit "s\t")
 678             FF64  -> ptext (sLit "d\t")
 679             _    -> panic "SPARC.Ppr.pprSizeRegReg: no match"),
 680         pprReg reg1,
 681         comma,
 682         pprReg reg2,
 683         comma,
 684         pprReg reg3
 685     ]
 686
 687
 688 -- | Pretty print an instruction of two regs and a ri.
 689 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
 690 pprRegRIReg name b reg1 ri reg2
 691   = hcat [
 692         char '\t',
 693         ptext name,
 694         if b then ptext (sLit "cc\t") else char '\t',
 695         pprReg reg1,
 696         comma,
 697         pprRI ri,
 698         comma,
 699         pprReg reg2
 700     ]
 701
 702 {-
 703 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
 704 pprRIReg name b ri reg1
 705   = hcat [
 706         char '\t',
 707         ptext name,
 708         if b then ptext (sLit "cc\t") else char '\t',
 709         pprRI ri,
 710         comma,
 711         pprReg reg1
 712     ]
 713 -}
 714
 715
 716 pp_ld_lbracket :: Doc
 717 pp_ld_lbracket    = ptext (sLit "\tld\t[")
 718
 719
 720 pp_rbracket_comma :: Doc
 721 pp_rbracket_comma = text "],"
 722
 723
 724 pp_comma_lbracket :: Doc
 725 pp_comma_lbracket = text ",["
 726
 727
 728 pp_comma_a :: Doc
 729 pp_comma_a        = text ",a"
 730