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