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