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