compiler/nativeGen/X86/Ppr.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Pretty-printing assembly language
   4 --
   5 -- (c) The University of Glasgow 1993-2005
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module X86.Ppr (
  10         pprNatCmmTop,
  11         pprBasicBlock,
  12         pprSectionHeader,
  13         pprData,
  14         pprInstr,
  15         pprSize,
  16         pprImm,
  17         pprDataItem,
  18 )
  19
  20 where
  21
  22 #include "HsVersions.h"
  23 #include "nativeGen/NCG.h"
  24
  25 import X86.Regs
  26 import X86.Instr
  27 import X86.Cond
  28 import Instruction
  29 import Size
  30 import Reg
  31 import PprBase
  32
  33
  34 import OldCmm
  35 import CLabel
  36 import Unique           ( pprUnique, Uniquable(..) )
  37 import Pretty
  38 import FastString
  39 import qualified Outputable
  40 import Outputable       (panic, Outputable)
  41
  42 import Data.Word
  43
  44 #if i386_TARGET_ARCH && darwin_TARGET_OS
  45 import Data.Bits
  46 #endif
  47
  48 -- -----------------------------------------------------------------------------
  49 -- Printing this stuff out
  50
  51 pprNatCmmTop :: NatCmmTop Instr -> Doc
  52 pprNatCmmTop (CmmData section dats) =
  53   pprSectionHeader section $$ vcat (map pprData dats)
  54
  55  -- special case for split markers:
  56 pprNatCmmTop (CmmProc [] lbl (ListGraph [])) = pprLabel lbl
  57
  58 pprNatCmmTop (CmmProc info lbl (ListGraph blocks)) =
  59   pprSectionHeader Text $$
  60   (if null info then -- blocks guaranteed not null, so label needed
  61        pprLabel lbl
  62    else
  63 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
  64             pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
  65                 <> char ':' $$
  66 #endif
  67        vcat (map pprData info) $$
  68        pprLabel (entryLblToInfoLbl lbl)
  69   ) $$
  70   vcat (map pprBasicBlock blocks)
  71      -- above: Even the first block gets a label, because with branch-chain
  72      -- elimination, it might be the target of a goto.
  73 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
  74         -- If we are using the .subsections_via_symbols directive
  75         -- (available on recent versions of Darwin),
  76         -- we have to make sure that there is some kind of reference
  77         -- from the entry code to a label on the _top_ of of the info table,
  78         -- so that the linker will not think it is unreferenced and dead-strip
  79         -- it. That's why the label is called a DeadStripPreventer (_dsp).
  80   $$ if not (null info)
  81                     then text "\t.long "
  82                       <+> pprCLabel_asm (entryLblToInfoLbl lbl)
  83                       <+> char '-'
  84                       <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
  85                     else empty
  86 #endif
  87    $$ pprSizeDecl (if null info then lbl else entryLblToInfoLbl lbl)
  88
  89 -- | Output the ELF .size directive.
  90 pprSizeDecl :: CLabel -> Doc
  91 #if elf_OBJ_FORMAT
  92 pprSizeDecl lbl =
  93     ptext (sLit "\t.size") <+> pprCLabel_asm lbl
  94     <> ptext (sLit ", .-") <> pprCLabel_asm lbl
  95 #else
  96 pprSizeDecl _ = empty
  97 #endif
  98
  99 pprBasicBlock :: NatBasicBlock Instr -> Doc
 100 pprBasicBlock (BasicBlock blockid instrs) =
 101   pprLabel (mkAsmTempLabel (getUnique blockid)) $$
 102   vcat (map pprInstr instrs)
 103
 104
 105 pprData :: CmmStatic -> Doc
 106 pprData (CmmAlign bytes)         = pprAlign bytes
 107 pprData (CmmDataLabel lbl)       = pprLabel lbl
 108 pprData (CmmString str)          = pprASCII str
 109
 110 #if  darwin_TARGET_OS
 111 pprData (CmmUninitialised bytes) = ptext (sLit ".space ") <> int bytes
 112 #else
 113 pprData (CmmUninitialised bytes) = ptext (sLit ".skip ") <> int bytes
 114 #endif
 115
 116 pprData (CmmStaticLit lit)       = pprDataItem lit
 117
 118 pprGloblDecl :: CLabel -> Doc
 119 pprGloblDecl lbl
 120   | not (externallyVisibleCLabel lbl) = empty
 121   | otherwise = ptext (sLit ".globl ") <> pprCLabel_asm lbl
 122
 123 pprTypeAndSizeDecl :: CLabel -> Doc
 124 #if elf_OBJ_FORMAT
 125 pprTypeAndSizeDecl lbl
 126   | not (externallyVisibleCLabel lbl) = empty
 127   | otherwise = ptext (sLit ".type ") <>
 128                 pprCLabel_asm lbl <> ptext (sLit ", @object")
 129 #else
 130 pprTypeAndSizeDecl _
 131   = empty
 132 #endif
 133
 134 pprLabel :: CLabel -> Doc
 135 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
 136
 137
 138 pprASCII :: [Word8] -> Doc
 139 pprASCII str
 140   = vcat (map do1 str) $$ do1 0
 141     where
 142        do1 :: Word8 -> Doc
 143        do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
 144
 145 pprAlign :: Int -> Doc
 146
 147
 148 pprAlign bytes
 149         = ptext (sLit ".align ") <> int IF_OS_darwin(pow2, bytes)
 150   where
 151
 152 #if darwin_TARGET_OS
 153         pow2 = log2 bytes
 154
 155         log2 :: Int -> Int  -- cache the common ones
 156         log2 1 = 0
 157         log2 2 = 1
 158         log2 4 = 2
 159         log2 8 = 3
 160         log2 n = 1 + log2 (n `quot` 2)
 161 #endif
 162
 163 -- -----------------------------------------------------------------------------
 164 -- pprInstr: print an 'Instr'
 165
 166 instance Outputable Instr where
 167     ppr instr = Outputable.docToSDoc $ pprInstr instr
 168
 169
 170 pprReg :: Size -> Reg -> Doc
 171
 172 pprReg s r
 173   = case r of
 174       RegReal    (RealRegSingle i) -> ppr_reg_no s i
 175       RegReal    (RealRegPair _ _) -> panic "X86.Ppr: no reg pairs on this arch"
 176       RegVirtual (VirtualRegI  u)  -> text "%vI_" <> asmSDoc (pprUnique u)
 177       RegVirtual (VirtualRegHi u)  -> text "%vHi_" <> asmSDoc (pprUnique u)
 178       RegVirtual (VirtualRegF  u)  -> text "%vF_" <> asmSDoc (pprUnique u)
 179       RegVirtual (VirtualRegD  u)  -> text "%vD_" <> asmSDoc (pprUnique u)
 180       RegVirtual (VirtualRegSSE  u) -> text "%vSSE_" <> asmSDoc (pprUnique u)
 181   where
 182 #if i386_TARGET_ARCH
 183     ppr_reg_no :: Size -> Int -> Doc
 184     ppr_reg_no II8   = ppr_reg_byte
 185     ppr_reg_no II16  = ppr_reg_word
 186     ppr_reg_no _    = ppr_reg_long
 187
 188     ppr_reg_byte i = ptext
 189       (case i of {
 190          0 -> sLit "%al";     1 -> sLit "%bl";
 191          2 -> sLit "%cl";     3 -> sLit "%dl";
 192         _  -> sLit "very naughty I386 byte register"
 193       })
 194
 195     ppr_reg_word i = ptext
 196       (case i of {
 197          0 -> sLit "%ax";     1 -> sLit "%bx";
 198          2 -> sLit "%cx";     3 -> sLit "%dx";
 199          4 -> sLit "%si";     5 -> sLit "%di";
 200          6 -> sLit "%bp";     7 -> sLit "%sp";
 201         _  -> sLit "very naughty I386 word register"
 202       })
 203
 204     ppr_reg_long i = ptext
 205       (case i of {
 206          0 -> sLit "%eax";    1 -> sLit "%ebx";
 207          2 -> sLit "%ecx";    3 -> sLit "%edx";
 208          4 -> sLit "%esi";    5 -> sLit "%edi";
 209          6 -> sLit "%ebp";    7 -> sLit "%esp";
 210          _  -> ppr_reg_float i
 211       })
 212 #elif x86_64_TARGET_ARCH
 213     ppr_reg_no :: Size -> Int -> Doc
 214     ppr_reg_no II8   = ppr_reg_byte
 215     ppr_reg_no II16  = ppr_reg_word
 216     ppr_reg_no II32  = ppr_reg_long
 217     ppr_reg_no _    = ppr_reg_quad
 218
 219     ppr_reg_byte i = ptext
 220       (case i of {
 221          0 -> sLit "%al";     1 -> sLit "%bl";
 222          2 -> sLit "%cl";     3 -> sLit "%dl";
 223          4 -> sLit "%sil";    5 -> sLit "%dil"; -- new 8-bit regs!
 224          6 -> sLit "%bpl";    7 -> sLit "%spl";
 225          8 -> sLit "%r8b";    9  -> sLit "%r9b";
 226         10 -> sLit "%r10b";   11 -> sLit "%r11b";
 227         12 -> sLit "%r12b";   13 -> sLit "%r13b";
 228         14 -> sLit "%r14b";   15 -> sLit "%r15b";
 229         _  -> sLit "very naughty x86_64 byte register"
 230       })
 231
 232     ppr_reg_word i = ptext
 233       (case i of {
 234          0 -> sLit "%ax";     1 -> sLit "%bx";
 235          2 -> sLit "%cx";     3 -> sLit "%dx";
 236          4 -> sLit "%si";     5 -> sLit "%di";
 237          6 -> sLit "%bp";     7 -> sLit "%sp";
 238          8 -> sLit "%r8w";    9  -> sLit "%r9w";
 239         10 -> sLit "%r10w";   11 -> sLit "%r11w";
 240         12 -> sLit "%r12w";   13 -> sLit "%r13w";
 241         14 -> sLit "%r14w";   15 -> sLit "%r15w";
 242         _  -> sLit "very naughty x86_64 word register"
 243       })
 244
 245     ppr_reg_long i = ptext
 246       (case i of {
 247          0 -> sLit "%eax";    1  -> sLit "%ebx";
 248          2 -> sLit "%ecx";    3  -> sLit "%edx";
 249          4 -> sLit "%esi";    5  -> sLit "%edi";
 250          6 -> sLit "%ebp";    7  -> sLit "%esp";
 251          8 -> sLit "%r8d";    9  -> sLit "%r9d";
 252         10 -> sLit "%r10d";   11 -> sLit "%r11d";
 253         12 -> sLit "%r12d";   13 -> sLit "%r13d";
 254         14 -> sLit "%r14d";   15 -> sLit "%r15d";
 255         _  -> sLit "very naughty x86_64 register"
 256       })
 257
 258     ppr_reg_quad i = ptext
 259       (case i of {
 260          0 -> sLit "%rax";      1 -> sLit "%rbx";
 261          2 -> sLit "%rcx";      3 -> sLit "%rdx";
 262          4 -> sLit "%rsi";      5 -> sLit "%rdi";
 263          6 -> sLit "%rbp";      7 -> sLit "%rsp";
 264          8 -> sLit "%r8";       9 -> sLit "%r9";
 265         10 -> sLit "%r10";    11 -> sLit "%r11";
 266         12 -> sLit "%r12";    13 -> sLit "%r13";
 267         14 -> sLit "%r14";    15 -> sLit "%r15";
 268         _  -> ppr_reg_float i
 269       })
 270 #else
 271      ppr_reg_no _ = panic "X86.Ppr.ppr_reg_no: no match"
 272 #endif
 273
 274 #if defined(i386_TARGET_ARCH) || defined(x86_64_TARGET_ARCH)
 275 ppr_reg_float :: Int -> LitString
 276 ppr_reg_float i = case i of
 277         16 -> sLit "%fake0";  17 -> sLit "%fake1"
 278         18 -> sLit "%fake2";  19 -> sLit "%fake3"
 279         20 -> sLit "%fake4";  21 -> sLit "%fake5"
 280         24 -> sLit "%xmm0";   25 -> sLit "%xmm1"
 281         26 -> sLit "%xmm2";   27 -> sLit "%xmm3"
 282         28 -> sLit "%xmm4";   29 -> sLit "%xmm5"
 283         30 -> sLit "%xmm6";   31 -> sLit "%xmm7"
 284         32 -> sLit "%xmm8";   33 -> sLit "%xmm9"
 285         34 -> sLit "%xmm10";  35 -> sLit "%xmm11"
 286         36 -> sLit "%xmm12";  37 -> sLit "%xmm13"
 287         38 -> sLit "%xmm14";  39 -> sLit "%xmm15"
 288         _  -> sLit "very naughty x86 register"
 289 #endif
 290
 291 pprSize :: Size -> Doc
 292 pprSize x
 293  = ptext (case x of
 294                 II8   -> sLit "b"
 295                 II16  -> sLit "w"
 296                 II32  -> sLit "l"
 297                 II64  -> sLit "q"
 298                 FF32  -> sLit "ss"      -- "scalar single-precision float" (SSE2)
 299                 FF64  -> sLit "sd"      -- "scalar double-precision float" (SSE2)
 300                 FF80  -> sLit "t"
 301                 )
 302
 303 pprSize_x87 :: Size -> Doc
 304 pprSize_x87 x
 305   = ptext $ case x of
 306                 FF32  -> sLit "s"
 307                 FF64  -> sLit "l"
 308                 FF80  -> sLit "t"
 309                 _     -> panic "X86.Ppr.pprSize_x87"
 310
 311 pprCond :: Cond -> Doc
 312 pprCond c
 313  = ptext (case c of {
 314                 GEU     -> sLit "ae";   LU    -> sLit "b";
 315                 EQQ     -> sLit "e";    GTT   -> sLit "g";
 316                 GE      -> sLit "ge";   GU    -> sLit "a";
 317                 LTT     -> sLit "l";    LE    -> sLit "le";
 318                 LEU     -> sLit "be";   NE    -> sLit "ne";
 319                 NEG     -> sLit "s";    POS   -> sLit "ns";
 320                 CARRY   -> sLit "c";   OFLO  -> sLit "o";
 321                 PARITY  -> sLit "p";   NOTPARITY -> sLit "np";
 322                 ALWAYS  -> sLit "mp"})
 323
 324
 325 pprImm :: Imm -> Doc
 326 pprImm (ImmInt i)     = int i
 327 pprImm (ImmInteger i) = integer i
 328 pprImm (ImmCLbl l)    = pprCLabel_asm l
 329 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
 330 pprImm (ImmLit s)     = s
 331
 332 pprImm (ImmFloat _)  = ptext (sLit "naughty float immediate")
 333 pprImm (ImmDouble _) = ptext (sLit "naughty double immediate")
 334
 335 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
 336 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
 337                             <> lparen <> pprImm b <> rparen
 338
 339
 340
 341 pprAddr :: AddrMode -> Doc
 342 pprAddr (ImmAddr imm off)
 343   = let pp_imm = pprImm imm
 344     in
 345     if (off == 0) then
 346         pp_imm
 347     else if (off < 0) then
 348         pp_imm <> int off
 349     else
 350         pp_imm <> char '+' <> int off
 351
 352 pprAddr (AddrBaseIndex base index displacement)
 353   = let
 354         pp_disp  = ppr_disp displacement
 355         pp_off p = pp_disp <> char '(' <> p <> char ')'
 356         pp_reg r = pprReg archWordSize r
 357     in
 358     case (base, index) of
 359       (EABaseNone,  EAIndexNone) -> pp_disp
 360       (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
 361       (EABaseRip,   EAIndexNone) -> pp_off (ptext (sLit "%rip"))
 362       (EABaseNone,  EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
 363       (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
 364                                        <> comma <> int i)
 365       _                         -> panic "X86.Ppr.pprAddr: no match"
 366
 367   where
 368     ppr_disp (ImmInt 0) = empty
 369     ppr_disp imm        = pprImm imm
 370
 371
 372 pprSectionHeader :: Section -> Doc
 373 #if  i386_TARGET_ARCH
 374
 375 #    if darwin_TARGET_OS
 376 pprSectionHeader seg
 377  = case seg of
 378         Text                    -> ptext (sLit ".text\n\t.align 2")
 379         Data                    -> ptext (sLit ".data\n\t.align 2")
 380         ReadOnlyData            -> ptext (sLit ".const\n.align 2")
 381         RelocatableReadOnlyData -> ptext (sLit ".const_data\n.align 2")
 382         UninitialisedData       -> ptext (sLit ".data\n\t.align 2")
 383         ReadOnlyData16          -> ptext (sLit ".const\n.align 4")
 384         OtherSection _          -> panic "X86.Ppr.pprSectionHeader: unknown section"
 385
 386 #    else
 387 pprSectionHeader seg
 388  = case seg of
 389         Text                    -> ptext (sLit ".text\n\t.align 4,0x90")
 390         Data                    -> ptext (sLit ".data\n\t.align 4")
 391         ReadOnlyData            -> ptext (sLit ".section .rodata\n\t.align 4")
 392         RelocatableReadOnlyData -> ptext (sLit ".section .data\n\t.align 4")
 393         UninitialisedData       -> ptext (sLit ".section .bss\n\t.align 4")
 394         ReadOnlyData16          -> ptext (sLit ".section .rodata\n\t.align 16")
 395         OtherSection _          -> panic "X86.Ppr.pprSectionHeader: unknown section"
 396
 397 #    endif
 398
 399 #elif x86_64_TARGET_ARCH
 400 #    if  darwin_TARGET_OS
 401 pprSectionHeader seg
 402  = case seg of
 403         Text                    -> ptext (sLit ".text\n.align 3")
 404         Data                    -> ptext (sLit ".data\n.align 3")
 405         ReadOnlyData            -> ptext (sLit ".const\n.align 3")
 406         RelocatableReadOnlyData -> ptext (sLit ".const_data\n.align 3")
 407         UninitialisedData       -> ptext (sLit ".data\n\t.align 3")
 408         ReadOnlyData16          -> ptext (sLit ".const\n.align 4")
 409         OtherSection _          -> panic "PprMach.pprSectionHeader: unknown section"
 410
 411 #    else
 412 pprSectionHeader seg
 413  = case seg of
 414         Text                    -> ptext (sLit ".text\n\t.align 8")
 415         Data                    -> ptext (sLit ".data\n\t.align 8")
 416         ReadOnlyData            -> ptext (sLit ".section .rodata\n\t.align 8")
 417         RelocatableReadOnlyData -> ptext (sLit ".section .data\n\t.align 8")
 418         UninitialisedData       -> ptext (sLit ".section .bss\n\t.align 8")
 419         ReadOnlyData16          -> ptext (sLit ".section .rodata.cst16\n\t.align 16")
 420         OtherSection _          -> panic "PprMach.pprSectionHeader: unknown section"
 421
 422 #    endif
 423
 424 #else
 425 pprSectionHeader _              = panic "X86.Ppr.pprSectionHeader: not defined for this architecture"
 426
 427 #endif
 428
 429
 430
 431
 432 pprDataItem :: CmmLit -> Doc
 433 pprDataItem lit
 434   = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
 435     where
 436         imm = litToImm lit
 437
 438         -- These seem to be common:
 439         ppr_item II8   _ = [ptext (sLit "\t.byte\t") <> pprImm imm]
 440         ppr_item II32  _ = [ptext (sLit "\t.long\t") <> pprImm imm]
 441
 442         ppr_item FF32  (CmmFloat r _)
 443            = let bs = floatToBytes (fromRational r)
 444              in  map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
 445
 446         ppr_item FF64 (CmmFloat r _)
 447            = let bs = doubleToBytes (fromRational r)
 448              in  map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
 449
 450 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 451         ppr_item II16  _ = [ptext (sLit "\t.word\t") <> pprImm imm]
 452 #endif
 453 #if i386_TARGET_ARCH && darwin_TARGET_OS
 454         ppr_item II64 (CmmInt x _)  =
 455                 [ptext (sLit "\t.long\t")
 456                     <> int (fromIntegral (fromIntegral x :: Word32)),
 457                  ptext (sLit "\t.long\t")
 458                     <> int (fromIntegral
 459                         (fromIntegral (x `shiftR` 32) :: Word32))]
 460 #endif
 461 #if i386_TARGET_ARCH || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
 462         ppr_item II64  _ = [ptext (sLit "\t.quad\t") <> pprImm imm]
 463 #endif
 464 #if x86_64_TARGET_ARCH && !darwin_TARGET_OS
 465         -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
 466         -- type, which means we can't do pc-relative 64-bit addresses.
 467         -- Fortunately we're assuming the small memory model, in which
 468         -- all such offsets will fit into 32 bits, so we have to stick
 469         -- to 32-bit offset fields and modify the RTS appropriately
 470         --
 471         -- See Note [x86-64-relative] in includes/rts/storage/InfoTables.h
 472         --
 473         ppr_item II64  x
 474            | isRelativeReloc x =
 475                 [ptext (sLit "\t.long\t") <> pprImm imm,
 476                  ptext (sLit "\t.long\t0")]
 477            | otherwise =
 478                 [ptext (sLit "\t.quad\t") <> pprImm imm]
 479            where
 480                 isRelativeReloc (CmmLabelDiffOff _ _ _) = True
 481                 isRelativeReloc _ = False
 482 #endif
 483
 484         ppr_item _ _
 485                 = panic "X86.Ppr.ppr_item: no match"
 486
 487
 488
 489 pprInstr :: Instr -> Doc
 490
 491 pprInstr (COMMENT _) = empty -- nuke 'em
 492 {-
 493 pprInstr (COMMENT s) = ptext (sLit "# ") <> ftext s
 494 -}
 495 pprInstr (DELTA d)
 496    = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
 497
 498 pprInstr (NEWBLOCK _)
 499    = panic "PprMach.pprInstr: NEWBLOCK"
 500
 501 pprInstr (LDATA _ _)
 502    = panic "PprMach.pprInstr: LDATA"
 503
 504 {-
 505 pprInstr (SPILL reg slot)
 506    = hcat [
 507         ptext (sLit "\tSPILL"),
 508         char ' ',
 509         pprUserReg reg,
 510         comma,
 511         ptext (sLit "SLOT") <> parens (int slot)]
 512
 513 pprInstr (RELOAD slot reg)
 514    = hcat [
 515         ptext (sLit "\tRELOAD"),
 516         char ' ',
 517         ptext (sLit "SLOT") <> parens (int slot),
 518         comma,
 519         pprUserReg reg]
 520 -}
 521
 522 pprInstr (MOV size src dst)
 523   = pprSizeOpOp (sLit "mov") size src dst
 524
 525 pprInstr (MOVZxL II32 src dst) = pprSizeOpOp (sLit "mov") II32 src dst
 526         -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
 527         -- movl.  But we represent it as a MOVZxL instruction, because
 528         -- the reg alloc would tend to throw away a plain reg-to-reg
 529         -- move, and we still want it to do that.
 530
 531 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce (sLit "movz") sizes II32 src dst
 532         -- zero-extension only needs to extend to 32 bits: on x86_64,
 533         -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
 534         -- instruction is shorter.
 535
 536 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce (sLit "movs") sizes archWordSize src dst
 537
 538 -- here we do some patching, since the physical registers are only set late
 539 -- in the code generation.
 540 pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
 541   | reg1 == reg3
 542   = pprSizeOpOp (sLit "add") size (OpReg reg2) dst
 543
 544 pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
 545   | reg2 == reg3
 546   = pprSizeOpOp (sLit "add") size (OpReg reg1) dst
 547
 548 pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
 549   | reg1 == reg3
 550   = pprInstr (ADD size (OpImm displ) dst)
 551
 552 pprInstr (LEA size src dst) = pprSizeOpOp (sLit "lea") size src dst
 553
 554 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
 555   = pprSizeOp (sLit "dec") size dst
 556 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
 557   = pprSizeOp (sLit "inc") size dst
 558 pprInstr (ADD size src dst)
 559   = pprSizeOpOp (sLit "add") size src dst
 560 pprInstr (ADC size src dst)
 561   = pprSizeOpOp (sLit "adc") size src dst
 562 pprInstr (SUB size src dst) = pprSizeOpOp (sLit "sub") size src dst
 563 pprInstr (IMUL size op1 op2) = pprSizeOpOp (sLit "imul") size op1 op2
 564
 565 {- A hack.  The Intel documentation says that "The two and three
 566    operand forms [of IMUL] may also be used with unsigned operands
 567    because the lower half of the product is the same regardless if
 568    (sic) the operands are signed or unsigned.  The CF and OF flags,
 569    however, cannot be used to determine if the upper half of the
 570    result is non-zero."  So there.
 571 -}
 572 pprInstr (AND size src dst) = pprSizeOpOp (sLit "and") size src dst
 573 pprInstr (OR  size src dst) = pprSizeOpOp (sLit "or")  size src dst
 574
 575 pprInstr (XOR FF32 src dst) = pprOpOp (sLit "xorps") FF32 src dst
 576 pprInstr (XOR FF64 src dst) = pprOpOp (sLit "xorpd") FF64 src dst
 577 pprInstr (XOR size src dst) = pprSizeOpOp (sLit "xor")  size src dst
 578
 579 pprInstr (NOT size op) = pprSizeOp (sLit "not") size op
 580 pprInstr (NEGI size op) = pprSizeOp (sLit "neg") size op
 581
 582 pprInstr (SHL size src dst) = pprShift (sLit "shl") size src dst
 583 pprInstr (SAR size src dst) = pprShift (sLit "sar") size src dst
 584 pprInstr (SHR size src dst) = pprShift (sLit "shr") size src dst
 585
 586 pprInstr (BT  size imm src) = pprSizeImmOp (sLit "bt") size imm src
 587
 588 pprInstr (CMP size src dst)
 589   | is_float size =  pprSizeOpOp (sLit "ucomi") size src dst -- SSE2
 590   | otherwise     =  pprSizeOpOp (sLit "cmp")   size src dst
 591   where
 592         -- This predicate is needed here and nowhere else
 593     is_float FF32       = True
 594     is_float FF64       = True
 595     is_float FF80       = True
 596     is_float _          = False
 597
 598 pprInstr (TEST size src dst) = pprSizeOpOp (sLit "test")  size src dst
 599 pprInstr (PUSH size op) = pprSizeOp (sLit "push") size op
 600 pprInstr (POP size op) = pprSizeOp (sLit "pop") size op
 601
 602 -- both unused (SDM):
 603 -- pprInstr PUSHA = ptext (sLit "\tpushal")
 604 -- pprInstr POPA = ptext (sLit "\tpopal")
 605
 606 pprInstr NOP = ptext (sLit "\tnop")
 607 pprInstr (CLTD II32) = ptext (sLit "\tcltd")
 608 pprInstr (CLTD II64) = ptext (sLit "\tcqto")
 609
 610 pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand II8 op)
 611
 612 pprInstr (JXX cond blockid)
 613   = pprCondInstr (sLit "j") cond (pprCLabel_asm lab)
 614   where lab = mkAsmTempLabel (getUnique blockid)
 615
 616 pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm)
 617
 618 pprInstr (JMP (OpImm imm)) = (<>) (ptext (sLit "\tjmp ")) (pprImm imm)
 619 pprInstr (JMP op)          = (<>) (ptext (sLit "\tjmp *")) (pprOperand archWordSize op)
 620 pprInstr (JMP_TBL op _ _ _)  = pprInstr (JMP op)
 621 pprInstr (CALL (Left imm) _)    = (<>) (ptext (sLit "\tcall ")) (pprImm imm)
 622 pprInstr (CALL (Right reg) _)   = (<>) (ptext (sLit "\tcall *")) (pprReg archWordSize reg)
 623
 624 pprInstr (IDIV sz op)   = pprSizeOp (sLit "idiv") sz op
 625 pprInstr (DIV sz op)    = pprSizeOp (sLit "div")  sz op
 626 pprInstr (IMUL2 sz op)  = pprSizeOp (sLit "imul") sz op
 627
 628 -- x86_64 only
 629 pprInstr (MUL size op1 op2) = pprSizeOpOp (sLit "mul") size op1 op2
 630
 631 pprInstr (FDIV size op1 op2) = pprSizeOpOp (sLit "div") size op1 op2
 632
 633 pprInstr (CVTSS2SD from to)      = pprRegReg (sLit "cvtss2sd") from to
 634 pprInstr (CVTSD2SS from to)      = pprRegReg (sLit "cvtsd2ss") from to
 635 pprInstr (CVTTSS2SIQ sz from to) = pprSizeSizeOpReg (sLit "cvttss2si") FF32 sz from to
 636 pprInstr (CVTTSD2SIQ sz from to) = pprSizeSizeOpReg (sLit "cvttsd2si") FF64 sz from to
 637 pprInstr (CVTSI2SS sz from to)   = pprSizeOpReg (sLit "cvtsi2ss") sz from to
 638 pprInstr (CVTSI2SD sz from to)   = pprSizeOpReg (sLit "cvtsi2sd") sz from to
 639
 640     -- FETCHGOT for PIC on ELF platforms
 641 pprInstr (FETCHGOT reg)
 642    = vcat [ ptext (sLit "\tcall 1f"),
 643             hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ],
 644             hcat [ ptext (sLit "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
 645                    pprReg II32 reg ]
 646           ]
 647
 648     -- FETCHPC for PIC on Darwin/x86
 649     -- get the instruction pointer into a register
 650     -- (Terminology note: the IP is called Program Counter on PPC,
 651     --  and it's a good thing to use the same name on both platforms)
 652 pprInstr (FETCHPC reg)
 653    = vcat [ ptext (sLit "\tcall 1f"),
 654             hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ]
 655           ]
 656
 657
 658 -- -----------------------------------------------------------------------------
 659 -- i386 floating-point
 660
 661 -- Simulating a flat register set on the x86 FP stack is tricky.
 662 -- you have to free %st(7) before pushing anything on the FP reg stack
 663 -- so as to preclude the possibility of a FP stack overflow exception.
 664 pprInstr g@(GMOV src dst)
 665    | src == dst
 666    = empty
 667    | otherwise
 668    = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
 669
 670 -- GLD sz addr dst ==> FLDsz addr ; FSTP (dst+1)
 671 pprInstr g@(GLD sz addr dst)
 672  = pprG g (hcat [gtab, text "fld", pprSize_x87 sz, gsp,
 673                  pprAddr addr, gsemi, gpop dst 1])
 674
 675 -- GST sz src addr ==> FLD dst ; FSTPsz addr
 676 pprInstr g@(GST sz src addr)
 677  | src == fake0 && sz /= FF80 -- fstt instruction doesn't exist
 678  = pprG g (hcat [gtab,
 679                  text "fst", pprSize_x87 sz, gsp, pprAddr addr])
 680  | otherwise
 681  = pprG g (hcat [gtab, gpush src 0, gsemi,
 682                  text "fstp", pprSize_x87 sz, gsp, pprAddr addr])
 683
 684 pprInstr g@(GLDZ dst)
 685  = pprG g (hcat [gtab, text "fldz ; ", gpop dst 1])
 686 pprInstr g@(GLD1 dst)
 687  = pprG g (hcat [gtab, text "fld1 ; ", gpop dst 1])
 688
 689 pprInstr (GFTOI src dst)
 690    = pprInstr (GDTOI src dst)
 691
 692 pprInstr g@(GDTOI src dst)
 693    = pprG g (vcat [
 694          hcat [gtab, text "subl $8, %esp ; fnstcw 4(%esp)"],
 695          hcat [gtab, gpush src 0],
 696          hcat [gtab, text "movzwl 4(%esp), ", reg,
 697                      text " ; orl $0xC00, ", reg],
 698          hcat [gtab, text "movl ", reg, text ", 0(%esp) ; fldcw 0(%esp)"],
 699          hcat [gtab, text "fistpl 0(%esp)"],
 700          hcat [gtab, text "fldcw 4(%esp) ; movl 0(%esp), ", reg],
 701          hcat [gtab, text "addl $8, %esp"]
 702      ])
 703    where
 704      reg = pprReg II32 dst
 705
 706 pprInstr (GITOF src dst)
 707    = pprInstr (GITOD src dst)
 708
 709 pprInstr g@(GITOD src dst)
 710    = pprG g (hcat [gtab, text "pushl ", pprReg II32 src,
 711                    text " ; fildl (%esp) ; ",
 712                    gpop dst 1, text " ; addl $4,%esp"])
 713
 714 pprInstr g@(GDTOF src dst)
 715   = pprG g (vcat [gtab <> gpush src 0,
 716                   gtab <> text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ;",
 717                   gtab <> gpop dst 1])
 718
 719 {- Gruesome swamp follows.  If you're unfortunate enough to have ventured
 720    this far into the jungle AND you give a Rat's Ass (tm) what's going
 721    on, here's the deal.  Generate code to do a floating point comparison
 722    of src1 and src2, of kind cond, and set the Zero flag if true.
 723
 724    The complications are to do with handling NaNs correctly.  We want the
 725    property that if either argument is NaN, then the result of the
 726    comparison is False ... except if we're comparing for inequality,
 727    in which case the answer is True.
 728
 729    Here's how the general (non-inequality) case works.  As an
 730    example, consider generating the an equality test:
 731
 732      pushl %eax         -- we need to mess with this
 733      <get src1 to top of FPU stack>
 734      fcomp <src2 location in FPU stack> and pop pushed src1
 735                 -- Result of comparison is in FPU Status Register bits
 736                 -- C3 C2 and C0
 737      fstsw %ax  -- Move FPU Status Reg to %ax
 738      sahf       -- move C3 C2 C0 from %ax to integer flag reg
 739      -- now the serious magic begins
 740      setpo %ah     -- %ah = if comparable(neither arg was NaN) then 1 else 0
 741      sete  %al     -- %al = if arg1 == arg2 then 1 else 0
 742      andb %ah,%al  -- %al &= %ah
 743                    -- so %al == 1 iff (comparable && same); else it holds 0
 744      decb %al      -- %al == 0, ZeroFlag=1  iff (comparable && same);
 745                       else %al == 0xFF, ZeroFlag=0
 746      -- the zero flag is now set as we desire.
 747      popl %eax
 748
 749    The special case of inequality differs thusly:
 750
 751      setpe %ah     -- %ah = if incomparable(either arg was NaN) then 1 else 0
 752      setne %al     -- %al = if arg1 /= arg2 then 1 else 0
 753      orb %ah,%al   -- %al = if (incomparable || different) then 1 else 0
 754      decb %al      -- if (incomparable || different) then (%al == 0, ZF=1)
 755                                                      else (%al == 0xFF, ZF=0)
 756 -}
 757 pprInstr g@(GCMP cond src1 src2)
 758    | case cond of { NE -> True; _ -> False }
 759    = pprG g (vcat [
 760         hcat [gtab, text "pushl %eax ; ",gpush src1 0],
 761         hcat [gtab, text "fcomp ", greg src2 1,
 762                     text "; fstsw %ax ; sahf ;  setpe %ah"],
 763         hcat [gtab, text "setne %al ;  ",
 764               text "orb %ah,%al ;  decb %al ;  popl %eax"]
 765     ])
 766    | otherwise
 767    = pprG g (vcat [
 768         hcat [gtab, text "pushl %eax ; ",gpush src1 0],
 769         hcat [gtab, text "fcomp ", greg src2 1,
 770                     text "; fstsw %ax ; sahf ;  setpo %ah"],
 771         hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ;  ",
 772               text "andb %ah,%al ;  decb %al ;  popl %eax"]
 773     ])
 774     where
 775         {- On the 486, the flags set by FP compare are the unsigned ones!
 776            (This looks like a HACK to me.  WDP 96/03)
 777         -}
 778         fix_FP_cond :: Cond -> Cond
 779         fix_FP_cond GE   = GEU
 780         fix_FP_cond GTT  = GU
 781         fix_FP_cond LTT  = LU
 782         fix_FP_cond LE   = LEU
 783         fix_FP_cond EQQ  = EQQ
 784         fix_FP_cond NE   = NE
 785         fix_FP_cond _    = panic "X86.Ppr.fix_FP_cond: no match"
 786         -- there should be no others
 787
 788
 789 pprInstr g@(GABS _ src dst)
 790    = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
 791
 792 pprInstr g@(GNEG _ src dst)
 793    = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
 794
 795 pprInstr g@(GSQRT sz src dst)
 796    = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
 797              hcat [gtab, gcoerceto sz, gpop dst 1])
 798
 799 pprInstr g@(GSIN sz l1 l2 src dst)
 800    = pprG g (pprTrigOp "fsin" False l1 l2 src dst sz)
 801
 802 pprInstr g@(GCOS sz l1 l2 src dst)
 803    = pprG g (pprTrigOp "fcos" False l1 l2 src dst sz)
 804
 805 pprInstr g@(GTAN sz l1 l2 src dst)
 806    = pprG g (pprTrigOp "fptan" True l1 l2 src dst sz)
 807
 808 -- In the translations for GADD, GMUL, GSUB and GDIV,
 809 -- the first two cases are mere optimisations.  The otherwise clause
 810 -- generates correct code under all circumstances.
 811
 812 pprInstr g@(GADD _ src1 src2 dst)
 813    | src1 == dst
 814    = pprG g (text "\t#GADD-xxxcase1" $$
 815              hcat [gtab, gpush src2 0,
 816                    text " ; faddp %st(0),", greg src1 1])
 817    | src2 == dst
 818    = pprG g (text "\t#GADD-xxxcase2" $$
 819              hcat [gtab, gpush src1 0,
 820                    text " ; faddp %st(0),", greg src2 1])
 821    | otherwise
 822    = pprG g (hcat [gtab, gpush src1 0,
 823                    text " ; fadd ", greg src2 1, text ",%st(0)",
 824                    gsemi, gpop dst 1])
 825
 826
 827 pprInstr g@(GMUL _ src1 src2 dst)
 828    | src1 == dst
 829    = pprG g (text "\t#GMUL-xxxcase1" $$
 830              hcat [gtab, gpush src2 0,
 831                    text " ; fmulp %st(0),", greg src1 1])
 832    | src2 == dst
 833    = pprG g (text "\t#GMUL-xxxcase2" $$
 834              hcat [gtab, gpush src1 0,
 835                    text " ; fmulp %st(0),", greg src2 1])
 836    | otherwise
 837    = pprG g (hcat [gtab, gpush src1 0,
 838                    text " ; fmul ", greg src2 1, text ",%st(0)",
 839                    gsemi, gpop dst 1])
 840
 841
 842 pprInstr g@(GSUB _ src1 src2 dst)
 843    | src1 == dst
 844    = pprG g (text "\t#GSUB-xxxcase1" $$
 845              hcat [gtab, gpush src2 0,
 846                    text " ; fsubrp %st(0),", greg src1 1])
 847    | src2 == dst
 848    = pprG g (text "\t#GSUB-xxxcase2" $$
 849              hcat [gtab, gpush src1 0,
 850                    text " ; fsubp %st(0),", greg src2 1])
 851    | otherwise
 852    = pprG g (hcat [gtab, gpush src1 0,
 853                    text " ; fsub ", greg src2 1, text ",%st(0)",
 854                    gsemi, gpop dst 1])
 855
 856
 857 pprInstr g@(GDIV _ src1 src2 dst)
 858    | src1 == dst
 859    = pprG g (text "\t#GDIV-xxxcase1" $$
 860              hcat [gtab, gpush src2 0,
 861                    text " ; fdivrp %st(0),", greg src1 1])
 862    | src2 == dst
 863    = pprG g (text "\t#GDIV-xxxcase2" $$
 864              hcat [gtab, gpush src1 0,
 865                    text " ; fdivp %st(0),", greg src2 1])
 866    | otherwise
 867    = pprG g (hcat [gtab, gpush src1 0,
 868                    text " ; fdiv ", greg src2 1, text ",%st(0)",
 869                    gsemi, gpop dst 1])
 870
 871
 872 pprInstr GFREE
 873    = vcat [ ptext (sLit "\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
 874             ptext (sLit "\tffree %st(4) ;ffree %st(5)")
 875           ]
 876
 877 pprInstr _
 878         = panic "X86.Ppr.pprInstr: no match"
 879
 880
 881 pprTrigOp :: String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> Size -> Doc
 882 pprTrigOp op -- fsin, fcos or fptan
 883           isTan -- we need a couple of extra steps if we're doing tan
 884           l1 l2 -- internal labels for us to use
 885           src dst sz
 886     = -- We'll be needing %eax later on
 887       hcat [gtab, text "pushl %eax;"] $$
 888       -- tan is going to use an extra space on the FP stack
 889       (if isTan then hcat [gtab, text "ffree %st(6)"] else empty) $$
 890       -- First put the value in %st(0) and try to apply the op to it
 891       hcat [gpush src 0, text ("; " ++ op)] $$
 892       -- Now look to see if C2 was set (overflow, |value| >= 2^63)
 893       hcat [gtab, text "fnstsw %ax"] $$
 894       hcat [gtab, text "test   $0x400,%eax"] $$
 895       -- If we were in bounds then jump to the end
 896       hcat [gtab, text "je     " <> pprCLabel_asm l1] $$
 897       -- Otherwise we need to shrink the value. Start by
 898       -- loading pi, doubleing it (by adding it to itself),
 899       -- and then swapping pi with the value, so the value we
 900       -- want to apply op to is in %st(0) again
 901       hcat [gtab, text "ffree %st(7); fldpi"] $$
 902       hcat [gtab, text "fadd   %st(0),%st"] $$
 903       hcat [gtab, text "fxch   %st(1)"] $$
 904       -- Now we have a loop in which we make the value smaller,
 905       -- see if it's small enough, and loop if not
 906       (pprCLabel_asm l2 <> char ':') $$
 907       hcat [gtab, text "fprem1"] $$
 908       -- My Debian libc uses fstsw here for the tan code, but I can't
 909       -- see any reason why it should need to be different for tan.
 910       hcat [gtab, text "fnstsw %ax"] $$
 911       hcat [gtab, text "test   $0x400,%eax"] $$
 912       hcat [gtab, text "jne    " <> pprCLabel_asm l2] $$
 913       hcat [gtab, text "fstp   %st(1)"] $$
 914       hcat [gtab, text op] $$
 915       (pprCLabel_asm l1 <> char ':') $$
 916       -- Pop the 1.0 tan gave us
 917       (if isTan then hcat [gtab, text "fstp %st(0)"] else empty) $$
 918       -- Restore %eax
 919       hcat [gtab, text "popl %eax;"] $$
 920       -- And finally make the result the right size
 921       hcat [gtab, gcoerceto sz, gpop dst 1]
 922
 923 --------------------------
 924
 925 -- coerce %st(0) to the specified size
 926 gcoerceto :: Size -> Doc
 927 gcoerceto FF64 = empty
 928 gcoerceto FF32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
 929 gcoerceto _    = panic "X86.Ppr.gcoerceto: no match"
 930
 931 gpush :: Reg -> RegNo -> Doc
 932 gpush reg offset
 933    = hcat [text "fld ", greg reg offset]
 934
 935 gpop :: Reg -> RegNo -> Doc
 936 gpop reg offset
 937    = hcat [text "fstp ", greg reg offset]
 938
 939 greg :: Reg -> RegNo -> Doc
 940 greg reg offset = text "%st(" <> int (gregno reg - firstfake+offset) <> char ')'
 941
 942 gsemi :: Doc
 943 gsemi = text " ; "
 944
 945 gtab :: Doc
 946 gtab  = char '\t'
 947
 948 gsp :: Doc
 949 gsp   = char ' '
 950
 951 gregno :: Reg -> RegNo
 952 gregno (RegReal (RealRegSingle i)) = i
 953 gregno _           = --pprPanic "gregno" (ppr other)
 954                      999   -- bogus; only needed for debug printing
 955
 956 pprG :: Instr -> Doc -> Doc
 957 pprG fake actual
 958    = (char '#' <> pprGInstr fake) $$ actual
 959
 960
 961 pprGInstr :: Instr -> Doc
 962 pprGInstr (GMOV src dst)   = pprSizeRegReg (sLit "gmov") FF64 src dst
 963 pprGInstr (GLD sz src dst) = pprSizeAddrReg (sLit "gld") sz src dst
 964 pprGInstr (GST sz src dst) = pprSizeRegAddr (sLit "gst") sz src dst
 965
 966 pprGInstr (GLDZ dst) = pprSizeReg (sLit "gldz") FF64 dst
 967 pprGInstr (GLD1 dst) = pprSizeReg (sLit "gld1") FF64 dst
 968
 969 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg (sLit "gftoi") FF32 II32  src dst
 970 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg (sLit "gdtoi") FF64 II32 src dst
 971
 972 pprGInstr (GITOF src dst) = pprSizeSizeRegReg (sLit "gitof") II32 FF32  src dst
 973 pprGInstr (GITOD src dst) = pprSizeSizeRegReg (sLit "gitod") II32 FF64 src dst
 974 pprGInstr (GDTOF src dst) = pprSizeSizeRegReg (sLit "gdtof") FF64 FF32 src dst
 975
 976 pprGInstr (GCMP co src dst) = pprCondRegReg (sLit "gcmp_") FF64 co src dst
 977 pprGInstr (GABS sz src dst) = pprSizeRegReg (sLit "gabs") sz src dst
 978 pprGInstr (GNEG sz src dst) = pprSizeRegReg (sLit "gneg") sz src dst
 979 pprGInstr (GSQRT sz src dst) = pprSizeRegReg (sLit "gsqrt") sz src dst
 980 pprGInstr (GSIN sz _ _ src dst) = pprSizeRegReg (sLit "gsin") sz src dst
 981 pprGInstr (GCOS sz _ _ src dst) = pprSizeRegReg (sLit "gcos") sz src dst
 982 pprGInstr (GTAN sz _ _ src dst) = pprSizeRegReg (sLit "gtan") sz src dst
 983
 984 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg (sLit "gadd") sz src1 src2 dst
 985 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg (sLit "gsub") sz src1 src2 dst
 986 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg (sLit "gmul") sz src1 src2 dst
 987 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg (sLit "gdiv") sz src1 src2 dst
 988
 989 pprGInstr _ = panic "X86.Ppr.pprGInstr: no match"
 990
 991 pprDollImm :: Imm -> Doc
 992 pprDollImm i =  ptext (sLit "$") <> pprImm i
 993
 994
 995 pprOperand :: Size -> Operand -> Doc
 996 pprOperand s (OpReg r)   = pprReg s r
 997 pprOperand _ (OpImm i)   = pprDollImm i
 998 pprOperand _ (OpAddr ea) = pprAddr ea
 999
1000
1001 pprMnemonic_  :: LitString -> Doc
1002 pprMnemonic_ name =
1003    char '\t' <> ptext name <> space
1004
1005
1006 pprMnemonic  :: LitString -> Size -> Doc
1007 pprMnemonic name size =
1008    char '\t' <> ptext name <> pprSize size <> space
1009
1010
1011 pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> Doc
1012 pprSizeImmOp name size imm op1
1013   = hcat [
1014         pprMnemonic name size,
1015         char '$',
1016         pprImm imm,
1017         comma,
1018         pprOperand size op1
1019     ]
1020
1021
1022 pprSizeOp :: LitString -> Size -> Operand -> Doc
1023 pprSizeOp name size op1
1024   = hcat [
1025         pprMnemonic name size,
1026         pprOperand size op1
1027     ]
1028
1029
1030 pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1031 pprSizeOpOp name size op1 op2
1032   = hcat [
1033         pprMnemonic name size,
1034         pprOperand size op1,
1035         comma,
1036         pprOperand size op2
1037     ]
1038
1039
1040 pprOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1041 pprOpOp name size op1 op2
1042   = hcat [
1043         pprMnemonic_ name,
1044         pprOperand size op1,
1045         comma,
1046         pprOperand size op2
1047     ]
1048
1049
1050 pprSizeReg :: LitString -> Size -> Reg -> Doc
1051 pprSizeReg name size reg1
1052   = hcat [
1053         pprMnemonic name size,
1054         pprReg size reg1
1055     ]
1056
1057
1058 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1059 pprSizeRegReg name size reg1 reg2
1060   = hcat [
1061         pprMnemonic name size,
1062         pprReg size reg1,
1063         comma,
1064         pprReg size reg2
1065     ]
1066
1067
1068 pprRegReg :: LitString -> Reg -> Reg -> Doc
1069 pprRegReg name reg1 reg2
1070   = hcat [
1071         pprMnemonic_ name,
1072         pprReg archWordSize reg1,
1073         comma,
1074         pprReg archWordSize reg2
1075     ]
1076
1077
1078 pprSizeOpReg :: LitString -> Size -> Operand -> Reg -> Doc
1079 pprSizeOpReg name size op1 reg2
1080   = hcat [
1081         pprMnemonic name size,
1082         pprOperand size op1,
1083         comma,
1084         pprReg archWordSize reg2
1085     ]
1086
1087 pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc
1088 pprCondRegReg name size cond reg1 reg2
1089   = hcat [
1090         char '\t',
1091         ptext name,
1092         pprCond cond,
1093         space,
1094         pprReg size reg1,
1095         comma,
1096         pprReg size reg2
1097     ]
1098
1099 pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> Doc
1100 pprSizeSizeRegReg name size1 size2 reg1 reg2
1101   = hcat [
1102         char '\t',
1103         ptext name,
1104         pprSize size1,
1105         pprSize size2,
1106         space,
1107         pprReg size1 reg1,
1108         comma,
1109         pprReg size2 reg2
1110     ]
1111
1112 pprSizeSizeOpReg :: LitString -> Size -> Size -> Operand -> Reg -> Doc
1113 pprSizeSizeOpReg name size1 size2 op1 reg2
1114   = hcat [
1115         pprMnemonic name size2,
1116         pprOperand size1 op1,
1117         comma,
1118         pprReg size2 reg2
1119     ]
1120
1121 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1122 pprSizeRegRegReg name size reg1 reg2 reg3
1123   = hcat [
1124         pprMnemonic name size,
1125         pprReg size reg1,
1126         comma,
1127         pprReg size reg2,
1128         comma,
1129         pprReg size reg3
1130     ]
1131
1132
1133 pprSizeAddrReg :: LitString -> Size -> AddrMode -> Reg -> Doc
1134 pprSizeAddrReg name size op dst
1135   = hcat [
1136         pprMnemonic name size,
1137         pprAddr op,
1138         comma,
1139         pprReg size dst
1140     ]
1141
1142
1143 pprSizeRegAddr :: LitString -> Size -> Reg -> AddrMode -> Doc
1144 pprSizeRegAddr name size src op
1145   = hcat [
1146         pprMnemonic name size,
1147         pprReg size src,
1148         comma,
1149         pprAddr op
1150     ]
1151
1152
1153 pprShift :: LitString -> Size -> Operand -> Operand -> Doc
1154 pprShift name size src dest
1155   = hcat [
1156         pprMnemonic name size,
1157         pprOperand II8 src,  -- src is 8-bit sized
1158         comma,
1159         pprOperand size dest
1160     ]
1161
1162
1163 pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> Doc
1164 pprSizeOpOpCoerce name size1 size2 op1 op2
1165   = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1166         pprOperand size1 op1,
1167         comma,
1168         pprOperand size2 op2
1169     ]
1170
1171
1172 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1173 pprCondInstr name cond arg
1174   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1175