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