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