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