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