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