compiler/nativeGen/PPC/Ppr.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Pretty-printing assembly language
   4 --
   5 -- (c) The University of Glasgow 1993-2005
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module PPC.Ppr (
  10         pprNatCmmTop,
  11         pprBasicBlock,
  12         pprSectionHeader,
  13         pprData,
  14         pprInstr,
  15         pprSize,
  16         pprImm,
  17         pprDataItem,
  18 )
  19
  20 where
  21
  22 #include "nativeGen/NCG.h"
  23 #include "HsVersions.h"
  24
  25 import PPC.Regs
  26 import PPC.Instr
  27 import PPC.Cond
  28 import PprBase
  29 import Instruction
  30 import Size
  31 import Reg
  32 import RegClass
  33 import TargetReg
  34
  35 import OldCmm
  36
  37 import CLabel
  38
  39 import Unique           ( pprUnique, Uniquable(..) )
  40 import Pretty
  41 import FastString
  42 import qualified Outputable
  43 import Outputable       ( Outputable, panic )
  44
  45 import Data.Word
  46 import Data.Bits
  47
  48
  49 -- -----------------------------------------------------------------------------
  50 -- Printing this stuff out
  51
  52 pprNatCmmTop :: NatCmmTop Instr -> Doc
  53 pprNatCmmTop (CmmData section dats) =
  54   pprSectionHeader section $$ vcat (map pprData dats)
  55
  56  -- special case for split markers:
  57 pprNatCmmTop (CmmProc [] lbl (ListGraph [])) = pprLabel lbl
  58
  59 pprNatCmmTop (CmmProc info lbl (ListGraph blocks)) =
  60   pprSectionHeader Text $$
  61   (if null info then -- blocks guaranteed not null, so label needed
  62        pprLabel lbl
  63    else
  64 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
  65             pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
  66                 <> char ':' $$
  67 #endif
  68        vcat (map pprData info) $$
  69        pprLabel (entryLblToInfoLbl lbl)
  70   ) $$
  71   vcat (map pprBasicBlock blocks)
  72      -- above: Even the first block gets a label, because with branch-chain
  73      -- elimination, it might be the target of a goto.
  74 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
  75         -- If we are using the .subsections_via_symbols directive
  76         -- (available on recent versions of Darwin),
  77         -- we have to make sure that there is some kind of reference
  78         -- from the entry code to a label on the _top_ of of the info table,
  79         -- so that the linker will not think it is unreferenced and dead-strip
  80         -- it. That's why the label is called a DeadStripPreventer (_dsp).
  81   $$ if not (null info)
  82                     then text "\t.long "
  83                       <+> pprCLabel_asm (entryLblToInfoLbl lbl)
  84                       <+> char '-'
  85                       <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
  86                     else empty
  87 #endif
  88
  89
  90 pprBasicBlock :: NatBasicBlock Instr -> Doc
  91 pprBasicBlock (BasicBlock blockid instrs) =
  92   pprLabel (mkAsmTempLabel (getUnique blockid)) $$
  93   vcat (map pprInstr instrs)
  94
  95
  96 pprData :: CmmStatic -> Doc
  97 pprData (CmmAlign bytes)         = pprAlign bytes
  98 pprData (CmmDataLabel lbl)       = pprLabel lbl
  99 pprData (CmmString str)          = pprASCII str
 100
 101 #if darwin_TARGET_OS
 102 pprData (CmmUninitialised bytes) = ptext (sLit ".space ") <> int bytes
 103 #else
 104 pprData (CmmUninitialised bytes) = ptext (sLit ".skip ") <> int bytes
 105 #endif
 106
 107 pprData (CmmStaticLit lit)       = pprDataItem lit
 108
 109 pprGloblDecl :: CLabel -> Doc
 110 pprGloblDecl lbl
 111   | not (externallyVisibleCLabel lbl) = empty
 112   | otherwise = ptext IF_ARCH_sparc((sLit ".global "),
 113                                     (sLit ".globl ")) <>
 114                 pprCLabel_asm lbl
 115
 116 pprTypeAndSizeDecl :: CLabel -> Doc
 117 #if linux_TARGET_OS
 118 pprTypeAndSizeDecl lbl
 119   | not (externallyVisibleCLabel lbl) = empty
 120   | otherwise = ptext (sLit ".type ") <>
 121                 pprCLabel_asm lbl <> ptext (sLit ", @object")
 122 #else
 123 pprTypeAndSizeDecl _
 124   = empty
 125 #endif
 126
 127 pprLabel :: CLabel -> Doc
 128 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
 129
 130
 131 pprASCII :: [Word8] -> Doc
 132 pprASCII str
 133   = vcat (map do1 str) $$ do1 0
 134     where
 135        do1 :: Word8 -> Doc
 136        do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
 137
 138 pprAlign :: Int -> Doc
 139 pprAlign bytes =
 140         ptext (sLit ".align ") <> int pow2
 141   where
 142         pow2 = log2 bytes
 143
 144         log2 :: Int -> Int  -- cache the common ones
 145         log2 1 = 0
 146         log2 2 = 1
 147         log2 4 = 2
 148         log2 8 = 3
 149         log2 n = 1 + log2 (n `quot` 2)
 150
 151
 152 -- -----------------------------------------------------------------------------
 153 -- pprInstr: print an 'Instr'
 154
 155 instance Outputable Instr where
 156     ppr  instr  = Outputable.docToSDoc $ pprInstr instr
 157
 158
 159 pprReg :: Reg -> Doc
 160
 161 pprReg r
 162   = case r of
 163       RegReal    (RealRegSingle i) -> ppr_reg_no i
 164       RegReal    (RealRegPair{})   -> panic "PPC.pprReg: no reg pairs on this arch"
 165       RegVirtual (VirtualRegI  u)  -> text "%vI_" <> asmSDoc (pprUnique u)
 166       RegVirtual (VirtualRegHi u)  -> text "%vHi_" <> asmSDoc (pprUnique u)
 167       RegVirtual (VirtualRegF  u)  -> text "%vF_" <> asmSDoc (pprUnique u)
 168       RegVirtual (VirtualRegD  u)  -> text "%vD_" <> asmSDoc (pprUnique u)
 169       RegVirtual (VirtualRegSSE  u) -> text "%vSSE_" <> asmSDoc (pprUnique u)
 170   where
 171 #if darwin_TARGET_OS
 172     ppr_reg_no :: Int -> Doc
 173     ppr_reg_no i = ptext
 174       (case i of {
 175          0 -> sLit "r0";   1 -> sLit "r1";
 176          2 -> sLit "r2";   3 -> sLit "r3";
 177          4 -> sLit "r4";   5 -> sLit "r5";
 178          6 -> sLit "r6";   7 -> sLit "r7";
 179          8 -> sLit "r8";   9 -> sLit "r9";
 180         10 -> sLit "r10";  11 -> sLit "r11";
 181         12 -> sLit "r12";  13 -> sLit "r13";
 182         14 -> sLit "r14";  15 -> sLit "r15";
 183         16 -> sLit "r16";  17 -> sLit "r17";
 184         18 -> sLit "r18";  19 -> sLit "r19";
 185         20 -> sLit "r20";  21 -> sLit "r21";
 186         22 -> sLit "r22";  23 -> sLit "r23";
 187         24 -> sLit "r24";  25 -> sLit "r25";
 188         26 -> sLit "r26";  27 -> sLit "r27";
 189         28 -> sLit "r28";  29 -> sLit "r29";
 190         30 -> sLit "r30";  31 -> sLit "r31";
 191         32 -> sLit "f0";  33 -> sLit "f1";
 192         34 -> sLit "f2";  35 -> sLit "f3";
 193         36 -> sLit "f4";  37 -> sLit "f5";
 194         38 -> sLit "f6";  39 -> sLit "f7";
 195         40 -> sLit "f8";  41 -> sLit "f9";
 196         42 -> sLit "f10"; 43 -> sLit "f11";
 197         44 -> sLit "f12"; 45 -> sLit "f13";
 198         46 -> sLit "f14"; 47 -> sLit "f15";
 199         48 -> sLit "f16"; 49 -> sLit "f17";
 200         50 -> sLit "f18"; 51 -> sLit "f19";
 201         52 -> sLit "f20"; 53 -> sLit "f21";
 202         54 -> sLit "f22"; 55 -> sLit "f23";
 203         56 -> sLit "f24"; 57 -> sLit "f25";
 204         58 -> sLit "f26"; 59 -> sLit "f27";
 205         60 -> sLit "f28"; 61 -> sLit "f29";
 206         62 -> sLit "f30"; 63 -> sLit "f31";
 207         _  -> sLit "very naughty powerpc register"
 208       })
 209 #else
 210     ppr_reg_no :: Int -> Doc
 211     ppr_reg_no i | i <= 31 = int i      -- GPRs
 212                  | i <= 63 = int (i-32) -- FPRs
 213                  | otherwise = ptext (sLit "very naughty powerpc register")
 214 #endif
 215
 216
 217
 218 pprSize :: Size -> Doc
 219 pprSize x
 220  = ptext (case x of
 221                 II8     -> sLit "b"
 222                 II16    -> sLit "h"
 223                 II32    -> sLit "w"
 224                 FF32    -> sLit "fs"
 225                 FF64    -> sLit "fd"
 226                 _       -> panic "PPC.Ppr.pprSize: no match")
 227
 228
 229 pprCond :: Cond -> Doc
 230 pprCond c
 231  = ptext (case c of {
 232                 ALWAYS  -> sLit "";
 233                 EQQ     -> sLit "eq";   NE    -> sLit "ne";
 234                 LTT     -> sLit "lt";  GE    -> sLit "ge";
 235                 GTT     -> sLit "gt";  LE    -> sLit "le";
 236                 LU      -> sLit "lt";  GEU   -> sLit "ge";
 237                 GU      -> sLit "gt";  LEU   -> sLit "le"; })
 238
 239
 240 pprImm :: Imm -> Doc
 241
 242 pprImm (ImmInt i)     = int i
 243 pprImm (ImmInteger i) = integer i
 244 pprImm (ImmCLbl l)    = pprCLabel_asm l
 245 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
 246 pprImm (ImmLit s)     = s
 247
 248 pprImm (ImmFloat _)  = ptext (sLit "naughty float immediate")
 249 pprImm (ImmDouble _) = ptext (sLit "naughty double immediate")
 250
 251 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
 252 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
 253                             <> lparen <> pprImm b <> rparen
 254
 255 #if darwin_TARGET_OS
 256 pprImm (LO i)
 257   = hcat [ pp_lo, pprImm i, rparen ]
 258   where
 259     pp_lo = text "lo16("
 260
 261 pprImm (HI i)
 262   = hcat [ pp_hi, pprImm i, rparen ]
 263   where
 264     pp_hi = text "hi16("
 265
 266 pprImm (HA i)
 267   = hcat [ pp_ha, pprImm i, rparen ]
 268   where
 269     pp_ha = text "ha16("
 270
 271 #else
 272 pprImm (LO i)
 273   = pprImm i <> text "@l"
 274
 275 pprImm (HI i)
 276   = pprImm i <> text "@h"
 277
 278 pprImm (HA i)
 279   = pprImm i <> text "@ha"
 280 #endif
 281
 282
 283
 284 pprAddr :: AddrMode -> Doc
 285 pprAddr (AddrRegReg r1 r2)
 286   = pprReg r1 <+> ptext (sLit ", ") <+> pprReg r2
 287
 288 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
 289 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
 290 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
 291
 292
 293 pprSectionHeader :: Section -> Doc
 294 #if darwin_TARGET_OS
 295 pprSectionHeader seg
 296  = case seg of
 297         Text                    -> ptext (sLit ".text\n.align 2")
 298         Data                    -> ptext (sLit ".data\n.align 2")
 299         ReadOnlyData            -> ptext (sLit ".const\n.align 2")
 300         RelocatableReadOnlyData -> ptext (sLit ".const_data\n.align 2")
 301         UninitialisedData       -> ptext (sLit ".const_data\n.align 2")
 302         ReadOnlyData16          -> ptext (sLit ".const\n.align 4")
 303         OtherSection _          -> panic "PprMach.pprSectionHeader: unknown section"
 304
 305 #else
 306 pprSectionHeader seg
 307  = case seg of
 308         Text                    -> ptext (sLit ".text\n.align 2")
 309         Data                    -> ptext (sLit ".data\n.align 2")
 310         ReadOnlyData            -> ptext (sLit ".section .rodata\n\t.align 2")
 311         RelocatableReadOnlyData -> ptext (sLit ".data\n\t.align 2")
 312         UninitialisedData       -> ptext (sLit ".section .bss\n\t.align 2")
 313         ReadOnlyData16          -> ptext (sLit ".section .rodata\n\t.align 4")
 314         OtherSection _          -> panic "PprMach.pprSectionHeader: unknown section"
 315
 316 #endif
 317
 318
 319 pprDataItem :: CmmLit -> Doc
 320 pprDataItem lit
 321   = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
 322     where
 323         imm = litToImm lit
 324
 325         ppr_item II8   _ = [ptext (sLit "\t.byte\t") <> pprImm imm]
 326
 327         ppr_item II32  _ = [ptext (sLit "\t.long\t") <> pprImm imm]
 328
 329         ppr_item FF32 (CmmFloat r _)
 330            = let bs = floatToBytes (fromRational r)
 331              in  map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
 332
 333         ppr_item FF64 (CmmFloat r _)
 334            = let bs = doubleToBytes (fromRational r)
 335              in  map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
 336
 337         ppr_item II16 _ = [ptext (sLit "\t.short\t") <> pprImm imm]
 338
 339         ppr_item II64 (CmmInt x _)  =
 340                 [ptext (sLit "\t.long\t")
 341                     <> int (fromIntegral
 342                         (fromIntegral (x `shiftR` 32) :: Word32)),
 343                  ptext (sLit "\t.long\t")
 344                     <> int (fromIntegral (fromIntegral x :: Word32))]
 345
 346         ppr_item _ _
 347                 = panic "PPC.Ppr.pprDataItem: no match"
 348
 349
 350 pprInstr :: Instr -> Doc
 351
 352 pprInstr (COMMENT _) = empty -- nuke 'em
 353 {-
 354 pprInstr (COMMENT s)
 355      IF_OS_linux(
 356         ((<>) (ptext (sLit "# ")) (ftext s)),
 357         ((<>) (ptext (sLit "; ")) (ftext s)))
 358 -}
 359 pprInstr (DELTA d)
 360    = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
 361
 362 pprInstr (NEWBLOCK _)
 363    = panic "PprMach.pprInstr: NEWBLOCK"
 364
 365 pprInstr (LDATA _ _)
 366    = panic "PprMach.pprInstr: LDATA"
 367
 368 {-
 369 pprInstr (SPILL reg slot)
 370    = hcat [
 371         ptext (sLit "\tSPILL"),
 372         char '\t',
 373         pprReg reg,
 374         comma,
 375         ptext (sLit "SLOT") <> parens (int slot)]
 376
 377 pprInstr (RELOAD slot reg)
 378    = hcat [
 379         ptext (sLit "\tRELOAD"),
 380         char '\t',
 381         ptext (sLit "SLOT") <> parens (int slot),
 382         comma,
 383         pprReg reg]
 384 -}
 385
 386 pprInstr (LD sz reg addr) = hcat [
 387         char '\t',
 388         ptext (sLit "l"),
 389         ptext (case sz of
 390             II8  -> sLit "bz"
 391             II16 -> sLit "hz"
 392             II32 -> sLit "wz"
 393             FF32 -> sLit "fs"
 394             FF64 -> sLit "fd"
 395             _    -> panic "PPC.Ppr.pprInstr: no match"
 396             ),
 397         case addr of AddrRegImm _ _ -> empty
 398                      AddrRegReg _ _ -> char 'x',
 399         char '\t',
 400         pprReg reg,
 401         ptext (sLit ", "),
 402         pprAddr addr
 403     ]
 404 pprInstr (LA sz reg addr) = hcat [
 405         char '\t',
 406         ptext (sLit "l"),
 407         ptext (case sz of
 408             II8  -> sLit "ba"
 409             II16 -> sLit "ha"
 410             II32 -> sLit "wa"
 411             FF32 -> sLit "fs"
 412             FF64 -> sLit "fd"
 413             _    -> panic "PPC.Ppr.pprInstr: no match"
 414             ),
 415         case addr of AddrRegImm _ _ -> empty
 416                      AddrRegReg _ _ -> char 'x',
 417         char '\t',
 418         pprReg reg,
 419         ptext (sLit ", "),
 420         pprAddr addr
 421     ]
 422 pprInstr (ST sz reg addr) = hcat [
 423         char '\t',
 424         ptext (sLit "st"),
 425         pprSize sz,
 426         case addr of AddrRegImm _ _ -> empty
 427                      AddrRegReg _ _ -> char 'x',
 428         char '\t',
 429         pprReg reg,
 430         ptext (sLit ", "),
 431         pprAddr addr
 432     ]
 433 pprInstr (STU sz reg addr) = hcat [
 434         char '\t',
 435         ptext (sLit "st"),
 436         pprSize sz,
 437         ptext (sLit "u\t"),
 438         case addr of AddrRegImm _ _ -> empty
 439                      AddrRegReg _ _ -> char 'x',
 440         pprReg reg,
 441         ptext (sLit ", "),
 442         pprAddr addr
 443     ]
 444 pprInstr (LIS reg imm) = hcat [
 445         char '\t',
 446         ptext (sLit "lis"),
 447         char '\t',
 448         pprReg reg,
 449         ptext (sLit ", "),
 450         pprImm imm
 451     ]
 452 pprInstr (LI reg imm) = hcat [
 453         char '\t',
 454         ptext (sLit "li"),
 455         char '\t',
 456         pprReg reg,
 457         ptext (sLit ", "),
 458         pprImm imm
 459     ]
 460 pprInstr (MR reg1 reg2)
 461     | reg1 == reg2 = empty
 462     | otherwise = hcat [
 463         char '\t',
 464         case targetClassOfReg reg1 of
 465             RcInteger -> ptext (sLit "mr")
 466             _ -> ptext (sLit "fmr"),
 467         char '\t',
 468         pprReg reg1,
 469         ptext (sLit ", "),
 470         pprReg reg2
 471     ]
 472 pprInstr (CMP sz reg ri) = hcat [
 473         char '\t',
 474         op,
 475         char '\t',
 476         pprReg reg,
 477         ptext (sLit ", "),
 478         pprRI ri
 479     ]
 480     where
 481         op = hcat [
 482                 ptext (sLit "cmp"),
 483                 pprSize sz,
 484                 case ri of
 485                     RIReg _ -> empty
 486                     RIImm _ -> char 'i'
 487             ]
 488 pprInstr (CMPL sz reg ri) = hcat [
 489         char '\t',
 490         op,
 491         char '\t',
 492         pprReg reg,
 493         ptext (sLit ", "),
 494         pprRI ri
 495     ]
 496     where
 497         op = hcat [
 498                 ptext (sLit "cmpl"),
 499                 pprSize sz,
 500                 case ri of
 501                     RIReg _ -> empty
 502                     RIImm _ -> char 'i'
 503             ]
 504 pprInstr (BCC cond blockid) = hcat [
 505         char '\t',
 506         ptext (sLit "b"),
 507         pprCond cond,
 508         char '\t',
 509         pprCLabel_asm lbl
 510     ]
 511     where lbl = mkAsmTempLabel (getUnique blockid)
 512
 513 pprInstr (BCCFAR cond blockid) = vcat [
 514         hcat [
 515             ptext (sLit "\tb"),
 516             pprCond (condNegate cond),
 517             ptext (sLit "\t$+8")
 518         ],
 519         hcat [
 520             ptext (sLit "\tb\t"),
 521             pprCLabel_asm lbl
 522         ]
 523     ]
 524     where lbl = mkAsmTempLabel (getUnique blockid)
 525
 526 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
 527         char '\t',
 528         ptext (sLit "b"),
 529         char '\t',
 530         pprCLabel_asm lbl
 531     ]
 532
 533 pprInstr (MTCTR reg) = hcat [
 534         char '\t',
 535         ptext (sLit "mtctr"),
 536         char '\t',
 537         pprReg reg
 538     ]
 539 pprInstr (BCTR _ _) = hcat [
 540         char '\t',
 541         ptext (sLit "bctr")
 542     ]
 543 pprInstr (BL lbl _) = hcat [
 544         ptext (sLit "\tbl\t"),
 545         pprCLabel_asm lbl
 546     ]
 547 pprInstr (BCTRL _) = hcat [
 548         char '\t',
 549         ptext (sLit "bctrl")
 550     ]
 551 pprInstr (ADD reg1 reg2 ri) = pprLogic (sLit "add") reg1 reg2 ri
 552 pprInstr (ADDIS reg1 reg2 imm) = hcat [
 553         char '\t',
 554         ptext (sLit "addis"),
 555         char '\t',
 556         pprReg reg1,
 557         ptext (sLit ", "),
 558         pprReg reg2,
 559         ptext (sLit ", "),
 560         pprImm imm
 561     ]
 562
 563 pprInstr (ADDC reg1 reg2 reg3) = pprLogic (sLit "addc") reg1 reg2 (RIReg reg3)
 564 pprInstr (ADDE reg1 reg2 reg3) = pprLogic (sLit "adde") reg1 reg2 (RIReg reg3)
 565 pprInstr (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3)
 566 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mullw") reg1 reg2 ri
 567 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic (sLit "mull") reg1 reg2 ri
 568 pprInstr (DIVW reg1 reg2 reg3) = pprLogic (sLit "divw") reg1 reg2 (RIReg reg3)
 569 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic (sLit "divwu") reg1 reg2 (RIReg reg3)
 570
 571 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
 572          hcat [ ptext (sLit "\tmullwo\t"), pprReg reg1, ptext (sLit ", "),
 573                                           pprReg reg2, ptext (sLit ", "),
 574                                           pprReg reg3 ],
 575          hcat [ ptext (sLit "\tmfxer\t"),  pprReg reg1 ],
 576          hcat [ ptext (sLit "\trlwinm\t"), pprReg reg1, ptext (sLit ", "),
 577                                           pprReg reg1, ptext (sLit ", "),
 578                                           ptext (sLit "2, 31, 31") ]
 579     ]
 580
 581         -- for some reason, "andi" doesn't exist.
 582         -- we'll use "andi." instead.
 583 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
 584         char '\t',
 585         ptext (sLit "andi."),
 586         char '\t',
 587         pprReg reg1,
 588         ptext (sLit ", "),
 589         pprReg reg2,
 590         ptext (sLit ", "),
 591         pprImm imm
 592     ]
 593 pprInstr (AND reg1 reg2 ri) = pprLogic (sLit "and") reg1 reg2 ri
 594
 595 pprInstr (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri
 596 pprInstr (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri
 597
 598 pprInstr (XORIS reg1 reg2 imm) = hcat [
 599         char '\t',
 600         ptext (sLit "xoris"),
 601         char '\t',
 602         pprReg reg1,
 603         ptext (sLit ", "),
 604         pprReg reg2,
 605         ptext (sLit ", "),
 606         pprImm imm
 607     ]
 608
 609 pprInstr (EXTS sz reg1 reg2) = hcat [
 610         char '\t',
 611         ptext (sLit "exts"),
 612         pprSize sz,
 613         char '\t',
 614         pprReg reg1,
 615         ptext (sLit ", "),
 616         pprReg reg2
 617     ]
 618
 619 pprInstr (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2
 620 pprInstr (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2
 621
 622 pprInstr (SLW reg1 reg2 ri) = pprLogic (sLit "slw") reg1 reg2 (limitShiftRI ri)
 623 pprInstr (SRW reg1 reg2 ri) = pprLogic (sLit "srw") reg1 reg2 (limitShiftRI ri)
 624 pprInstr (SRAW reg1 reg2 ri) = pprLogic (sLit "sraw") reg1 reg2 (limitShiftRI ri)
 625 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
 626         ptext (sLit "\trlwinm\t"),
 627         pprReg reg1,
 628         ptext (sLit ", "),
 629         pprReg reg2,
 630         ptext (sLit ", "),
 631         int sh,
 632         ptext (sLit ", "),
 633         int mb,
 634         ptext (sLit ", "),
 635         int me
 636     ]
 637
 638 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF (sLit "fadd") sz reg1 reg2 reg3
 639 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF (sLit "fsub") sz reg1 reg2 reg3
 640 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF (sLit "fmul") sz reg1 reg2 reg3
 641 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") sz reg1 reg2 reg3
 642 pprInstr (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2
 643
 644 pprInstr (FCMP reg1 reg2) = hcat [
 645         char '\t',
 646         ptext (sLit "fcmpu\tcr0, "),
 647             -- Note: we're using fcmpu, not fcmpo
 648             -- The difference is with fcmpo, compare with NaN is an invalid operation.
 649             -- We don't handle invalid fp ops, so we don't care
 650         pprReg reg1,
 651         ptext (sLit ", "),
 652         pprReg reg2
 653     ]
 654
 655 pprInstr (FCTIWZ reg1 reg2) = pprUnary (sLit "fctiwz") reg1 reg2
 656 pprInstr (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2
 657
 658 pprInstr (CRNOR dst src1 src2) = hcat [
 659         ptext (sLit "\tcrnor\t"),
 660         int dst,
 661         ptext (sLit ", "),
 662         int src1,
 663         ptext (sLit ", "),
 664         int src2
 665     ]
 666
 667 pprInstr (MFCR reg) = hcat [
 668         char '\t',
 669         ptext (sLit "mfcr"),
 670         char '\t',
 671         pprReg reg
 672     ]
 673
 674 pprInstr (MFLR reg) = hcat [
 675         char '\t',
 676         ptext (sLit "mflr"),
 677         char '\t',
 678         pprReg reg
 679     ]
 680
 681 pprInstr (FETCHPC reg) = vcat [
 682         ptext (sLit "\tbcl\t20,31,1f"),
 683         hcat [ ptext (sLit "1:\tmflr\t"), pprReg reg ]
 684     ]
 685
 686 pprInstr LWSYNC = ptext (sLit "\tlwsync")
 687
 688 -- pprInstr _ = panic "pprInstr (ppc)"
 689
 690
 691 pprLogic :: LitString -> Reg -> Reg -> RI -> Doc
 692 pprLogic op reg1 reg2 ri = hcat [
 693         char '\t',
 694         ptext op,
 695         case ri of
 696             RIReg _ -> empty
 697             RIImm _ -> char 'i',
 698         char '\t',
 699         pprReg reg1,
 700         ptext (sLit ", "),
 701         pprReg reg2,
 702         ptext (sLit ", "),
 703         pprRI ri
 704     ]
 705
 706
 707 pprUnary :: LitString -> Reg -> Reg -> Doc
 708 pprUnary op reg1 reg2 = hcat [
 709         char '\t',
 710         ptext op,
 711         char '\t',
 712         pprReg reg1,
 713         ptext (sLit ", "),
 714         pprReg reg2
 715     ]
 716
 717
 718 pprBinaryF :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
 719 pprBinaryF op sz reg1 reg2 reg3 = hcat [
 720         char '\t',
 721         ptext op,
 722         pprFSize sz,
 723         char '\t',
 724         pprReg reg1,
 725         ptext (sLit ", "),
 726         pprReg reg2,
 727         ptext (sLit ", "),
 728         pprReg reg3
 729     ]
 730
 731 pprRI :: RI -> Doc
 732 pprRI (RIReg r) = pprReg r
 733 pprRI (RIImm r) = pprImm r
 734
 735
 736 pprFSize :: Size -> Doc
 737 pprFSize FF64   = empty
 738 pprFSize FF32   = char 's'
 739 pprFSize _      = panic "PPC.Ppr.pprFSize: no match"
 740
 741     -- limit immediate argument for shift instruction to range 0..32
 742     -- (yes, the maximum is really 32, not 31)
 743 limitShiftRI :: RI -> RI
 744 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
 745 limitShiftRI x = x
 746