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_ARCH_alpha( ((<>) (ptext (sLit "\t# ")) (ftext s))
 356      ,IF_ARCH_sparc( ((<>) (ptext (sLit "# "))   (ftext s))
 357      ,IF_ARCH_i386( ((<>) (ptext (sLit "# "))   (ftext s))
 358      ,IF_ARCH_x86_64( ((<>) (ptext (sLit "# "))   (ftext s))
 359      ,IF_ARCH_powerpc( IF_OS_linux(
 360         ((<>) (ptext (sLit "# ")) (ftext s)),
 361         ((<>) (ptext (sLit "; ")) (ftext s)))
 362      ,)))))
 363 -}
 364 pprInstr (DELTA d)
 365    = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
 366
 367 pprInstr (NEWBLOCK _)
 368    = panic "PprMach.pprInstr: NEWBLOCK"
 369
 370 pprInstr (LDATA _ _)
 371    = panic "PprMach.pprInstr: LDATA"
 372
 373 {-
 374 pprInstr (SPILL reg slot)
 375    = hcat [
 376         ptext (sLit "\tSPILL"),
 377         char '\t',
 378         pprReg reg,
 379         comma,
 380         ptext (sLit "SLOT") <> parens (int slot)]
 381
 382 pprInstr (RELOAD slot reg)
 383    = hcat [
 384         ptext (sLit "\tRELOAD"),
 385         char '\t',
 386         ptext (sLit "SLOT") <> parens (int slot),
 387         comma,
 388         pprReg reg]
 389 -}
 390
 391 pprInstr (LD sz reg addr) = hcat [
 392         char '\t',
 393         ptext (sLit "l"),
 394         ptext (case sz of
 395             II8  -> sLit "bz"
 396             II16 -> sLit "hz"
 397             II32 -> sLit "wz"
 398             FF32 -> sLit "fs"
 399             FF64 -> sLit "fd"
 400             _    -> panic "PPC.Ppr.pprInstr: no match"
 401             ),
 402         case addr of AddrRegImm _ _ -> empty
 403                      AddrRegReg _ _ -> char 'x',
 404         char '\t',
 405         pprReg reg,
 406         ptext (sLit ", "),
 407         pprAddr addr
 408     ]
 409 pprInstr (LA sz reg addr) = hcat [
 410         char '\t',
 411         ptext (sLit "l"),
 412         ptext (case sz of
 413             II8  -> sLit "ba"
 414             II16 -> sLit "ha"
 415             II32 -> sLit "wa"
 416             FF32 -> sLit "fs"
 417             FF64 -> sLit "fd"
 418             _    -> panic "PPC.Ppr.pprInstr: no match"
 419             ),
 420         case addr of AddrRegImm _ _ -> empty
 421                      AddrRegReg _ _ -> char 'x',
 422         char '\t',
 423         pprReg reg,
 424         ptext (sLit ", "),
 425         pprAddr addr
 426     ]
 427 pprInstr (ST sz reg addr) = hcat [
 428         char '\t',
 429         ptext (sLit "st"),
 430         pprSize sz,
 431         case addr of AddrRegImm _ _ -> empty
 432                      AddrRegReg _ _ -> char 'x',
 433         char '\t',
 434         pprReg reg,
 435         ptext (sLit ", "),
 436         pprAddr addr
 437     ]
 438 pprInstr (STU sz reg addr) = hcat [
 439         char '\t',
 440         ptext (sLit "st"),
 441         pprSize sz,
 442         ptext (sLit "u\t"),
 443         case addr of AddrRegImm _ _ -> empty
 444                      AddrRegReg _ _ -> char 'x',
 445         pprReg reg,
 446         ptext (sLit ", "),
 447         pprAddr addr
 448     ]
 449 pprInstr (LIS reg imm) = hcat [
 450         char '\t',
 451         ptext (sLit "lis"),
 452         char '\t',
 453         pprReg reg,
 454         ptext (sLit ", "),
 455         pprImm imm
 456     ]
 457 pprInstr (LI reg imm) = hcat [
 458         char '\t',
 459         ptext (sLit "li"),
 460         char '\t',
 461         pprReg reg,
 462         ptext (sLit ", "),
 463         pprImm imm
 464     ]
 465 pprInstr (MR reg1 reg2)
 466     | reg1 == reg2 = empty
 467     | otherwise = hcat [
 468         char '\t',
 469         case targetClassOfReg reg1 of
 470             RcInteger -> ptext (sLit "mr")
 471             _ -> ptext (sLit "fmr"),
 472         char '\t',
 473         pprReg reg1,
 474         ptext (sLit ", "),
 475         pprReg reg2
 476     ]
 477 pprInstr (CMP sz reg ri) = hcat [
 478         char '\t',
 479         op,
 480         char '\t',
 481         pprReg reg,
 482         ptext (sLit ", "),
 483         pprRI ri
 484     ]
 485     where
 486         op = hcat [
 487                 ptext (sLit "cmp"),
 488                 pprSize sz,
 489                 case ri of
 490                     RIReg _ -> empty
 491                     RIImm _ -> char 'i'
 492             ]
 493 pprInstr (CMPL sz reg ri) = hcat [
 494         char '\t',
 495         op,
 496         char '\t',
 497         pprReg reg,
 498         ptext (sLit ", "),
 499         pprRI ri
 500     ]
 501     where
 502         op = hcat [
 503                 ptext (sLit "cmpl"),
 504                 pprSize sz,
 505                 case ri of
 506                     RIReg _ -> empty
 507                     RIImm _ -> char 'i'
 508             ]
 509 pprInstr (BCC cond blockid) = hcat [
 510         char '\t',
 511         ptext (sLit "b"),
 512         pprCond cond,
 513         char '\t',
 514         pprCLabel_asm lbl
 515     ]
 516     where lbl = mkAsmTempLabel (getUnique blockid)
 517
 518 pprInstr (BCCFAR cond blockid) = vcat [
 519         hcat [
 520             ptext (sLit "\tb"),
 521             pprCond (condNegate cond),
 522             ptext (sLit "\t$+8")
 523         ],
 524         hcat [
 525             ptext (sLit "\tb\t"),
 526             pprCLabel_asm lbl
 527         ]
 528     ]
 529     where lbl = mkAsmTempLabel (getUnique blockid)
 530
 531 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
 532         char '\t',
 533         ptext (sLit "b"),
 534         char '\t',
 535         pprCLabel_asm lbl
 536     ]
 537
 538 pprInstr (MTCTR reg) = hcat [
 539         char '\t',
 540         ptext (sLit "mtctr"),
 541         char '\t',
 542         pprReg reg
 543     ]
 544 pprInstr (BCTR _ _) = hcat [
 545         char '\t',
 546         ptext (sLit "bctr")
 547     ]
 548 pprInstr (BL lbl _) = hcat [
 549         ptext (sLit "\tbl\t"),
 550         pprCLabel_asm lbl
 551     ]
 552 pprInstr (BCTRL _) = hcat [
 553         char '\t',
 554         ptext (sLit "bctrl")
 555     ]
 556 pprInstr (ADD reg1 reg2 ri) = pprLogic (sLit "add") reg1 reg2 ri
 557 pprInstr (ADDIS reg1 reg2 imm) = hcat [
 558         char '\t',
 559         ptext (sLit "addis"),
 560         char '\t',
 561         pprReg reg1,
 562         ptext (sLit ", "),
 563         pprReg reg2,
 564         ptext (sLit ", "),
 565         pprImm imm
 566     ]
 567
 568 pprInstr (ADDC reg1 reg2 reg3) = pprLogic (sLit "addc") reg1 reg2 (RIReg reg3)
 569 pprInstr (ADDE reg1 reg2 reg3) = pprLogic (sLit "adde") reg1 reg2 (RIReg reg3)
 570 pprInstr (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3)
 571 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mullw") reg1 reg2 ri
 572 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic (sLit "mull") reg1 reg2 ri
 573 pprInstr (DIVW reg1 reg2 reg3) = pprLogic (sLit "divw") reg1 reg2 (RIReg reg3)
 574 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic (sLit "divwu") reg1 reg2 (RIReg reg3)
 575
 576 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
 577          hcat [ ptext (sLit "\tmullwo\t"), pprReg reg1, ptext (sLit ", "),
 578                                           pprReg reg2, ptext (sLit ", "),
 579                                           pprReg reg3 ],
 580          hcat [ ptext (sLit "\tmfxer\t"),  pprReg reg1 ],
 581          hcat [ ptext (sLit "\trlwinm\t"), pprReg reg1, ptext (sLit ", "),
 582                                           pprReg reg1, ptext (sLit ", "),
 583                                           ptext (sLit "2, 31, 31") ]
 584     ]
 585
 586         -- for some reason, "andi" doesn't exist.
 587         -- we'll use "andi." instead.
 588 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
 589         char '\t',
 590         ptext (sLit "andi."),
 591         char '\t',
 592         pprReg reg1,
 593         ptext (sLit ", "),
 594         pprReg reg2,
 595         ptext (sLit ", "),
 596         pprImm imm
 597     ]
 598 pprInstr (AND reg1 reg2 ri) = pprLogic (sLit "and") reg1 reg2 ri
 599
 600 pprInstr (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri
 601 pprInstr (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri
 602
 603 pprInstr (XORIS reg1 reg2 imm) = hcat [
 604         char '\t',
 605         ptext (sLit "xoris"),
 606         char '\t',
 607         pprReg reg1,
 608         ptext (sLit ", "),
 609         pprReg reg2,
 610         ptext (sLit ", "),
 611         pprImm imm
 612     ]
 613
 614 pprInstr (EXTS sz reg1 reg2) = hcat [
 615         char '\t',
 616         ptext (sLit "exts"),
 617         pprSize sz,
 618         char '\t',
 619         pprReg reg1,
 620         ptext (sLit ", "),
 621         pprReg reg2
 622     ]
 623
 624 pprInstr (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2
 625 pprInstr (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2
 626
 627 pprInstr (SLW reg1 reg2 ri) = pprLogic (sLit "slw") reg1 reg2 (limitShiftRI ri)
 628 pprInstr (SRW reg1 reg2 ri) = pprLogic (sLit "srw") reg1 reg2 (limitShiftRI ri)
 629 pprInstr (SRAW reg1 reg2 ri) = pprLogic (sLit "sraw") reg1 reg2 (limitShiftRI ri)
 630 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
 631         ptext (sLit "\trlwinm\t"),
 632         pprReg reg1,
 633         ptext (sLit ", "),
 634         pprReg reg2,
 635         ptext (sLit ", "),
 636         int sh,
 637         ptext (sLit ", "),
 638         int mb,
 639         ptext (sLit ", "),
 640         int me
 641     ]
 642
 643 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF (sLit "fadd") sz reg1 reg2 reg3
 644 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF (sLit "fsub") sz reg1 reg2 reg3
 645 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF (sLit "fmul") sz reg1 reg2 reg3
 646 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") sz reg1 reg2 reg3
 647 pprInstr (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2
 648
 649 pprInstr (FCMP reg1 reg2) = hcat [
 650         char '\t',
 651         ptext (sLit "fcmpu\tcr0, "),
 652             -- Note: we're using fcmpu, not fcmpo
 653             -- The difference is with fcmpo, compare with NaN is an invalid operation.
 654             -- We don't handle invalid fp ops, so we don't care
 655         pprReg reg1,
 656         ptext (sLit ", "),
 657         pprReg reg2
 658     ]
 659
 660 pprInstr (FCTIWZ reg1 reg2) = pprUnary (sLit "fctiwz") reg1 reg2
 661 pprInstr (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2
 662
 663 pprInstr (CRNOR dst src1 src2) = hcat [
 664         ptext (sLit "\tcrnor\t"),
 665         int dst,
 666         ptext (sLit ", "),
 667         int src1,
 668         ptext (sLit ", "),
 669         int src2
 670     ]
 671
 672 pprInstr (MFCR reg) = hcat [
 673         char '\t',
 674         ptext (sLit "mfcr"),
 675         char '\t',
 676         pprReg reg
 677     ]
 678
 679 pprInstr (MFLR reg) = hcat [
 680         char '\t',
 681         ptext (sLit "mflr"),
 682         char '\t',
 683         pprReg reg
 684     ]
 685
 686 pprInstr (FETCHPC reg) = vcat [
 687         ptext (sLit "\tbcl\t20,31,1f"),
 688         hcat [ ptext (sLit "1:\tmflr\t"), pprReg reg ]
 689     ]
 690
 691 pprInstr LWSYNC = ptext (sLit "\tlwsync")
 692
 693 -- pprInstr _ = panic "pprInstr (ppc)"
 694
 695
 696 pprLogic :: LitString -> Reg -> Reg -> RI -> Doc
 697 pprLogic op reg1 reg2 ri = hcat [
 698         char '\t',
 699         ptext op,
 700         case ri of
 701             RIReg _ -> empty
 702             RIImm _ -> char 'i',
 703         char '\t',
 704         pprReg reg1,
 705         ptext (sLit ", "),
 706         pprReg reg2,
 707         ptext (sLit ", "),
 708         pprRI ri
 709     ]
 710
 711
 712 pprUnary :: LitString -> Reg -> Reg -> Doc
 713 pprUnary op reg1 reg2 = hcat [
 714         char '\t',
 715         ptext op,
 716         char '\t',
 717         pprReg reg1,
 718         ptext (sLit ", "),
 719         pprReg reg2
 720     ]
 721
 722
 723 pprBinaryF :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
 724 pprBinaryF op sz reg1 reg2 reg3 = hcat [
 725         char '\t',
 726         ptext op,
 727         pprFSize sz,
 728         char '\t',
 729         pprReg reg1,
 730         ptext (sLit ", "),
 731         pprReg reg2,
 732         ptext (sLit ", "),
 733         pprReg reg3
 734     ]
 735
 736 pprRI :: RI -> Doc
 737 pprRI (RIReg r) = pprReg r
 738 pprRI (RIImm r) = pprImm r
 739
 740
 741 pprFSize :: Size -> Doc
 742 pprFSize FF64   = empty
 743 pprFSize FF32   = char 's'
 744 pprFSize _      = panic "PPC.Ppr.pprFSize: no match"
 745
 746     -- limit immediate argument for shift instruction to range 0..32
 747     -- (yes, the maximum is really 32, not 31)
 748 limitShiftRI :: RI -> RI
 749 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
 750 limitShiftRI x = x
 751