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