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