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