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