Ppr.hs 43.7 KB
Newer Older
1 2 3 4 5 6 7 8 9
-----------------------------------------------------------------------------
--
-- Pretty-printing assembly language
--
-- (c) The University of Glasgow 1993-2005
--
-----------------------------------------------------------------------------

module X86.Ppr (
Simon Peyton Jones's avatar
Simon Peyton Jones committed
10
        pprNatCmmDecl,
Ian Lynagh's avatar
Ian Lynagh committed
11 12 13 14 15 16 17
        pprBasicBlock,
        pprSectionHeader,
        pprData,
        pprInstr,
        pprSize,
        pprImm,
        pprDataItem,
18 19 20 21 22 23 24 25 26
)

where

#include "HsVersions.h"
#include "nativeGen/NCG.h"

import X86.Regs
import X86.Instr
27 28 29 30 31 32
import X86.Cond
import Instruction
import Size
import Reg
import PprBase

33

34
import BasicTypes       (Alignment)
35
import OldCmm
36
import CLabel
37
import Unique           ( pprUnique, Uniquable(..) )
Ian Lynagh's avatar
Ian Lynagh committed
38
import Platform
39 40 41
import Pretty
import FastString
import qualified Outputable
42
import Outputable       (panic, PlatformOutputable)
43 44 45

import Data.Word

46
import Data.Bits
47 48 49 50

-- -----------------------------------------------------------------------------
-- Printing this stuff out

Simon Peyton Jones's avatar
Simon Peyton Jones committed
51 52
pprNatCmmDecl :: Platform -> NatCmmDecl (Alignment, CmmStatics) Instr -> Doc
pprNatCmmDecl platform (CmmData section dats) =
Ian Lynagh's avatar
Ian Lynagh committed
53
  pprSectionHeader platform section $$ pprDatas platform dats
54 55

 -- special case for split markers:
Simon Peyton Jones's avatar
Simon Peyton Jones committed
56
pprNatCmmDecl platform (CmmProc Nothing lbl (ListGraph [])) = pprLabel platform lbl
57

58
 -- special case for code without info table:
Simon Peyton Jones's avatar
Simon Peyton Jones committed
59
pprNatCmmDecl platform (CmmProc Nothing lbl (ListGraph blocks)) =
Ian Lynagh's avatar
Ian Lynagh committed
60
  pprSectionHeader platform Text $$
Ian Lynagh's avatar
Ian Lynagh committed
61 62
  pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed
  vcat (map (pprBasicBlock platform) blocks) $$
Ian Lynagh's avatar
Ian Lynagh committed
63
  pprSizeDecl platform lbl
64

Simon Peyton Jones's avatar
Simon Peyton Jones committed
65
pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) =
Ian Lynagh's avatar
Ian Lynagh committed
66
  pprSectionHeader platform Text $$
67
  (
68 69 70
       (if platformHasSubsectionsViaSymbols platform
        then pprCLabel_asm platform (mkDeadStripPreventer info_lbl) <> char ':'
        else empty) $$
Ian Lynagh's avatar
Ian Lynagh committed
71 72
       vcat (map (pprData platform) info) $$
       pprLabel platform info_lbl
73
  ) $$
74
  vcat (map (pprBasicBlock platform) blocks) $$
75 76
     -- above: Even the first block gets a label, because with branch-chain
     -- elimination, it might be the target of a goto.
77 78 79 80 81 82 83 84 85 86 87 88 89 90
        (if platformHasSubsectionsViaSymbols platform
         then
         -- If we are using the .subsections_via_symbols directive
         -- (available on recent versions of Darwin),
         -- we have to make sure that there is some kind of reference
         -- from the entry code to a label on the _top_ of of the info table,
         -- so that the linker will not think it is unreferenced and dead-strip
         -- it. That's why the label is called a DeadStripPreventer (_dsp).
                  text "\t.long "
              <+> pprCLabel_asm platform info_lbl
              <+> char '-'
              <+> pprCLabel_asm platform (mkDeadStripPreventer info_lbl)
         else empty) $$
  pprSizeDecl platform info_lbl
91 92

-- | Output the ELF .size directive.
Ian Lynagh's avatar
Ian Lynagh committed
93 94 95
pprSizeDecl :: Platform -> CLabel -> Doc
pprSizeDecl platform lbl
 | osElfTarget (platformOS platform) =
96 97
    ptext (sLit "\t.size") <+> pprCLabel_asm platform lbl
    <> ptext (sLit ", .-") <> pprCLabel_asm platform lbl
Ian Lynagh's avatar
Ian Lynagh committed
98
 | otherwise = empty
99

Ian Lynagh's avatar
Ian Lynagh committed
100 101 102
pprBasicBlock :: Platform -> NatBasicBlock Instr -> Doc
pprBasicBlock platform (BasicBlock blockid instrs) =
  pprLabel platform (mkAsmTempLabel (getUnique blockid)) $$
Ian Lynagh's avatar
Ian Lynagh committed
103
  vcat (map (pprInstr platform) instrs)
104 105


Ian Lynagh's avatar
Ian Lynagh committed
106 107 108 109
pprDatas :: Platform -> (Alignment, CmmStatics) -> Doc
pprDatas platform (align, (Statics lbl dats))
 = vcat (pprAlign platform align : pprLabel platform lbl : map (pprData platform) dats)
 -- TODO: could remove if align == 1
110

Ian Lynagh's avatar
Ian Lynagh committed
111 112
pprData :: Platform -> CmmStatic -> Doc
pprData _ (CmmString str)          = pprASCII str
113

Ian Lynagh's avatar
Ian Lynagh committed
114 115 116
pprData platform (CmmUninitialised bytes)
 | platformOS platform == OSDarwin = ptext (sLit ".space ") <> int bytes
 | otherwise                       = ptext (sLit ".skip ")  <> int bytes
117

Ian Lynagh's avatar
Ian Lynagh committed
118
pprData platform (CmmStaticLit lit) = pprDataItem platform lit
119

120 121
pprGloblDecl :: Platform -> CLabel -> Doc
pprGloblDecl platform lbl
122
  | not (externallyVisibleCLabel lbl) = empty
123
  | otherwise = ptext (sLit ".globl ") <> pprCLabel_asm platform lbl
124

Ian Lynagh's avatar
Ian Lynagh committed
125 126 127 128
pprTypeAndSizeDecl :: Platform -> CLabel -> Doc
pprTypeAndSizeDecl platform lbl
 | osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
    = ptext (sLit ".type ") <>
129
      pprCLabel_asm platform lbl <> ptext (sLit ", @object")
Ian Lynagh's avatar
Ian Lynagh committed
130
 | otherwise = empty
131

Ian Lynagh's avatar
Ian Lynagh committed
132
pprLabel :: Platform -> CLabel -> Doc
133
pprLabel platform lbl = pprGloblDecl platform lbl
Ian Lynagh's avatar
Ian Lynagh committed
134
                     $$ pprTypeAndSizeDecl platform lbl
135
                     $$ (pprCLabel_asm platform lbl <> char ':')
136 137 138 139 140 141 142 143 144


pprASCII :: [Word8] -> Doc
pprASCII str
  = vcat (map do1 str) $$ do1 0
    where
       do1 :: Word8 -> Doc
       do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)

Ian Lynagh's avatar
Ian Lynagh committed
145 146 147
pprAlign :: Platform -> Int -> Doc
pprAlign platform bytes
        = ptext (sLit ".align ") <> int alignment
148
  where
Ian Lynagh's avatar
Ian Lynagh committed
149 150 151
        alignment = if platformOS platform == OSDarwin
                    then log2 bytes
                    else      bytes
Ian Lynagh's avatar
Ian Lynagh committed
152 153 154 155 156 157 158

        log2 :: Int -> Int  -- cache the common ones
        log2 1 = 0
        log2 2 = 1
        log2 4 = 2
        log2 8 = 3
        log2 n = 1 + log2 (n `quot` 2)
159 160 161 162

-- -----------------------------------------------------------------------------
-- pprInstr: print an 'Instr'

163 164
instance PlatformOutputable Instr where
    pprPlatform platform instr = Outputable.docToSDoc $ pprInstr platform instr
165 166


Ian Lynagh's avatar
Ian Lynagh committed
167
pprReg :: Platform -> Size -> Reg -> Doc
Ian Lynagh's avatar
Ian Lynagh committed
168
pprReg platform s r
169
  = case r of
Ian Lynagh's avatar
Ian Lynagh committed
170 171 172
      RegReal    (RealRegSingle i) ->
          if target32Bit platform then ppr32_reg_no s i
                                  else ppr64_reg_no s i
173 174 175 176 177
      RegReal    (RealRegPair _ _) -> panic "X86.Ppr: no reg pairs on this arch"
      RegVirtual (VirtualRegI  u)  -> text "%vI_" <> asmSDoc (pprUnique u)
      RegVirtual (VirtualRegHi u)  -> text "%vHi_" <> asmSDoc (pprUnique u)
      RegVirtual (VirtualRegF  u)  -> text "%vF_" <> asmSDoc (pprUnique u)
      RegVirtual (VirtualRegD  u)  -> text "%vD_" <> asmSDoc (pprUnique u)
178
      RegVirtual (VirtualRegSSE  u) -> text "%vSSE_" <> asmSDoc (pprUnique u)
179
  where
Ian Lynagh's avatar
Ian Lynagh committed
180 181 182 183
    ppr32_reg_no :: Size -> Int -> Doc
    ppr32_reg_no II8   = ppr32_reg_byte
    ppr32_reg_no II16  = ppr32_reg_word
    ppr32_reg_no _     = ppr32_reg_long
184

Ian Lynagh's avatar
Ian Lynagh committed
185
    ppr32_reg_byte i = ptext
186
      (case i of {
Ian Lynagh's avatar
Ian Lynagh committed
187 188 189
         0 -> sLit "%al";     1 -> sLit "%bl";
         2 -> sLit "%cl";     3 -> sLit "%dl";
        _  -> sLit "very naughty I386 byte register"
190 191
      })

Ian Lynagh's avatar
Ian Lynagh committed
192
    ppr32_reg_word i = ptext
193
      (case i of {
Ian Lynagh's avatar
Ian Lynagh committed
194 195 196 197 198
         0 -> sLit "%ax";     1 -> sLit "%bx";
         2 -> sLit "%cx";     3 -> sLit "%dx";
         4 -> sLit "%si";     5 -> sLit "%di";
         6 -> sLit "%bp";     7 -> sLit "%sp";
        _  -> sLit "very naughty I386 word register"
199 200
      })

Ian Lynagh's avatar
Ian Lynagh committed
201
    ppr32_reg_long i = ptext
202
      (case i of {
Ian Lynagh's avatar
Ian Lynagh committed
203 204 205 206
         0 -> sLit "%eax";    1 -> sLit "%ebx";
         2 -> sLit "%ecx";    3 -> sLit "%edx";
         4 -> sLit "%esi";    5 -> sLit "%edi";
         6 -> sLit "%ebp";    7 -> sLit "%esp";
207
         _  -> ppr_reg_float i
208
      })
Ian Lynagh's avatar
Ian Lynagh committed
209 210 211 212 213 214 215 216

    ppr64_reg_no :: Size -> Int -> Doc
    ppr64_reg_no II8   = ppr64_reg_byte
    ppr64_reg_no II16  = ppr64_reg_word
    ppr64_reg_no II32  = ppr64_reg_long
    ppr64_reg_no _     = ppr64_reg_quad

    ppr64_reg_byte i = ptext
217
      (case i of {
Ian Lynagh's avatar
Ian Lynagh committed
218 219 220 221 222 223 224 225 226
         0 -> sLit "%al";     1 -> sLit "%bl";
         2 -> sLit "%cl";     3 -> sLit "%dl";
         4 -> sLit "%sil";    5 -> sLit "%dil"; -- new 8-bit regs!
         6 -> sLit "%bpl";    7 -> sLit "%spl";
         8 -> sLit "%r8b";    9  -> sLit "%r9b";
        10 -> sLit "%r10b";   11 -> sLit "%r11b";
        12 -> sLit "%r12b";   13 -> sLit "%r13b";
        14 -> sLit "%r14b";   15 -> sLit "%r15b";
        _  -> sLit "very naughty x86_64 byte register"
227 228
      })

Ian Lynagh's avatar
Ian Lynagh committed
229
    ppr64_reg_word i = ptext
230
      (case i of {
Ian Lynagh's avatar
Ian Lynagh committed
231 232 233 234 235 236 237 238 239
         0 -> sLit "%ax";     1 -> sLit "%bx";
         2 -> sLit "%cx";     3 -> sLit "%dx";
         4 -> sLit "%si";     5 -> sLit "%di";
         6 -> sLit "%bp";     7 -> sLit "%sp";
         8 -> sLit "%r8w";    9  -> sLit "%r9w";
        10 -> sLit "%r10w";   11 -> sLit "%r11w";
        12 -> sLit "%r12w";   13 -> sLit "%r13w";
        14 -> sLit "%r14w";   15 -> sLit "%r15w";
        _  -> sLit "very naughty x86_64 word register"
240 241
      })

Ian Lynagh's avatar
Ian Lynagh committed
242
    ppr64_reg_long i = ptext
243
      (case i of {
Ian Lynagh's avatar
Ian Lynagh committed
244 245 246 247 248 249 250 251 252
         0 -> sLit "%eax";    1  -> sLit "%ebx";
         2 -> sLit "%ecx";    3  -> sLit "%edx";
         4 -> sLit "%esi";    5  -> sLit "%edi";
         6 -> sLit "%ebp";    7  -> sLit "%esp";
         8 -> sLit "%r8d";    9  -> sLit "%r9d";
        10 -> sLit "%r10d";   11 -> sLit "%r11d";
        12 -> sLit "%r12d";   13 -> sLit "%r13d";
        14 -> sLit "%r14d";   15 -> sLit "%r15d";
        _  -> sLit "very naughty x86_64 register"
253 254
      })

Ian Lynagh's avatar
Ian Lynagh committed
255
    ppr64_reg_quad i = ptext
256
      (case i of {
Ian Lynagh's avatar
Ian Lynagh committed
257 258 259 260 261 262 263 264
         0 -> sLit "%rax";      1 -> sLit "%rbx";
         2 -> sLit "%rcx";      3 -> sLit "%rdx";
         4 -> sLit "%rsi";      5 -> sLit "%rdi";
         6 -> sLit "%rbp";      7 -> sLit "%rsp";
         8 -> sLit "%r8";       9 -> sLit "%r9";
        10 -> sLit "%r10";    11 -> sLit "%r11";
        12 -> sLit "%r12";    13 -> sLit "%r13";
        14 -> sLit "%r14";    15 -> sLit "%r15";
265
        _  -> ppr_reg_float i
266 267
      })

268 269
ppr_reg_float :: Int -> LitString
ppr_reg_float i = case i of
Ian Lynagh's avatar
Ian Lynagh committed
270 271 272 273 274 275 276 277 278 279 280 281
        16 -> sLit "%fake0";  17 -> sLit "%fake1"
        18 -> sLit "%fake2";  19 -> sLit "%fake3"
        20 -> sLit "%fake4";  21 -> sLit "%fake5"
        24 -> sLit "%xmm0";   25 -> sLit "%xmm1"
        26 -> sLit "%xmm2";   27 -> sLit "%xmm3"
        28 -> sLit "%xmm4";   29 -> sLit "%xmm5"
        30 -> sLit "%xmm6";   31 -> sLit "%xmm7"
        32 -> sLit "%xmm8";   33 -> sLit "%xmm9"
        34 -> sLit "%xmm10";  35 -> sLit "%xmm11"
        36 -> sLit "%xmm12";  37 -> sLit "%xmm13"
        38 -> sLit "%xmm14";  39 -> sLit "%xmm15"
        _  -> sLit "very naughty x86 register"
282 283

pprSize :: Size -> Doc
Ian Lynagh's avatar
Ian Lynagh committed
284
pprSize x
285
 = ptext (case x of
Ian Lynagh's avatar
Ian Lynagh committed
286 287 288 289 290 291 292 293
                II8   -> sLit "b"
                II16  -> sLit "w"
                II32  -> sLit "l"
                II64  -> sLit "q"
                FF32  -> sLit "ss"      -- "scalar single-precision float" (SSE2)
                FF64  -> sLit "sd"      -- "scalar double-precision float" (SSE2)
                FF80  -> sLit "t"
                )
294

295 296 297
pprSize_x87 :: Size -> Doc
pprSize_x87 x
  = ptext $ case x of
Ian Lynagh's avatar
Ian Lynagh committed
298 299 300
                FF32  -> sLit "s"
                FF64  -> sLit "l"
                FF80  -> sLit "t"
301 302
                _     -> panic "X86.Ppr.pprSize_x87"

303 304 305
pprCond :: Cond -> Doc
pprCond c
 = ptext (case c of {
Ian Lynagh's avatar
Ian Lynagh committed
306 307 308 309 310 311 312 313 314
                GEU     -> sLit "ae";   LU    -> sLit "b";
                EQQ     -> sLit "e";    GTT   -> sLit "g";
                GE      -> sLit "ge";   GU    -> sLit "a";
                LTT     -> sLit "l";    LE    -> sLit "le";
                LEU     -> sLit "be";   NE    -> sLit "ne";
                NEG     -> sLit "s";    POS   -> sLit "ns";
                CARRY   -> sLit "c";   OFLO  -> sLit "o";
                PARITY  -> sLit "p";   NOTPARITY -> sLit "np";
                ALWAYS  -> sLit "mp"})
315 316


317 318 319 320 321 322
pprImm :: Platform -> Imm -> Doc
pprImm _        (ImmInt i)     = int i
pprImm _        (ImmInteger i) = integer i
pprImm platform (ImmCLbl l)    = pprCLabel_asm platform l
pprImm platform (ImmIndex l i) = pprCLabel_asm platform l <> char '+' <> int i
pprImm _        (ImmLit s)     = s
323

324 325
pprImm _        (ImmFloat _)  = ptext (sLit "naughty float immediate")
pprImm _        (ImmDouble _) = ptext (sLit "naughty double immediate")
326

327 328 329
pprImm platform (ImmConstantSum a b) = pprImm platform a <> char '+' <> pprImm platform b
pprImm platform (ImmConstantDiff a b) = pprImm platform a <> char '-'
                                     <> lparen <> pprImm platform b <> rparen
330 331 332



Ian Lynagh's avatar
Ian Lynagh committed
333
pprAddr :: Platform -> AddrMode -> Doc
334 335
pprAddr platform (ImmAddr imm off)
  = let pp_imm = pprImm platform imm
336 337
    in
    if (off == 0) then
Ian Lynagh's avatar
Ian Lynagh committed
338
        pp_imm
339
    else if (off < 0) then
Ian Lynagh's avatar
Ian Lynagh committed
340
        pp_imm <> int off
341
    else
Ian Lynagh's avatar
Ian Lynagh committed
342
        pp_imm <> char '+' <> int off
343

Ian Lynagh's avatar
Ian Lynagh committed
344
pprAddr platform (AddrBaseIndex base index displacement)
345
  = let
Ian Lynagh's avatar
Ian Lynagh committed
346 347
        pp_disp  = ppr_disp displacement
        pp_off p = pp_disp <> char '(' <> p <> char ')'
Ian Lynagh's avatar
Ian Lynagh committed
348
        pp_reg r = pprReg platform (archWordSize (target32Bit platform)) r
349 350 351 352 353 354
    in
    case (base, index) of
      (EABaseNone,  EAIndexNone) -> pp_disp
      (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
      (EABaseRip,   EAIndexNone) -> pp_off (ptext (sLit "%rip"))
      (EABaseNone,  EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
Ian Lynagh's avatar
Ian Lynagh committed
355
      (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
356
                                       <> comma <> int i)
Ian Lynagh's avatar
Ian Lynagh committed
357 358
      _                         -> panic "X86.Ppr.pprAddr: no match"

359 360
  where
    ppr_disp (ImmInt 0) = empty
361
    ppr_disp imm        = pprImm platform imm
362 363


Ian Lynagh's avatar
Ian Lynagh committed
364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410
pprSectionHeader :: Platform -> Section -> Doc
pprSectionHeader platform seg
 = case platformOS platform of
   OSDarwin
    | target32Bit platform ->
       case seg of
           Text                    -> ptext (sLit ".text\n\t.align 2")
           Data                    -> ptext (sLit ".data\n\t.align 2")
           ReadOnlyData            -> ptext (sLit ".const\n.align 2")
           RelocatableReadOnlyData -> ptext (sLit ".const_data\n.align 2")
           UninitialisedData       -> ptext (sLit ".data\n\t.align 2")
           ReadOnlyData16          -> ptext (sLit ".const\n.align 4")
           OtherSection _          -> panic "X86.Ppr.pprSectionHeader: unknown section"
    | otherwise ->
       case seg of
           Text                    -> ptext (sLit ".text\n.align 3")
           Data                    -> ptext (sLit ".data\n.align 3")
           ReadOnlyData            -> ptext (sLit ".const\n.align 3")
           RelocatableReadOnlyData -> ptext (sLit ".const_data\n.align 3")
           UninitialisedData       -> ptext (sLit ".data\n\t.align 3")
           ReadOnlyData16          -> ptext (sLit ".const\n.align 4")
           OtherSection _          -> panic "PprMach.pprSectionHeader: unknown section"
   _
    | target32Bit platform ->
       case seg of
           Text                    -> ptext (sLit ".text\n\t.align 4,0x90")
           Data                    -> ptext (sLit ".data\n\t.align 4")
           ReadOnlyData            -> ptext (sLit ".section .rodata\n\t.align 4")
           RelocatableReadOnlyData -> ptext (sLit ".section .data\n\t.align 4")
           UninitialisedData       -> ptext (sLit ".section .bss\n\t.align 4")
           ReadOnlyData16          -> ptext (sLit ".section .rodata\n\t.align 16")
           OtherSection _          -> panic "X86.Ppr.pprSectionHeader: unknown section"
    | otherwise ->
       case seg of
           Text                    -> ptext (sLit ".text\n\t.align 8")
           Data                    -> ptext (sLit ".data\n\t.align 8")
           ReadOnlyData            -> ptext (sLit ".section .rodata\n\t.align 8")
           RelocatableReadOnlyData -> ptext (sLit ".section .data\n\t.align 8")
           UninitialisedData       -> ptext (sLit ".section .bss\n\t.align 8")
           ReadOnlyData16          -> ptext (sLit ".section .rodata.cst16\n\t.align 16")
           OtherSection _          -> panic "PprMach.pprSectionHeader: unknown section"




pprDataItem :: Platform -> CmmLit -> Doc
pprDataItem platform lit
411 412
  = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
    where
Ian Lynagh's avatar
Ian Lynagh committed
413
        imm = litToImm lit
414

Ian Lynagh's avatar
Ian Lynagh committed
415
        -- These seem to be common:
416 417 418
        ppr_item II8   _ = [ptext (sLit "\t.byte\t") <> pprImm platform imm]
        ppr_item II16  _ = [ptext (sLit "\t.word\t") <> pprImm platform imm]
        ppr_item II32  _ = [ptext (sLit "\t.long\t") <> pprImm platform imm]
419

Ian Lynagh's avatar
Ian Lynagh committed
420
        ppr_item FF32  (CmmFloat r _)
421
           = let bs = floatToBytes (fromRational r)
422
             in  map (\b -> ptext (sLit "\t.byte\t") <> pprImm platform (ImmInt b)) bs
423

Ian Lynagh's avatar
Ian Lynagh committed
424
        ppr_item FF64 (CmmFloat r _)
425
           = let bs = doubleToBytes (fromRational r)
426
             in  map (\b -> ptext (sLit "\t.byte\t") <> pprImm platform (ImmInt b)) bs
427

Ian Lynagh's avatar
Ian Lynagh committed
428 429 430 431 432 433 434 435 436 437 438 439 440
        ppr_item II64 _
            = case platformOS platform of
              OSDarwin
               | target32Bit platform ->
                  case lit of
                  CmmInt x _ ->
                      [ptext (sLit "\t.long\t")
                          <> int (fromIntegral (fromIntegral x :: Word32)),
                       ptext (sLit "\t.long\t")
                          <> int (fromIntegral
                              (fromIntegral (x `shiftR` 32) :: Word32))]
                  _ -> panic "X86.Ppr.ppr_item: no match for II64"
               | otherwise ->
441
                  [ptext (sLit "\t.quad\t") <> pprImm platform imm]
Ian Lynagh's avatar
Ian Lynagh committed
442 443
              _
               | target32Bit platform ->
444
                  [ptext (sLit "\t.quad\t") <> pprImm platform imm]
Ian Lynagh's avatar
Ian Lynagh committed
445 446 447 448 449 450 451 452 453 454 455 456 457 458
               | otherwise ->
                  -- x86_64: binutils can't handle the R_X86_64_PC64
                  -- relocation type, which means we can't do
                  -- pc-relative 64-bit addresses. Fortunately we're
                  -- assuming the small memory model, in which all such
                  -- offsets will fit into 32 bits, so we have to stick
                  -- to 32-bit offset fields and modify the RTS
                  -- appropriately
                  --
                  -- See Note [x86-64-relative] in includes/rts/storage/InfoTables.h
                  --
                  case lit of
                  -- A relative relocation:
                  CmmLabelDiffOff _ _ _ ->
459
                      [ptext (sLit "\t.long\t") <> pprImm platform imm,
Ian Lynagh's avatar
Ian Lynagh committed
460 461
                       ptext (sLit "\t.long\t0")]
                  _ ->
462
                      [ptext (sLit "\t.quad\t") <> pprImm platform imm]
463

Ian Lynagh's avatar
Ian Lynagh committed
464 465
        ppr_item _ _
                = panic "X86.Ppr.ppr_item: no match"
466 467 468



Ian Lynagh's avatar
Ian Lynagh committed
469
pprInstr :: Platform -> Instr -> Doc
470

Ian Lynagh's avatar
Ian Lynagh committed
471
pprInstr _ (COMMENT _) = empty -- nuke 'em
472
{-
Ian Lynagh's avatar
Ian Lynagh committed
473
pprInstr _ (COMMENT s) = ptext (sLit "# ") <> ftext s
474
-}
Ian Lynagh's avatar
Ian Lynagh committed
475 476
pprInstr platform (DELTA d)
   = pprInstr platform (COMMENT (mkFastString ("\tdelta = " ++ show d)))
477

Ian Lynagh's avatar
Ian Lynagh committed
478
pprInstr _ (NEWBLOCK _)
479 480
   = panic "PprMach.pprInstr: NEWBLOCK"

Ian Lynagh's avatar
Ian Lynagh committed
481
pprInstr _ (LDATA _ _)
482 483
   = panic "PprMach.pprInstr: LDATA"

484
{-
Ian Lynagh's avatar
Ian Lynagh committed
485
pprInstr _ (SPILL reg slot)
486
   = hcat [
Ian Lynagh's avatar
Ian Lynagh committed
487 488 489 490 491
        ptext (sLit "\tSPILL"),
        char ' ',
        pprUserReg reg,
        comma,
        ptext (sLit "SLOT") <> parens (int slot)]
492

Ian Lynagh's avatar
Ian Lynagh committed
493
pprInstr _ (RELOAD slot reg)
494
   = hcat [
Ian Lynagh's avatar
Ian Lynagh committed
495 496 497 498 499
        ptext (sLit "\tRELOAD"),
        char ' ',
        ptext (sLit "SLOT") <> parens (int slot),
        comma,
        pprUserReg reg]
500
-}
501

Ian Lynagh's avatar
Ian Lynagh committed
502 503
pprInstr platform (MOV size src dst)
  = pprSizeOpOp platform (sLit "mov") size src dst
504

Ian Lynagh's avatar
Ian Lynagh committed
505
pprInstr platform (MOVZxL II32 src dst) = pprSizeOpOp platform (sLit "mov") II32 src dst
Ian Lynagh's avatar
Ian Lynagh committed
506 507 508 509
        -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
        -- movl.  But we represent it as a MOVZxL instruction, because
        -- the reg alloc would tend to throw away a plain reg-to-reg
        -- move, and we still want it to do that.
510

Ian Lynagh's avatar
Ian Lynagh committed
511
pprInstr platform (MOVZxL sizes src dst) = pprSizeOpOpCoerce platform (sLit "movz") sizes II32 src dst
Ian Lynagh's avatar
Ian Lynagh committed
512 513 514
        -- zero-extension only needs to extend to 32 bits: on x86_64,
        -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
        -- instruction is shorter.
515

Ian Lynagh's avatar
Ian Lynagh committed
516
pprInstr platform (MOVSxL sizes src dst) = pprSizeOpOpCoerce platform (sLit "movs") sizes (archWordSize (target32Bit platform)) src dst
517 518 519

-- here we do some patching, since the physical registers are only set late
-- in the code generation.
Ian Lynagh's avatar
Ian Lynagh committed
520
pprInstr platform (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
521
  | reg1 == reg3
Ian Lynagh's avatar
Ian Lynagh committed
522
  = pprSizeOpOp platform (sLit "add") size (OpReg reg2) dst
523

Ian Lynagh's avatar
Ian Lynagh committed
524
pprInstr platform (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
525
  | reg2 == reg3
Ian Lynagh's avatar
Ian Lynagh committed
526
  = pprSizeOpOp platform (sLit "add") size (OpReg reg1) dst
527

Ian Lynagh's avatar
Ian Lynagh committed
528
pprInstr platform (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
529
  | reg1 == reg3
Ian Lynagh's avatar
Ian Lynagh committed
530
  = pprInstr platform (ADD size (OpImm displ) dst)
531

Ian Lynagh's avatar
Ian Lynagh committed
532
pprInstr platform (LEA size src dst) = pprSizeOpOp platform (sLit "lea") size src dst
533

Ian Lynagh's avatar
Ian Lynagh committed
534 535 536 537 538 539 540 541 542 543
pprInstr platform (ADD size (OpImm (ImmInt (-1))) dst)
  = pprSizeOp platform (sLit "dec") size dst
pprInstr platform (ADD size (OpImm (ImmInt 1)) dst)
  = pprSizeOp platform (sLit "inc") size dst
pprInstr platform (ADD size src dst)
  = pprSizeOpOp platform (sLit "add") size src dst
pprInstr platform (ADC size src dst)
  = pprSizeOpOp platform (sLit "adc") size src dst
pprInstr platform (SUB size src dst) = pprSizeOpOp platform (sLit "sub") size src dst
pprInstr platform (IMUL size op1 op2) = pprSizeOpOp platform (sLit "imul") size op1 op2
544 545 546 547 548 549

{- A hack.  The Intel documentation says that "The two and three
   operand forms [of IMUL] may also be used with unsigned operands
   because the lower half of the product is the same regardless if
   (sic) the operands are signed or unsigned.  The CF and OF flags,
   however, cannot be used to determine if the upper half of the
Ian Lynagh's avatar
Ian Lynagh committed
550 551
   result is non-zero."  So there.
-}
Ian Lynagh's avatar
Ian Lynagh committed
552 553
pprInstr platform (AND size src dst) = pprSizeOpOp platform (sLit "and") size src dst
pprInstr platform (OR  size src dst) = pprSizeOpOp platform (sLit "or")  size src dst
554

Ian Lynagh's avatar
Ian Lynagh committed
555 556 557
pprInstr platform (XOR FF32 src dst) = pprOpOp platform (sLit "xorps") FF32 src dst
pprInstr platform (XOR FF64 src dst) = pprOpOp platform (sLit "xorpd") FF64 src dst
pprInstr platform (XOR size src dst) = pprSizeOpOp platform (sLit "xor")  size src dst
558

tibbe's avatar
tibbe committed
559 560
pprInstr platform (POPCNT size src dst) = pprOpOp platform (sLit "popcnt") size src (OpReg dst)

Ian Lynagh's avatar
Ian Lynagh committed
561 562
pprInstr platform (NOT size op) = pprSizeOp platform (sLit "not") size op
pprInstr platform (NEGI size op) = pprSizeOp platform (sLit "neg") size op
563

Ian Lynagh's avatar
Ian Lynagh committed
564 565 566
pprInstr platform (SHL size src dst) = pprShift platform (sLit "shl") size src dst
pprInstr platform (SAR size src dst) = pprShift platform (sLit "sar") size src dst
pprInstr platform (SHR size src dst) = pprShift platform (sLit "shr") size src dst
567

Ian Lynagh's avatar
Ian Lynagh committed
568
pprInstr platform (BT  size imm src) = pprSizeImmOp platform (sLit "bt") size imm src
569

Ian Lynagh's avatar
Ian Lynagh committed
570 571 572
pprInstr platform (CMP size src dst)
  | is_float size =  pprSizeOpOp platform (sLit "ucomi") size src dst -- SSE2
  | otherwise     =  pprSizeOpOp platform (sLit "cmp")   size src dst
573
  where
Ian Lynagh's avatar
Ian Lynagh committed
574 575 576 577 578
        -- This predicate is needed here and nowhere else
    is_float FF32       = True
    is_float FF64       = True
    is_float FF80       = True
    is_float _          = False
579

Ian Lynagh's avatar
Ian Lynagh committed
580 581 582
pprInstr platform (TEST size src dst) = pprSizeOpOp platform (sLit "test")  size src dst
pprInstr platform (PUSH size op) = pprSizeOp platform (sLit "push") size op
pprInstr platform (POP size op) = pprSizeOp platform (sLit "pop") size op
583 584 585 586 587

-- both unused (SDM):
-- pprInstr PUSHA = ptext (sLit "\tpushal")
-- pprInstr POPA = ptext (sLit "\tpopal")

Ian Lynagh's avatar
Ian Lynagh committed
588 589 590
pprInstr _ NOP = ptext (sLit "\tnop")
pprInstr _ (CLTD II32) = ptext (sLit "\tcltd")
pprInstr _ (CLTD II64) = ptext (sLit "\tcqto")
591

Ian Lynagh's avatar
Ian Lynagh committed
592
pprInstr platform (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand platform II8 op)
593

594 595
pprInstr platform (JXX cond blockid)
  = pprCondInstr (sLit "j") cond (pprCLabel_asm platform lab)
596
  where lab = mkAsmTempLabel (getUnique blockid)
597

598
pprInstr platform (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm platform imm)
599

600
pprInstr platform (JMP (OpImm imm)) = (<>) (ptext (sLit "\tjmp ")) (pprImm platform imm)
Ian Lynagh's avatar
Ian Lynagh committed
601
pprInstr platform (JMP op)          = (<>) (ptext (sLit "\tjmp *")) (pprOperand platform (archWordSize (target32Bit platform)) op)
Ian Lynagh's avatar
Ian Lynagh committed
602
pprInstr platform (JMP_TBL op _ _ _)  = pprInstr platform (JMP op)
603
pprInstr platform (CALL (Left imm) _)    = (<>) (ptext (sLit "\tcall ")) (pprImm platform imm)
Ian Lynagh's avatar
Ian Lynagh committed
604
pprInstr platform (CALL (Right reg) _)   = (<>) (ptext (sLit "\tcall *")) (pprReg platform (archWordSize (target32Bit platform)) reg)
605

Ian Lynagh's avatar
Ian Lynagh committed
606 607 608
pprInstr platform (IDIV sz op)   = pprSizeOp platform (sLit "idiv") sz op
pprInstr platform (DIV sz op)    = pprSizeOp platform (sLit "div")  sz op
pprInstr platform (IMUL2 sz op)  = pprSizeOp platform (sLit "imul") sz op
609 610

-- x86_64 only
Ian Lynagh's avatar
Ian Lynagh committed
611
pprInstr platform (MUL size op1 op2) = pprSizeOpOp platform (sLit "mul") size op1 op2
612
pprInstr platform (MUL2 size op) = pprSizeOp platform (sLit "mul") size op
613

Ian Lynagh's avatar
Ian Lynagh committed
614
pprInstr platform (FDIV size op1 op2) = pprSizeOpOp platform (sLit "div") size op1 op2
615

Ian Lynagh's avatar
Ian Lynagh committed
616 617 618 619 620 621
pprInstr platform (CVTSS2SD from to)      = pprRegReg platform (sLit "cvtss2sd") from to
pprInstr platform (CVTSD2SS from to)      = pprRegReg platform (sLit "cvtsd2ss") from to
pprInstr platform (CVTTSS2SIQ sz from to) = pprSizeSizeOpReg platform (sLit "cvttss2si") FF32 sz from to
pprInstr platform (CVTTSD2SIQ sz from to) = pprSizeSizeOpReg platform (sLit "cvttsd2si") FF64 sz from to
pprInstr platform (CVTSI2SS sz from to)   = pprSizeOpReg platform (sLit "cvtsi2ss") sz from to
pprInstr platform (CVTSI2SD sz from to)   = pprSizeOpReg platform (sLit "cvtsi2sd") sz from to
622 623

    -- FETCHGOT for PIC on ELF platforms
Ian Lynagh's avatar
Ian Lynagh committed
624
pprInstr platform (FETCHGOT reg)
625
   = vcat [ ptext (sLit "\tcall 1f"),
Ian Lynagh's avatar
Ian Lynagh committed
626
            hcat [ ptext (sLit "1:\tpopl\t"), pprReg platform II32 reg ],
627
            hcat [ ptext (sLit "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
Ian Lynagh's avatar
Ian Lynagh committed
628
                   pprReg platform II32 reg ]
629 630 631 632 633 634
          ]

    -- FETCHPC for PIC on Darwin/x86
    -- get the instruction pointer into a register
    -- (Terminology note: the IP is called Program Counter on PPC,
    --  and it's a good thing to use the same name on both platforms)
Ian Lynagh's avatar
Ian Lynagh committed
635
pprInstr platform (FETCHPC reg)
636
   = vcat [ ptext (sLit "\tcall 1f"),
Ian Lynagh's avatar
Ian Lynagh committed
637
            hcat [ ptext (sLit "1:\tpopl\t"), pprReg platform II32 reg ]
638 639 640 641 642 643 644 645 646
          ]


-- -----------------------------------------------------------------------------
-- i386 floating-point

-- Simulating a flat register set on the x86 FP stack is tricky.
-- you have to free %st(7) before pushing anything on the FP reg stack
-- so as to preclude the possibility of a FP stack overflow exception.
Ian Lynagh's avatar
Ian Lynagh committed
647
pprInstr platform g@(GMOV src dst)
648 649
   | src == dst
   = empty
Ian Lynagh's avatar
Ian Lynagh committed
650
   | otherwise
Ian Lynagh's avatar
Ian Lynagh committed
651
   = pprG platform g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
652

653
-- GLD sz addr dst ==> FLDsz addr ; FSTP (dst+1)
Ian Lynagh's avatar
Ian Lynagh committed
654 655 656
pprInstr platform g@(GLD sz addr dst)
 = pprG platform g (hcat [gtab, text "fld", pprSize_x87 sz, gsp,
                          pprAddr platform addr, gsemi, gpop dst 1])
657

658
-- GST sz src addr ==> FLD dst ; FSTPsz addr
Ian Lynagh's avatar
Ian Lynagh committed
659
pprInstr platform g@(GST sz src addr)
660
 | src == fake0 && sz /= FF80 -- fstt instruction doesn't exist
Ian Lynagh's avatar
Ian Lynagh committed
661 662
 = pprG platform g (hcat [gtab,
                          text "fst", pprSize_x87 sz, gsp, pprAddr platform addr])
663
 | otherwise
Ian Lynagh's avatar
Ian Lynagh committed
664 665
 = pprG platform g (hcat [gtab, gpush src 0, gsemi,
                          text "fstp", pprSize_x87 sz, gsp, pprAddr platform addr])
666

Ian Lynagh's avatar
Ian Lynagh committed
667 668 669 670
pprInstr platform g@(GLDZ dst)
 = pprG platform g (hcat [gtab, text "fldz ; ", gpop dst 1])
pprInstr platform g@(GLD1 dst)
 = pprG platform g (hcat [gtab, text "fld1 ; ", gpop dst 1])
671

Ian Lynagh's avatar
Ian Lynagh committed
672 673
pprInstr platform (GFTOI src dst)
   = pprInstr platform (GDTOI src dst)
674

Ian Lynagh's avatar
Ian Lynagh committed
675 676
pprInstr platform g@(GDTOI src dst)
   = pprG platform g (vcat [
677 678 679 680 681 682 683 684 685 686
         hcat [gtab, text "subl $8, %esp ; fnstcw 4(%esp)"],
         hcat [gtab, gpush src 0],
         hcat [gtab, text "movzwl 4(%esp), ", reg,
                     text " ; orl $0xC00, ", reg],
         hcat [gtab, text "movl ", reg, text ", 0(%esp) ; fldcw 0(%esp)"],
         hcat [gtab, text "fistpl 0(%esp)"],
         hcat [gtab, text "fldcw 4(%esp) ; movl 0(%esp), ", reg],
         hcat [gtab, text "addl $8, %esp"]
     ])
   where
Ian Lynagh's avatar
Ian Lynagh committed
687
     reg = pprReg platform II32 dst
688

Ian Lynagh's avatar
Ian Lynagh committed
689 690
pprInstr platform (GITOF src dst)
   = pprInstr platform (GITOD src dst)
691

Ian Lynagh's avatar
Ian Lynagh committed
692 693 694 695
pprInstr platform g@(GITOD src dst)
   = pprG platform g (hcat [gtab, text "pushl ", pprReg platform II32 src,
                            text " ; fildl (%esp) ; ",
                            gpop dst 1, text " ; addl $4,%esp"])
696

Ian Lynagh's avatar
Ian Lynagh committed
697 698 699 700
pprInstr platform g@(GDTOF src dst)
  = pprG platform g (vcat [gtab <> gpush src 0,
                           gtab <> text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ;",
                           gtab <> gpop dst 1])
701

702 703 704 705 706 707 708 709 710 711 712 713 714
{- Gruesome swamp follows.  If you're unfortunate enough to have ventured
   this far into the jungle AND you give a Rat's Ass (tm) what's going
   on, here's the deal.  Generate code to do a floating point comparison
   of src1 and src2, of kind cond, and set the Zero flag if true.

   The complications are to do with handling NaNs correctly.  We want the
   property that if either argument is NaN, then the result of the
   comparison is False ... except if we're comparing for inequality,
   in which case the answer is True.

   Here's how the general (non-inequality) case works.  As an
   example, consider generating the an equality test:

Ian Lynagh's avatar
Ian Lynagh committed
715
     pushl %eax         -- we need to mess with this
716 717
     <get src1 to top of FPU stack>
     fcomp <src2 location in FPU stack> and pop pushed src1
Ian Lynagh's avatar
Ian Lynagh committed
718 719 720 721
                -- Result of comparison is in FPU Status Register bits
                -- C3 C2 and C0
     fstsw %ax  -- Move FPU Status Reg to %ax
     sahf       -- move C3 C2 C0 from %ax to integer flag reg
722
     -- now the serious magic begins
Ian Lynagh's avatar
Ian Lynagh committed
723
     setpo %ah     -- %ah = if comparable(neither arg was NaN) then 1 else 0
724 725 726
     sete  %al     -- %al = if arg1 == arg2 then 1 else 0
     andb %ah,%al  -- %al &= %ah
                   -- so %al == 1 iff (comparable && same); else it holds 0
Ian Lynagh's avatar
Ian Lynagh committed
727
     decb %al      -- %al == 0, ZeroFlag=1  iff (comparable && same);
728 729 730 731 732 733 734 735 736 737 738 739
                      else %al == 0xFF, ZeroFlag=0
     -- the zero flag is now set as we desire.
     popl %eax

   The special case of inequality differs thusly:

     setpe %ah     -- %ah = if incomparable(either arg was NaN) then 1 else 0
     setne %al     -- %al = if arg1 /= arg2 then 1 else 0
     orb %ah,%al   -- %al = if (incomparable || different) then 1 else 0
     decb %al      -- if (incomparable || different) then (%al == 0, ZF=1)
                                                     else (%al == 0xFF, ZF=0)
-}
Ian Lynagh's avatar
Ian Lynagh committed
740
pprInstr platform g@(GCMP cond src1 src2)
741
   | case cond of { NE -> True; _ -> False }
Ian Lynagh's avatar
Ian Lynagh committed
742
   = pprG platform g (vcat [
743
        hcat [gtab, text "pushl %eax ; ",gpush src1 0],
Ian Lynagh's avatar
Ian Lynagh committed
744
        hcat [gtab, text "fcomp ", greg src2 1,
745 746 747 748 749
                    text "; fstsw %ax ; sahf ;  setpe %ah"],
        hcat [gtab, text "setne %al ;  ",
              text "orb %ah,%al ;  decb %al ;  popl %eax"]
    ])
   | otherwise
Ian Lynagh's avatar
Ian Lynagh committed
750
   = pprG platform g (vcat [
751
        hcat [gtab, text "pushl %eax ; ",gpush src1 0],
Ian Lynagh's avatar
Ian Lynagh committed
752
        hcat [gtab, text "fcomp ", greg src2 1,
753 754 755 756 757 758 759 760 761 762 763 764 765 766 767
                    text "; fstsw %ax ; sahf ;  setpo %ah"],
        hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ;  ",
              text "andb %ah,%al ;  decb %al ;  popl %eax"]
    ])
    where
        {- On the 486, the flags set by FP compare are the unsigned ones!
           (This looks like a HACK to me.  WDP 96/03)
        -}
        fix_FP_cond :: Cond -> Cond
        fix_FP_cond GE   = GEU
        fix_FP_cond GTT  = GU
        fix_FP_cond LTT  = LU
        fix_FP_cond LE   = LEU
        fix_FP_cond EQQ  = EQQ
        fix_FP_cond NE   = NE
Ian Lynagh's avatar
Ian Lynagh committed
768
        fix_FP_cond _    = panic "X86.Ppr.fix_FP_cond: no match"
769 770 771
        -- there should be no others


Ian Lynagh's avatar
Ian Lynagh committed
772 773
pprInstr platform g@(GABS _ src dst)
   = pprG platform g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
774

Ian Lynagh's avatar
Ian Lynagh committed
775 776
pprInstr platform g@(GNEG _ src dst)
   = pprG platform g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
777

Ian Lynagh's avatar
Ian Lynagh committed
778 779 780
pprInstr platform g@(GSQRT sz src dst)
   = pprG platform g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
                      hcat [gtab, gcoerceto sz, gpop dst 1])
781

Ian Lynagh's avatar
Ian Lynagh committed
782
pprInstr platform g@(GSIN sz l1 l2 src dst)
783
   = pprG platform g (pprTrigOp platform "fsin" False l1 l2 src dst sz)
784

Ian Lynagh's avatar
Ian Lynagh committed
785
pprInstr platform g@(GCOS sz l1 l2 src dst)
786
   = pprG platform g (pprTrigOp platform "fcos" False l1 l2 src dst sz)
787

Ian Lynagh's avatar
Ian Lynagh committed
788
pprInstr platform g@(GTAN sz l1 l2 src dst)
789
   = pprG platform g (pprTrigOp platform "fptan" True l1 l2 src dst sz)
790 791 792 793 794

-- In the translations for GADD, GMUL, GSUB and GDIV,
-- the first two cases are mere optimisations.  The otherwise clause
-- generates correct code under all circumstances.

Ian Lynagh's avatar
Ian Lynagh committed
795
pprInstr platform g@(GADD _ src1 src2 dst)
796
   | src1 == dst
Ian Lynagh's avatar
Ian Lynagh committed
797 798 799
   = pprG platform g (text "\t#GADD-xxxcase1" $$
                      hcat [gtab, gpush src2 0,
                            text " ; faddp %st(0),", greg src1 1])
800
   | src2 == dst
Ian Lynagh's avatar
Ian Lynagh committed
801 802 803
   = pprG platform g (text "\t#GADD-xxxcase2" $$
                      hcat [gtab, gpush src1 0,
                            text " ; faddp %st(0),", greg src2 1])
804
   | otherwise
Ian Lynagh's avatar
Ian Lynagh committed
805 806 807
   = pprG platform g (hcat [gtab, gpush src1 0,
                            text " ; fadd ", greg src2 1, text ",%st(0)",
                            gsemi, gpop dst 1])
808 809


Ian Lynagh's avatar
Ian Lynagh committed
810
pprInstr platform g@(GMUL _ src1 src2 dst)
811
   | src1 == dst
Ian Lynagh's avatar
Ian Lynagh committed
812 813 814
   = pprG platform g (text "\t#GMUL-xxxcase1" $$
                      hcat [gtab, gpush src2 0,
                            text " ; fmulp %st(0),", greg src1 1])
815
   | src2 == dst
Ian Lynagh's avatar
Ian Lynagh committed
816 817 818
   = pprG platform g (text "\t#GMUL-xxxcase2" $$
                      hcat [gtab, gpush src1 0,
                            text " ; fmulp %st(0),", greg src2 1])
819
   | otherwise
Ian Lynagh's avatar
Ian Lynagh committed
820 821 822
   = pprG platform g (hcat [gtab, gpush src1 0,
                            text " ; fmul ", greg src2 1, text ",%st(0)",
                            gsemi, gpop dst 1])
823 824


Ian Lynagh's avatar
Ian Lynagh committed
825
pprInstr platform g@(GSUB _ src1 src2 dst)
826
   | src1 == dst
Ian Lynagh's avatar
Ian Lynagh committed
827 828 829
   = pprG platform g (text "\t#GSUB-xxxcase1" $$
                      hcat [gtab, gpush src2 0,
                            text " ; fsubrp %st(0),", greg src1 1])
830
   | src2 == dst
Ian Lynagh's avatar
Ian Lynagh committed
831 832 833
   = pprG platform g (text "\t#GSUB-xxxcase2" $$
                      hcat [gtab, gpush src1 0,
                            text " ; fsubp %st(0),", greg src2 1])
834
   | otherwise
Ian Lynagh's avatar
Ian Lynagh committed
835 836 837
   = pprG platform g (hcat [gtab, gpush src1 0,
                            text " ; fsub ", greg src2 1, text ",%st(0)",
                            gsemi, gpop dst 1])