compiler/nativeGen/X86/Ppr.hs

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