Ppr.hs 19.3 KB
Newer Older
1 2
{-# LANGUAGE CPP #-}

3 4 5 6 7 8 9 10
-----------------------------------------------------------------------------
--
-- Pretty-printing assembly language
--
-- (c) The University of Glasgow 1993-2005
--
-----------------------------------------------------------------------------

11
{-# OPTIONS_GHC -fno-warn-orphans #-}
Ian Lynagh's avatar
Ian Lynagh committed
12

Sylvain Henry's avatar
Sylvain Henry committed
13
module GHC.CmmToAsm.SPARC.Ppr (
14 15 16 17
        pprNatCmmDecl,
        pprBasicBlock,
        pprData,
        pprInstr,
18
        pprFormat,
19 20
        pprImm,
        pprDataItem
21 22 23 24 25 26
)

where

#include "HsVersions.h"

27
import GHC.Prelude
28

Sylvain Henry's avatar
Sylvain Henry committed
29 30 31 32 33 34 35 36 37 38
import GHC.CmmToAsm.SPARC.Regs
import GHC.CmmToAsm.SPARC.Instr
import GHC.CmmToAsm.SPARC.Cond
import GHC.CmmToAsm.SPARC.Imm
import GHC.CmmToAsm.SPARC.AddrMode
import GHC.CmmToAsm.SPARC.Base
import GHC.CmmToAsm.Instr
import GHC.Platform.Reg
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Ppr
39
import GHC.CmmToAsm.Config
40

41 42 43 44 45 46
import GHC.Cmm hiding (topInfoTable)
import GHC.Cmm.Ppr() -- For Outputable instances
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.Dataflow.Collections
47

Sylvain Henry's avatar
Sylvain Henry committed
48
import GHC.Types.Unique ( pprUniqueAlways )
49
import GHC.Utils.Outputable
50
import GHC.Utils.Panic
John Ericson's avatar
John Ericson committed
51
import GHC.Platform
52
import GHC.Data.FastString
53 54 55 56

-- -----------------------------------------------------------------------------
-- Printing this stuff out

57 58 59 60
pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc
pprNatCmmDecl config (CmmData section dats) =
  pprSectionAlign config section
  $$ pprDatas (ncgPlatform config) dats
61

62 63
pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
  let platform = ncgPlatform config in
64 65
  case topInfoTable proc of
    Nothing ->
Ben Gamari's avatar
Ben Gamari committed
66
        -- special case for code without info table:
67 68 69
        pprSectionAlign config (Section Text lbl) $$
        pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed
        vcat (map (pprBasicBlock platform top_info) blocks)
70

Sylvain Henry's avatar
Sylvain Henry committed
71
    Just (CmmStaticsRaw info_lbl _) ->
72
      (if platformHasSubsectionsViaSymbols platform
73
          then pprSectionAlign config dspSection $$
74 75
               ppr (mkDeadStripPreventer info_lbl) <> char ':'
          else empty) $$
76
      vcat (map (pprBasicBlock platform top_info) blocks) $$
77 78 79 80
      -- above: Even the first block gets a label, because with branch-chain
      -- elimination, it might be the target of a goto.
      (if platformHasSubsectionsViaSymbols platform
       then
81
       -- See Note [Subsections Via Symbols] in X86/Ppr.hs
82 83 84 85 86 87 88 89 90
                text "\t.long "
            <+> ppr info_lbl
            <+> char '-'
            <+> ppr (mkDeadStripPreventer info_lbl)
       else empty)

dspSection :: Section
dspSection = Section Text $
    panic "subsections-via-symbols doesn't combine with split-sections"
91

92 93
pprBasicBlock :: Platform -> LabelMap RawCmmStatics -> NatBasicBlock Instr -> SDoc
pprBasicBlock platform info_env (BasicBlock blockid instrs)
94
  = maybe_infotable $$
95
    pprLabel platform (blockLbl blockid) $$
96 97 98 99
    vcat (map pprInstr instrs)
  where
    maybe_infotable = case mapLookup blockid info_env of
       Nothing   -> empty
Sylvain Henry's avatar
Sylvain Henry committed
100
       Just (CmmStaticsRaw info_lbl info) ->
101
           pprAlignForSection Text $$
102
           vcat (map (pprData platform) info) $$
103
           pprLabel platform info_lbl
104 105


106
pprDatas :: Platform -> RawCmmStatics -> SDoc
107
-- See note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
Sylvain Henry's avatar
Sylvain Henry committed
108
pprDatas _platform (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
109 110 111 112 113 114 115 116
  | lbl == mkIndStaticInfoLabel
  , let labelInd (CmmLabelOff l _) = Just l
        labelInd (CmmLabel l) = Just l
        labelInd _ = Nothing
  , Just ind' <- labelInd ind
  , alias `mayRedirectTo` ind'
  = pprGloblDecl alias
    $$ text ".equiv" <+> ppr alias <> comma <> ppr (CmmLabel ind')
Sylvain Henry's avatar
Sylvain Henry committed
117
pprDatas platform (CmmStaticsRaw lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats)
118

119
pprData :: Platform -> CmmStatic -> SDoc
120 121 122 123 124
pprData platform d = case d of
   CmmString str          -> pprString str
   CmmFileEmbed path      -> pprFileEmbed path
   CmmUninitialised bytes -> text ".skip " <> int bytes
   CmmStaticLit lit       -> pprDataItem platform lit
125

126 127
pprGloblDecl :: CLabel -> SDoc
pprGloblDecl lbl
128
  | not (externallyVisibleCLabel lbl) = empty
129
  | otherwise = text ".global " <> ppr lbl
130

131 132 133
pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc
pprTypeAndSizeDecl platform lbl
    = if platformOS platform == OSLinux && externallyVisibleCLabel lbl
134
      then text ".type " <> ppr lbl <> ptext (sLit ", @object")
135
      else empty
136

137 138 139 140 141
pprLabel :: Platform -> CLabel -> SDoc
pprLabel platform lbl =
   pprGloblDecl lbl
   $$ pprTypeAndSizeDecl platform lbl
   $$ (ppr lbl <> char ':')
142 143 144 145

-- -----------------------------------------------------------------------------
-- pprInstr: print an 'Instr'

Ian Lynagh's avatar
Ian Lynagh committed
146
instance Outputable Instr where
147
    ppr instr = pprInstr instr
148 149 150


-- | Pretty print a register.
151
pprReg :: Reg -> SDoc
152 153
pprReg reg
 = case reg of
154
        RegVirtual vr
155 156 157 158 159 160
         -> case vr of
                VirtualRegI   u -> text "%vI_"   <> pprUniqueAlways u
                VirtualRegHi  u -> text "%vHi_"  <> pprUniqueAlways u
                VirtualRegF   u -> text "%vF_"   <> pprUniqueAlways u
                VirtualRegD   u -> text "%vD_"   <> pprUniqueAlways u

161

162 163 164 165 166 167 168
        RegReal rr
         -> case rr of
                RealRegSingle r1
                 -> pprReg_ofRegNo r1

                RealRegPair r1 r2
                 -> text "(" <> pprReg_ofRegNo r1
169
                 <> vbar     <> pprReg_ofRegNo r2
170
                 <> text ")"
171

172 173 174


-- | Pretty print a register name, based on this register number.
175 176 177
--   The definition has been unfolded so we get a jump-table in the
--   object code. This function is called quite a lot when emitting
--   the asm file..
178
--
179
pprReg_ofRegNo :: Int -> SDoc
180 181 182
pprReg_ofRegNo i
 = ptext
    (case i of {
183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215
         0 -> sLit "%g0";   1 -> sLit "%g1";
         2 -> sLit "%g2";   3 -> sLit "%g3";
         4 -> sLit "%g4";   5 -> sLit "%g5";
         6 -> sLit "%g6";   7 -> sLit "%g7";
         8 -> sLit "%o0";   9 -> sLit "%o1";
        10 -> sLit "%o2";  11 -> sLit "%o3";
        12 -> sLit "%o4";  13 -> sLit "%o5";
        14 -> sLit "%o6";  15 -> sLit "%o7";
        16 -> sLit "%l0";  17 -> sLit "%l1";
        18 -> sLit "%l2";  19 -> sLit "%l3";
        20 -> sLit "%l4";  21 -> sLit "%l5";
        22 -> sLit "%l6";  23 -> sLit "%l7";
        24 -> sLit "%i0";  25 -> sLit "%i1";
        26 -> sLit "%i2";  27 -> sLit "%i3";
        28 -> sLit "%i4";  29 -> sLit "%i5";
        30 -> sLit "%i6";  31 -> sLit "%i7";
        32 -> sLit "%f0";  33 -> sLit "%f1";
        34 -> sLit "%f2";  35 -> sLit "%f3";
        36 -> sLit "%f4";  37 -> sLit "%f5";
        38 -> sLit "%f6";  39 -> sLit "%f7";
        40 -> sLit "%f8";  41 -> sLit "%f9";
        42 -> sLit "%f10"; 43 -> sLit "%f11";
        44 -> sLit "%f12"; 45 -> sLit "%f13";
        46 -> sLit "%f14"; 47 -> sLit "%f15";
        48 -> sLit "%f16"; 49 -> sLit "%f17";
        50 -> sLit "%f18"; 51 -> sLit "%f19";
        52 -> sLit "%f20"; 53 -> sLit "%f21";
        54 -> sLit "%f22"; 55 -> sLit "%f23";
        56 -> sLit "%f24"; 57 -> sLit "%f25";
        58 -> sLit "%f26"; 59 -> sLit "%f27";
        60 -> sLit "%f28"; 61 -> sLit "%f29";
        62 -> sLit "%f30"; 63 -> sLit "%f31";
        _  -> sLit "very naughty sparc register" })
216 217


218 219 220
-- | Pretty print a format for an instruction suffix.
pprFormat :: Format -> SDoc
pprFormat x
221
 = ptext
222
    (case x of
223 224 225 226 227
        II8     -> sLit "ub"
        II16    -> sLit "uh"
        II32    -> sLit ""
        II64    -> sLit "d"
        FF32    -> sLit ""
228
        FF64    -> sLit "d")
229 230


231
-- | Pretty print a format for an instruction suffix.
232
--      eg LD is 32bit on sparc, but LDD is 64 bit.
233 234
pprStFormat :: Format -> SDoc
pprStFormat x
235
 = ptext
236
    (case x of
237 238 239 240 241
        II8   -> sLit "b"
        II16  -> sLit "h"
        II32  -> sLit ""
        II64  -> sLit "x"
        FF32  -> sLit ""
242
        FF64  -> sLit "d")
243

244 245


246
-- | Pretty print a condition code.
247
pprCond :: Cond -> SDoc
248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266
pprCond c
 = ptext
    (case c of
        ALWAYS  -> sLit ""
        NEVER   -> sLit "n"
        GEU     -> sLit "geu"
        LU      -> sLit "lu"
        EQQ     -> sLit "e"
        GTT     -> sLit "g"
        GE      -> sLit "ge"
        GU      -> sLit "gu"
        LTT     -> sLit "l"
        LE      -> sLit "le"
        LEU     -> sLit "leu"
        NE      -> sLit "ne"
        NEG     -> sLit "neg"
        POS     -> sLit "pos"
        VC      -> sLit "vc"
        VS      -> sLit "vs")
267 268 269


-- | Pretty print an address mode.
270 271
pprAddr :: AddrMode -> SDoc
pprAddr am
272
 = case am of
273 274
        AddrRegReg r1 (RegReal (RealRegSingle 0))
         -> pprReg r1
275

276 277
        AddrRegReg r1 r2
         -> hcat [ pprReg r1, char '+', pprReg r2 ]
278

279 280 281 282 283 284
        AddrRegImm r1 (ImmInt i)
         | i == 0               -> pprReg r1
         | not (fits13Bits i)   -> largeOffsetError i
         | otherwise            -> hcat [ pprReg r1, pp_sign, int i ]
         where
                pp_sign = if i > 0 then char '+' else empty
285

286 287 288 289 290 291
        AddrRegImm r1 (ImmInteger i)
         | i == 0               -> pprReg r1
         | not (fits13Bits i)   -> largeOffsetError i
         | otherwise            -> hcat [ pprReg r1, pp_sign, integer i ]
         where
                pp_sign = if i > 0 then char '+' else empty
292

293
        AddrRegImm r1 imm
294
         -> hcat [ pprReg r1, char '+', pprImm imm ]
295 296 297


-- | Pretty print an immediate value.
298 299
pprImm :: Imm -> SDoc
pprImm imm
300
 = case imm of
301 302
        ImmInt i        -> int i
        ImmInteger i    -> integer i
303 304
        ImmCLbl l       -> ppr l
        ImmIndex l i    -> ppr l <> char '+' <> int i
305
        ImmLit s        -> s
306

307
        ImmConstantSum a b
308
         -> pprImm a <> char '+' <> pprImm b
309

310
        ImmConstantDiff a b
311
         -> pprImm a <> char '-' <> lparen <> pprImm b <> rparen
312

313
        LO i
314
         -> hcat [ text "%lo(", pprImm i, rparen ]
315

316
        HI i
317
         -> hcat [ text "%hi(", pprImm i, rparen ]
318 319 320

        -- these should have been converted to bytes and placed
        --      in the data section.
321 322
        ImmFloat _      -> text "naughty float immediate"
        ImmDouble _     -> text "naughty double immediate"
323 324 325


-- | Pretty print a section \/ segment header.
326 327
--      On SPARC all the data sections must be at least 8 byte aligned
--      incase we store doubles in them.
328
--
329 330 331
pprSectionAlign :: NCGConfig -> Section -> SDoc
pprSectionAlign config sec@(Section seg _) =
    pprSectionHeader config sec $$
332 333 334 335 336
    pprAlignForSection seg

-- | Print appropriate alignment for the given section type.
pprAlignForSection :: SectionType -> SDoc
pprAlignForSection seg =
337 338 339 340 341 342 343 344
    ptext (case seg of
      Text              -> sLit ".align 4"
      Data              -> sLit ".align 8"
      ReadOnlyData      -> sLit ".align 8"
      RelocatableReadOnlyData
                        -> sLit ".align 8"
      UninitialisedData -> sLit ".align 8"
      ReadOnlyData16    -> sLit ".align 16"
345 346 347
      -- TODO: This is copied from the ReadOnlyData case, but it can likely be
      -- made more efficient.
      CString           -> sLit ".align 8"
348
      OtherSection _    -> panic "PprMach.pprSectionHeader: unknown section")
349 350

-- | Pretty print a data item.
351 352 353
pprDataItem :: Platform -> CmmLit -> SDoc
pprDataItem platform lit
  = vcat (ppr_item (cmmTypeFormat $ cmmLitType platform lit) lit)
354
    where
355
        imm = litToImm lit
356

357 358
        ppr_item II8   _        = [text "\t.byte\t" <> pprImm imm]
        ppr_item II32  _        = [text "\t.long\t" <> pprImm imm]
359

360
        ppr_item FF32  (CmmFloat r _)
361
         = let bs = floatToBytes (fromRational r)
362
           in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
363

364
        ppr_item FF64 (CmmFloat r _)
365
         = let bs = doubleToBytes (fromRational r)
366
           in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
367

368 369
        ppr_item II16  _        = [text "\t.short\t" <> pprImm imm]
        ppr_item II64  _        = [text "\t.quad\t" <> pprImm imm]
370
        ppr_item _ _            = panic "SPARC.Ppr.pprDataItem: no match"
371 372 373


-- | Pretty print an instruction.
374
pprInstr :: Instr -> SDoc
375 376

-- nuke comments.
377
pprInstr (COMMENT _)
378
        = empty
379

380 381
pprInstr (DELTA d)
        = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
382 383

-- Newblocks and LData should have been slurped out before producing the .s file.
384
pprInstr (NEWBLOCK _)
385
        = panic "X86.Ppr.pprInstr: NEWBLOCK"
386

387
pprInstr (LDATA _ _)
388
        = panic "PprMach.pprInstr: LDATA"
389

390
-- 64 bit FP loads are expanded into individual instructions in CodeGen.Expand
391
pprInstr (LD FF64 _ reg)
392 393
        | RegReal (RealRegSingle{})     <- reg
        = panic "SPARC.Ppr: not emitting potentially misaligned LD FF64 instr"
394

395
pprInstr (LD format addr reg)
396
        = hcat [
397
               text "\tld",
398
               pprFormat format,
399 400
               char '\t',
               lbrack,
401
               pprAddr addr,
402 403 404
               pp_rbracket_comma,
               pprReg reg
            ]
405

Gabor Greif's avatar
Gabor Greif committed
406
-- 64 bit FP stores are expanded into individual instructions in CodeGen.Expand
407
pprInstr (ST FF64 reg _)
408 409
        | RegReal (RealRegSingle{}) <- reg
        = panic "SPARC.Ppr: not emitting potentially misaligned ST FF64 instr"
410 411 412

-- no distinction is made between signed and unsigned bytes on stores for the
-- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
413 414
-- so we call a special-purpose pprFormat for ST..
pprInstr (ST format reg addr)
415
        = hcat [
416
               text "\tst",
417
               pprStFormat format,
418 419 420
               char '\t',
               pprReg reg,
               pp_comma_lbracket,
421
               pprAddr addr,
422 423
               rbrack
            ]
424 425


426
pprInstr (ADD x cc reg1 ri reg2)
427
        | not x && not cc && riZero ri
428
        = hcat [ text "\tmov\t", pprReg reg1, comma, pprReg reg2 ]
429

430
        | otherwise
431
        = pprRegRIReg (if x then sLit "addx" else sLit "add") cc reg1 ri reg2
432 433


434
pprInstr (SUB x cc reg1 ri reg2)
435
        | not x && cc && reg2 == g0
436
        = hcat [ text "\tcmp\t", pprReg reg1, comma, pprRI ri ]
437 438

        | not x && not cc && riZero ri
439
        = hcat [ text "\tmov\t", pprReg reg1, comma, pprReg reg2 ]
440

441
        | otherwise
442
        = pprRegRIReg (if x then sLit "subx" else sLit "sub") cc reg1 ri reg2
443

444
pprInstr (AND  b reg1 ri reg2) = pprRegRIReg (sLit "and")  b reg1 ri reg2
445

446
pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg (sLit "andn") b reg1 ri reg2
447

448
pprInstr (OR b reg1 ri reg2)
449
        | not b && reg1 == g0
450
        = let doit = hcat [ text "\tmov\t", pprRI ri, comma, pprReg reg2 ]
451 452 453 454 455
          in  case ri of
                   RIReg rrr | rrr == reg2 -> empty
                   _                       -> doit

        | otherwise
456
        = pprRegRIReg (sLit "or") b reg1 ri reg2
457

458
pprInstr (ORN b reg1 ri reg2)  = pprRegRIReg (sLit "orn") b reg1 ri reg2
459

460 461
pprInstr (XOR  b reg1 ri reg2) = pprRegRIReg (sLit "xor")  b reg1 ri reg2
pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg (sLit "xnor") b reg1 ri reg2
462

463 464 465
pprInstr (SLL reg1 ri reg2)    = pprRegRIReg (sLit "sll") False reg1 ri reg2
pprInstr (SRL reg1 ri reg2)    = pprRegRIReg (sLit "srl") False reg1 ri reg2
pprInstr (SRA reg1 ri reg2)    = pprRegRIReg (sLit "sra") False reg1 ri reg2
466

467
pprInstr (RDY rd)              = text "\trd\t%y," <> pprReg rd
468
pprInstr (WRY reg1 reg2)
469
        = text "\twr\t"
470 471 472 473
                <> pprReg reg1
                <> char ','
                <> pprReg reg2
                <> char ','
474
                <> text "%y"
475

476 477 478 479
pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg (sLit "smul")  b reg1 ri reg2
pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg (sLit "umul")  b reg1 ri reg2
pprInstr (SDIV b reg1 ri reg2) = pprRegRIReg (sLit "sdiv")  b reg1 ri reg2
pprInstr (UDIV b reg1 ri reg2) = pprRegRIReg (sLit "udiv")  b reg1 ri reg2
480

481
pprInstr (SETHI imm reg)
482
  = hcat [
483
        text "\tsethi\t",
484
        pprImm imm,
485 486
        comma,
        pprReg reg
487 488
    ]

489
pprInstr NOP
490
        = text "\tnop"
491

492 493
pprInstr (FABS format reg1 reg2)
        = pprFormatRegReg (sLit "fabs") format reg1 reg2
494

495 496
pprInstr (FADD format reg1 reg2 reg3)
        = pprFormatRegRegReg (sLit "fadd") format reg1 reg2 reg3
497

498 499 500
pprInstr (FCMP e format reg1 reg2)
        = pprFormatRegReg (if e then sLit "fcmpe" else sLit "fcmp")
                          format reg1 reg2
501

502 503
pprInstr (FDIV format reg1 reg2 reg3)
        = pprFormatRegRegReg (sLit "fdiv") format reg1 reg2 reg3
504

505 506
pprInstr (FMOV format reg1 reg2)
        = pprFormatRegReg (sLit "fmov") format reg1 reg2
507

508 509
pprInstr (FMUL format reg1 reg2 reg3)
        = pprFormatRegRegReg (sLit "fmul") format reg1 reg2 reg3
510

511 512
pprInstr (FNEG format reg1 reg2)
        = pprFormatRegReg (sLit "fneg") format reg1 reg2
513

514 515
pprInstr (FSQRT format reg1 reg2)
        = pprFormatRegReg (sLit "fsqrt") format reg1 reg2
516

517 518
pprInstr (FSUB format reg1 reg2 reg3)
        = pprFormatRegRegReg (sLit "fsub") format reg1 reg2 reg3
519

520
pprInstr (FxTOy format1 format2 reg1 reg2)
521
  = hcat [
522
        text "\tf",
523
        ptext
524
        (case format1 of
525 526 527 528 529
            II32  -> sLit "ito"
            FF32  -> sLit "sto"
            FF64  -> sLit "dto"
            _     -> panic "SPARC.Ppr.pprInstr.FxToY: no match"),
        ptext
530
        (case format2 of
531 532 533 534 535 536
            II32  -> sLit "i\t"
            II64  -> sLit "x\t"
            FF32  -> sLit "s\t"
            FF64  -> sLit "d\t"
            _     -> panic "SPARC.Ppr.pprInstr.FxToY: no match"),
        pprReg reg1, comma, pprReg reg2
537 538 539
    ]


540
pprInstr (BI cond b blockid)
541
  = hcat [
542
        text "\tb", pprCond cond,
543 544
        if b then pp_comma_a else empty,
        char '\t',
545
        ppr (blockLbl blockid)
546 547
    ]

548
pprInstr (BF cond b blockid)
549
  = hcat [
550
        text "\tfb", pprCond cond,
551 552
        if b then pp_comma_a else empty,
        char '\t',
553
        ppr (blockLbl blockid)
554 555
    ]

556
pprInstr (JMP addr) = text "\tjmp\t" <> pprAddr addr
557
pprInstr (JMP_TBL op _ _)  = pprInstr (JMP op)
558

559
pprInstr (CALL (Left imm) n _)
560
  = hcat [ text "\tcall\t", pprImm imm, comma, int n ]
561

562
pprInstr (CALL (Right reg) n _)
563
  = hcat [ text "\tcall\t", pprReg reg, comma, int n ]
564 565 566


-- | Pretty print a RI
567 568 569
pprRI :: RI -> SDoc
pprRI (RIReg r) = pprReg r
pprRI (RIImm r) = pprImm r
570 571 572


-- | Pretty print a two reg instruction.
Sylvain Henry's avatar
Sylvain Henry committed
573
pprFormatRegReg :: PtrString -> Format -> Reg -> Reg -> SDoc
574
pprFormatRegReg name format reg1 reg2
575
  = hcat [
576 577
        char '\t',
        ptext name,
578
        (case format of
579 580
            FF32 -> text "s\t"
            FF64 -> text "d\t"
581
            _    -> panic "SPARC.Ppr.pprFormatRegReg: no match"),
582 583 584 585

        pprReg reg1,
        comma,
        pprReg reg2
586 587 588 589
    ]


-- | Pretty print a three reg instruction.
Sylvain Henry's avatar
Sylvain Henry committed
590
pprFormatRegRegReg :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
591
pprFormatRegRegReg name format reg1 reg2 reg3
592
  = hcat [
593 594
        char '\t',
        ptext name,
595
        (case format of
596 597
            FF32  -> text "s\t"
            FF64  -> text "d\t"
598
            _    -> panic "SPARC.Ppr.pprFormatRegReg: no match"),
599 600 601 602 603
        pprReg reg1,
        comma,
        pprReg reg2,
        comma,
        pprReg reg3
604 605 606 607
    ]


-- | Pretty print an instruction of two regs and a ri.
Sylvain Henry's avatar
Sylvain Henry committed
608
pprRegRIReg :: PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
609
pprRegRIReg name b reg1 ri reg2
610
  = hcat [
611 612
        char '\t',
        ptext name,
613
        if b then text "cc\t" else char '\t',
614 615
        pprReg reg1,
        comma,
616
        pprRI ri,
617 618
        comma,
        pprReg reg2
619 620 621
    ]

{-
Sylvain Henry's avatar
Sylvain Henry committed
622
pprRIReg :: PtrString -> Bool -> RI -> Reg -> SDoc
623 624
pprRIReg name b ri reg1
  = hcat [
625 626
        char '\t',
        ptext name,
627
        if b then text "cc\t" else char '\t',
628 629 630
        pprRI ri,
        comma,
        pprReg reg1
631 632 633
    ]
-}

634
{-
635
pp_ld_lbracket :: SDoc
636
pp_ld_lbracket    = text "\tld\t["
637
-}
638

639
pp_rbracket_comma :: SDoc
640 641 642
pp_rbracket_comma = text "],"


643
pp_comma_lbracket :: SDoc
644 645 646
pp_comma_lbracket = text ",["


647
pp_comma_a :: SDoc
648
pp_comma_a        = text ",a"