compiler/nativeGen/PprMach.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Pretty-printing assembly language
   4 --
   5 -- (c) The University of Glasgow 1993-2005
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 -- We start with the @pprXXX@s with some cross-platform commonality
  10 -- (e.g., 'pprReg'); we conclude with the no-commonality monster,
  11 -- 'pprInstr'.
  12
  13 #include "nativeGen/NCG.h"
  14
  15 module PprMach (
  16         pprNatCmmTop, pprBasicBlock,
  17         pprInstr, pprSize, pprUserReg,
  18   ) where
  19
  20
  21 #include "HsVersions.h"
  22
  23 import Cmm
  24 import MachOp           ( MachRep(..), wordRep, isFloatingRep )
  25 import MachRegs         -- may differ per-platform
  26 import MachInstrs
  27
  28 import CLabel           ( CLabel, pprCLabel, externallyVisibleCLabel,
  29                           labelDynamic, mkAsmTempLabel, entryLblToInfoLbl )
  30 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
  31 import CLabel       ( mkDeadStripPreventer )
  32 #endif
  33
  34 import Panic            ( panic )
  35 import Unique           ( pprUnique )
  36 import Pretty
  37 import FastString
  38 import qualified Outputable
  39
  40 import Data.Array.ST
  41 import Data.Word        ( Word8 )
  42 import Control.Monad.ST
  43 import Data.Char        ( chr, ord )
  44 import Data.Maybe       ( isJust )
  45
  46 #if powerpc_TARGET_ARCH || darwin_TARGET_OS
  47 import Data.Word(Word32)
  48 import Data.Bits
  49 #endif
  50
  51 -- -----------------------------------------------------------------------------
  52 -- Printing this stuff out
  53
  54 asmSDoc d = Outputable.withPprStyleDoc (
  55               Outputable.mkCodeStyle Outputable.AsmStyle) d
  56 pprCLabel_asm l = asmSDoc (pprCLabel l)
  57
  58 pprNatCmmTop :: NatCmmTop -> Doc
  59 pprNatCmmTop (CmmData section dats) =
  60   pprSectionHeader section $$ vcat (map pprData dats)
  61
  62  -- special case for split markers:
  63 pprNatCmmTop (CmmProc [] lbl _ []) = pprLabel lbl
  64
  65 pprNatCmmTop (CmmProc info lbl params blocks) =
  66   pprSectionHeader Text $$
  67   (if not (null info)
  68         then
  69 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
  70             pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
  71                 <> char ':' $$
  72 #endif
  73             vcat (map pprData info) $$
  74             pprLabel (entryLblToInfoLbl lbl)
  75         else empty) $$
  76   (case blocks of
  77         [] -> empty
  78         (BasicBlock _ instrs : rest) ->
  79                 (if null info then pprLabel lbl else empty) $$
  80                 -- the first block doesn't get a label:
  81                 vcat (map pprInstr instrs) $$
  82                 vcat (map pprBasicBlock rest)
  83   )
  84 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
  85         -- If we are using the .subsections_via_symbols directive
  86         -- (available on recent versions of Darwin),
  87         -- we have to make sure that there is some kind of reference
  88         -- from the entry code to a label on the _top_ of of the info table,
  89         -- so that the linker will not think it is unreferenced and dead-strip
  90         -- it. That's why the label is called a DeadStripPreventer (_dsp).
  91   $$ if not (null info)
  92                     then text "\t.long "
  93                       <+> pprCLabel_asm (entryLblToInfoLbl lbl)
  94                       <+> char '-'
  95                       <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
  96                     else empty
  97 #endif
  98
  99
 100 pprBasicBlock :: NatBasicBlock -> Doc
 101 pprBasicBlock (BasicBlock (BlockId id) instrs) =
 102   pprLabel (mkAsmTempLabel id) $$
 103   vcat (map pprInstr instrs)
 104
 105 -- -----------------------------------------------------------------------------
 106 -- pprReg: print a 'Reg'
 107
 108 -- For x86, the way we print a register name depends
 109 -- on which bit of it we care about.  Yurgh.
 110
 111 pprUserReg :: Reg -> Doc
 112 pprUserReg = pprReg IF_ARCH_i386(I32,) IF_ARCH_x86_64(I64,)
 113
 114 pprReg :: IF_ARCH_i386(MachRep ->,) IF_ARCH_x86_64(MachRep ->,) Reg -> Doc
 115
 116 pprReg IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) r
 117   = case r of
 118       RealReg i      -> ppr_reg_no IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) i
 119       VirtualRegI  u  -> text "%vI_" <> asmSDoc (pprUnique u)
 120       VirtualRegHi u  -> text "%vHi_" <> asmSDoc (pprUnique u)
 121       VirtualRegF  u  -> text "%vF_" <> asmSDoc (pprUnique u)
 122       VirtualRegD  u  -> text "%vD_" <> asmSDoc (pprUnique u)
 123   where
 124 #if alpha_TARGET_ARCH
 125     ppr_reg_no :: Int -> Doc
 126     ppr_reg_no i = ptext
 127       (case i of {
 128          0 -> SLIT("$0");    1 -> SLIT("$1");
 129          2 -> SLIT("$2");    3 -> SLIT("$3");
 130          4 -> SLIT("$4");    5 -> SLIT("$5");
 131          6 -> SLIT("$6");    7 -> SLIT("$7");
 132          8 -> SLIT("$8");    9 -> SLIT("$9");
 133         10 -> SLIT("$10");  11 -> SLIT("$11");
 134         12 -> SLIT("$12");  13 -> SLIT("$13");
 135         14 -> SLIT("$14");  15 -> SLIT("$15");
 136         16 -> SLIT("$16");  17 -> SLIT("$17");
 137         18 -> SLIT("$18");  19 -> SLIT("$19");
 138         20 -> SLIT("$20");  21 -> SLIT("$21");
 139         22 -> SLIT("$22");  23 -> SLIT("$23");
 140         24 -> SLIT("$24");  25 -> SLIT("$25");
 141         26 -> SLIT("$26");  27 -> SLIT("$27");
 142         28 -> SLIT("$28");  29 -> SLIT("$29");
 143         30 -> SLIT("$30");  31 -> SLIT("$31");
 144         32 -> SLIT("$f0");  33 -> SLIT("$f1");
 145         34 -> SLIT("$f2");  35 -> SLIT("$f3");
 146         36 -> SLIT("$f4");  37 -> SLIT("$f5");
 147         38 -> SLIT("$f6");  39 -> SLIT("$f7");
 148         40 -> SLIT("$f8");  41 -> SLIT("$f9");
 149         42 -> SLIT("$f10"); 43 -> SLIT("$f11");
 150         44 -> SLIT("$f12"); 45 -> SLIT("$f13");
 151         46 -> SLIT("$f14"); 47 -> SLIT("$f15");
 152         48 -> SLIT("$f16"); 49 -> SLIT("$f17");
 153         50 -> SLIT("$f18"); 51 -> SLIT("$f19");
 154         52 -> SLIT("$f20"); 53 -> SLIT("$f21");
 155         54 -> SLIT("$f22"); 55 -> SLIT("$f23");
 156         56 -> SLIT("$f24"); 57 -> SLIT("$f25");
 157         58 -> SLIT("$f26"); 59 -> SLIT("$f27");
 158         60 -> SLIT("$f28"); 61 -> SLIT("$f29");
 159         62 -> SLIT("$f30"); 63 -> SLIT("$f31");
 160         _  -> SLIT("very naughty alpha register")
 161       })
 162 #endif
 163 #if i386_TARGET_ARCH
 164     ppr_reg_no :: MachRep -> Int -> Doc
 165     ppr_reg_no I8   = ppr_reg_byte
 166     ppr_reg_no I16  = ppr_reg_word
 167     ppr_reg_no _    = ppr_reg_long
 168
 169     ppr_reg_byte i = ptext
 170       (case i of {
 171          0 -> SLIT("%al");     1 -> SLIT("%bl");
 172          2 -> SLIT("%cl");     3 -> SLIT("%dl");
 173         _  -> SLIT("very naughty I386 byte register")
 174       })
 175
 176     ppr_reg_word i = ptext
 177       (case i of {
 178          0 -> SLIT("%ax");     1 -> SLIT("%bx");
 179          2 -> SLIT("%cx");     3 -> SLIT("%dx");
 180          4 -> SLIT("%si");     5 -> SLIT("%di");
 181          6 -> SLIT("%bp");     7 -> SLIT("%sp");
 182         _  -> SLIT("very naughty I386 word register")
 183       })
 184
 185     ppr_reg_long i = ptext
 186       (case i of {
 187          0 -> SLIT("%eax");    1 -> SLIT("%ebx");
 188          2 -> SLIT("%ecx");    3 -> SLIT("%edx");
 189          4 -> SLIT("%esi");    5 -> SLIT("%edi");
 190          6 -> SLIT("%ebp");    7 -> SLIT("%esp");
 191          8 -> SLIT("%fake0");  9 -> SLIT("%fake1");
 192         10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
 193         12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
 194         _  -> SLIT("very naughty I386 register")
 195       })
 196 #endif
 197
 198 #if x86_64_TARGET_ARCH
 199     ppr_reg_no :: MachRep -> Int -> Doc
 200     ppr_reg_no I8   = ppr_reg_byte
 201     ppr_reg_no I16  = ppr_reg_word
 202     ppr_reg_no I32  = ppr_reg_long
 203     ppr_reg_no _    = ppr_reg_quad
 204
 205     ppr_reg_byte i = ptext
 206       (case i of {
 207          0 -> SLIT("%al");     1 -> SLIT("%bl");
 208          2 -> SLIT("%cl");     3 -> SLIT("%dl");
 209          4 -> SLIT("%sil");    5 -> SLIT("%dil"); -- new 8-bit regs!
 210          6 -> SLIT("%bpl");    7 -> SLIT("%spl");
 211          8 -> SLIT("%r8b");    9  -> SLIT("%r9b");
 212         10 -> SLIT("%r10b");   11 -> SLIT("%r11b");
 213         12 -> SLIT("%r12b");   13 -> SLIT("%r13b");
 214         14 -> SLIT("%r14b");   15 -> SLIT("%r15b");
 215         _  -> SLIT("very naughty x86_64 byte register")
 216       })
 217
 218     ppr_reg_word i = ptext
 219       (case i of {
 220          0 -> SLIT("%ax");     1 -> SLIT("%bx");
 221          2 -> SLIT("%cx");     3 -> SLIT("%dx");
 222          4 -> SLIT("%si");     5 -> SLIT("%di");
 223          6 -> SLIT("%bp");     7 -> SLIT("%sp");
 224          8 -> SLIT("%r8w");    9  -> SLIT("%r9w");
 225         10 -> SLIT("%r10w");   11 -> SLIT("%r11w");
 226         12 -> SLIT("%r12w");   13 -> SLIT("%r13w");
 227         14 -> SLIT("%r14w");   15 -> SLIT("%r15w");
 228         _  -> SLIT("very naughty x86_64 word register")
 229       })
 230
 231     ppr_reg_long i = ptext
 232       (case i of {
 233          0 -> SLIT("%eax");    1  -> SLIT("%ebx");
 234          2 -> SLIT("%ecx");    3  -> SLIT("%edx");
 235          4 -> SLIT("%esi");    5  -> SLIT("%edi");
 236          6 -> SLIT("%ebp");    7  -> SLIT("%esp");
 237          8 -> SLIT("%r8d");    9  -> SLIT("%r9d");
 238         10 -> SLIT("%r10d");   11 -> SLIT("%r11d");
 239         12 -> SLIT("%r12d");   13 -> SLIT("%r13d");
 240         14 -> SLIT("%r14d");   15 -> SLIT("%r15d");
 241         _  -> SLIT("very naughty x86_64 register")
 242       })
 243
 244     ppr_reg_quad i = ptext
 245       (case i of {
 246          0 -> SLIT("%rax");     1 -> SLIT("%rbx");
 247          2 -> SLIT("%rcx");     3 -> SLIT("%rdx");
 248          4 -> SLIT("%rsi");     5 -> SLIT("%rdi");
 249          6 -> SLIT("%rbp");     7 -> SLIT("%rsp");
 250          8 -> SLIT("%r8");      9 -> SLIT("%r9");
 251         10 -> SLIT("%r10");    11 -> SLIT("%r11");
 252         12 -> SLIT("%r12");    13 -> SLIT("%r13");
 253         14 -> SLIT("%r14");    15 -> SLIT("%r15");
 254         16 -> SLIT("%xmm0");   17 -> SLIT("%xmm1");
 255         18 -> SLIT("%xmm2");   19 -> SLIT("%xmm3");
 256         20 -> SLIT("%xmm4");   21 -> SLIT("%xmm5");
 257         22 -> SLIT("%xmm6");   23 -> SLIT("%xmm7");
 258         24 -> SLIT("%xmm8");   25 -> SLIT("%xmm9");
 259         26 -> SLIT("%xmm10");  27 -> SLIT("%xmm11");
 260         28 -> SLIT("%xmm12");  29 -> SLIT("%xmm13");
 261         30 -> SLIT("%xmm14");  31 -> SLIT("%xmm15");
 262         _  -> SLIT("very naughty x86_64 register")
 263       })
 264 #endif
 265
 266 #if sparc_TARGET_ARCH
 267     ppr_reg_no :: Int -> Doc
 268     ppr_reg_no i = ptext
 269       (case i of {
 270          0 -> SLIT("%g0");   1 -> SLIT("%g1");
 271          2 -> SLIT("%g2");   3 -> SLIT("%g3");
 272          4 -> SLIT("%g4");   5 -> SLIT("%g5");
 273          6 -> SLIT("%g6");   7 -> SLIT("%g7");
 274          8 -> SLIT("%o0");   9 -> SLIT("%o1");
 275         10 -> SLIT("%o2");  11 -> SLIT("%o3");
 276         12 -> SLIT("%o4");  13 -> SLIT("%o5");
 277         14 -> SLIT("%o6");  15 -> SLIT("%o7");
 278         16 -> SLIT("%l0");  17 -> SLIT("%l1");
 279         18 -> SLIT("%l2");  19 -> SLIT("%l3");
 280         20 -> SLIT("%l4");  21 -> SLIT("%l5");
 281         22 -> SLIT("%l6");  23 -> SLIT("%l7");
 282         24 -> SLIT("%i0");  25 -> SLIT("%i1");
 283         26 -> SLIT("%i2");  27 -> SLIT("%i3");
 284         28 -> SLIT("%i4");  29 -> SLIT("%i5");
 285         30 -> SLIT("%i6");  31 -> SLIT("%i7");
 286         32 -> SLIT("%f0");  33 -> SLIT("%f1");
 287         34 -> SLIT("%f2");  35 -> SLIT("%f3");
 288         36 -> SLIT("%f4");  37 -> SLIT("%f5");
 289         38 -> SLIT("%f6");  39 -> SLIT("%f7");
 290         40 -> SLIT("%f8");  41 -> SLIT("%f9");
 291         42 -> SLIT("%f10"); 43 -> SLIT("%f11");
 292         44 -> SLIT("%f12"); 45 -> SLIT("%f13");
 293         46 -> SLIT("%f14"); 47 -> SLIT("%f15");
 294         48 -> SLIT("%f16"); 49 -> SLIT("%f17");
 295         50 -> SLIT("%f18"); 51 -> SLIT("%f19");
 296         52 -> SLIT("%f20"); 53 -> SLIT("%f21");
 297         54 -> SLIT("%f22"); 55 -> SLIT("%f23");
 298         56 -> SLIT("%f24"); 57 -> SLIT("%f25");
 299         58 -> SLIT("%f26"); 59 -> SLIT("%f27");
 300         60 -> SLIT("%f28"); 61 -> SLIT("%f29");
 301         62 -> SLIT("%f30"); 63 -> SLIT("%f31");
 302         _  -> SLIT("very naughty sparc register")
 303       })
 304 #endif
 305 #if powerpc_TARGET_ARCH
 306 #if darwin_TARGET_OS
 307     ppr_reg_no :: Int -> Doc
 308     ppr_reg_no i = ptext
 309       (case i of {
 310          0 -> SLIT("r0");   1 -> SLIT("r1");
 311          2 -> SLIT("r2");   3 -> SLIT("r3");
 312          4 -> SLIT("r4");   5 -> SLIT("r5");
 313          6 -> SLIT("r6");   7 -> SLIT("r7");
 314          8 -> SLIT("r8");   9 -> SLIT("r9");
 315         10 -> SLIT("r10");  11 -> SLIT("r11");
 316         12 -> SLIT("r12");  13 -> SLIT("r13");
 317         14 -> SLIT("r14");  15 -> SLIT("r15");
 318         16 -> SLIT("r16");  17 -> SLIT("r17");
 319         18 -> SLIT("r18");  19 -> SLIT("r19");
 320         20 -> SLIT("r20");  21 -> SLIT("r21");
 321         22 -> SLIT("r22");  23 -> SLIT("r23");
 322         24 -> SLIT("r24");  25 -> SLIT("r25");
 323         26 -> SLIT("r26");  27 -> SLIT("r27");
 324         28 -> SLIT("r28");  29 -> SLIT("r29");
 325         30 -> SLIT("r30");  31 -> SLIT("r31");
 326         32 -> SLIT("f0");  33 -> SLIT("f1");
 327         34 -> SLIT("f2");  35 -> SLIT("f3");
 328         36 -> SLIT("f4");  37 -> SLIT("f5");
 329         38 -> SLIT("f6");  39 -> SLIT("f7");
 330         40 -> SLIT("f8");  41 -> SLIT("f9");
 331         42 -> SLIT("f10"); 43 -> SLIT("f11");
 332         44 -> SLIT("f12"); 45 -> SLIT("f13");
 333         46 -> SLIT("f14"); 47 -> SLIT("f15");
 334         48 -> SLIT("f16"); 49 -> SLIT("f17");
 335         50 -> SLIT("f18"); 51 -> SLIT("f19");
 336         52 -> SLIT("f20"); 53 -> SLIT("f21");
 337         54 -> SLIT("f22"); 55 -> SLIT("f23");
 338         56 -> SLIT("f24"); 57 -> SLIT("f25");
 339         58 -> SLIT("f26"); 59 -> SLIT("f27");
 340         60 -> SLIT("f28"); 61 -> SLIT("f29");
 341         62 -> SLIT("f30"); 63 -> SLIT("f31");
 342         _  -> SLIT("very naughty powerpc register")
 343       })
 344 #else
 345     ppr_reg_no :: Int -> Doc
 346     ppr_reg_no i | i <= 31 = int i      -- GPRs
 347                  | i <= 63 = int (i-32) -- FPRs
 348                  | otherwise = ptext SLIT("very naughty powerpc register")
 349 #endif
 350 #endif
 351
 352
 353 -- -----------------------------------------------------------------------------
 354 -- pprSize: print a 'Size'
 355
 356 #if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
 357 pprSize :: MachRep -> Doc
 358 #else
 359 pprSize :: Size -> Doc
 360 #endif
 361
 362 pprSize x = ptext (case x of
 363 #if alpha_TARGET_ARCH
 364          B  -> SLIT("b")
 365          Bu -> SLIT("bu")
 366 --       W  -> SLIT("w") UNUSED
 367 --       Wu -> SLIT("wu") UNUSED
 368          L  -> SLIT("l")
 369          Q  -> SLIT("q")
 370 --       FF -> SLIT("f") UNUSED
 371 --       DF -> SLIT("d") UNUSED
 372 --       GF -> SLIT("g") UNUSED
 373 --       SF -> SLIT("s") UNUSED
 374          TF -> SLIT("t")
 375 #endif
 376 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 377         I8   -> SLIT("b")
 378         I16  -> SLIT("w")
 379         I32  -> SLIT("l")
 380         I64  -> SLIT("q")
 381 #endif
 382 #if i386_TARGET_ARCH
 383         F32  -> SLIT("s")
 384         F64  -> SLIT("l")
 385         F80  -> SLIT("t")
 386 #endif
 387 #if x86_64_TARGET_ARCH
 388         F32  -> SLIT("ss")      -- "scalar single-precision float" (SSE2)
 389         F64  -> SLIT("sd")      -- "scalar double-precision float" (SSE2)
 390 #endif
 391 #if sparc_TARGET_ARCH
 392         I8   -> SLIT("sb")
 393         I16   -> SLIT("sh")
 394         I32   -> SLIT("")
 395         F32   -> SLIT("")
 396         F64  -> SLIT("d")
 397     )
 398 pprStSize :: MachRep -> Doc
 399 pprStSize x = ptext (case x of
 400         I8   -> SLIT("b")
 401         I16  -> SLIT("h")
 402         I32  -> SLIT("")
 403         F32  -> SLIT("")
 404         F64  -> SLIT("d")
 405 #endif
 406 #if powerpc_TARGET_ARCH
 407         I8   -> SLIT("b")
 408         I16  -> SLIT("h")
 409         I32  -> SLIT("w")
 410         F32  -> SLIT("fs")
 411         F64  -> SLIT("fd")
 412 #endif
 413     )
 414
 415 -- -----------------------------------------------------------------------------
 416 -- pprCond: print a 'Cond'
 417
 418 pprCond :: Cond -> Doc
 419
 420 pprCond c = ptext (case c of {
 421 #if alpha_TARGET_ARCH
 422         EQQ  -> SLIT("eq");
 423         LTT  -> SLIT("lt");
 424         LE  -> SLIT("le");
 425         ULT -> SLIT("ult");
 426         ULE -> SLIT("ule");
 427         NE  -> SLIT("ne");
 428         GTT  -> SLIT("gt");
 429         GE  -> SLIT("ge")
 430 #endif
 431 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 432         GEU     -> SLIT("ae");  LU    -> SLIT("b");
 433         EQQ     -> SLIT("e");   GTT   -> SLIT("g");
 434         GE      -> SLIT("ge");  GU    -> SLIT("a");
 435         LTT     -> SLIT("l");   LE    -> SLIT("le");
 436         LEU     -> SLIT("be");  NE    -> SLIT("ne");
 437         NEG     -> SLIT("s");   POS   -> SLIT("ns");
 438         CARRY   -> SLIT("c");   OFLO  -> SLIT("o");
 439         PARITY  -> SLIT("p");   NOTPARITY -> SLIT("np");
 440         ALWAYS  -> SLIT("mp")   -- hack
 441 #endif
 442 #if sparc_TARGET_ARCH
 443         ALWAYS  -> SLIT("");    NEVER -> SLIT("n");
 444         GEU     -> SLIT("geu"); LU    -> SLIT("lu");
 445         EQQ     -> SLIT("e");   GTT   -> SLIT("g");
 446         GE      -> SLIT("ge");  GU    -> SLIT("gu");
 447         LTT     -> SLIT("l");   LE    -> SLIT("le");
 448         LEU     -> SLIT("leu"); NE    -> SLIT("ne");
 449         NEG     -> SLIT("neg"); POS   -> SLIT("pos");
 450         VC      -> SLIT("vc");  VS    -> SLIT("vs")
 451 #endif
 452 #if powerpc_TARGET_ARCH
 453         ALWAYS  -> SLIT("");
 454         EQQ     -> SLIT("eq");  NE    -> SLIT("ne");
 455         LTT     -> SLIT("lt");  GE    -> SLIT("ge");
 456         GTT     -> SLIT("gt");  LE    -> SLIT("le");
 457         LU      -> SLIT("lt");  GEU   -> SLIT("ge");
 458         GU      -> SLIT("gt");  LEU   -> SLIT("le");
 459 #endif
 460     })
 461
 462
 463 -- -----------------------------------------------------------------------------
 464 -- pprImm: print an 'Imm'
 465
 466 pprImm :: Imm -> Doc
 467
 468 pprImm (ImmInt i)     = int i
 469 pprImm (ImmInteger i) = integer i
 470 pprImm (ImmCLbl l)    = pprCLabel_asm l
 471 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
 472 pprImm (ImmLit s)     = s
 473
 474 pprImm (ImmFloat _) = ptext SLIT("naughty float immediate")
 475 pprImm (ImmDouble _) = ptext SLIT("naughty double immediate")
 476
 477 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
 478 #if sparc_TARGET_ARCH
 479 -- ToDo: This should really be fixed in the PIC support, but only
 480 -- print a for now.
 481 pprImm (ImmConstantDiff a b) = pprImm a
 482 #else
 483 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
 484                             <> lparen <> pprImm b <> rparen
 485 #endif
 486
 487 #if sparc_TARGET_ARCH
 488 pprImm (LO i)
 489   = hcat [ pp_lo, pprImm i, rparen ]
 490   where
 491     pp_lo = text "%lo("
 492
 493 pprImm (HI i)
 494   = hcat [ pp_hi, pprImm i, rparen ]
 495   where
 496     pp_hi = text "%hi("
 497 #endif
 498 #if powerpc_TARGET_ARCH
 499 #if darwin_TARGET_OS
 500 pprImm (LO i)
 501   = hcat [ pp_lo, pprImm i, rparen ]
 502   where
 503     pp_lo = text "lo16("
 504
 505 pprImm (HI i)
 506   = hcat [ pp_hi, pprImm i, rparen ]
 507   where
 508     pp_hi = text "hi16("
 509
 510 pprImm (HA i)
 511   = hcat [ pp_ha, pprImm i, rparen ]
 512   where
 513     pp_ha = text "ha16("
 514
 515 #else
 516 pprImm (LO i)
 517   = pprImm i <> text "@l"
 518
 519 pprImm (HI i)
 520   = pprImm i <> text "@h"
 521
 522 pprImm (HA i)
 523   = pprImm i <> text "@ha"
 524 #endif
 525 #endif
 526
 527
 528 -- -----------------------------------------------------------------------------
 529 -- @pprAddr: print an 'AddrMode'
 530
 531 pprAddr :: AddrMode -> Doc
 532
 533 #if alpha_TARGET_ARCH
 534 pprAddr (AddrReg r) = parens (pprReg r)
 535 pprAddr (AddrImm i) = pprImm i
 536 pprAddr (AddrRegImm r1 i)
 537   = (<>) (pprImm i) (parens (pprReg r1))
 538 #endif
 539
 540 -------------------
 541
 542 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 543 pprAddr (ImmAddr imm off)
 544   = let pp_imm = pprImm imm
 545     in
 546     if (off == 0) then
 547         pp_imm
 548     else if (off < 0) then
 549         pp_imm <> int off
 550     else
 551         pp_imm <> char '+' <> int off
 552
 553 pprAddr (AddrBaseIndex base index displacement)
 554   = let
 555         pp_disp  = ppr_disp displacement
 556         pp_off p = pp_disp <> char '(' <> p <> char ')'
 557         pp_reg r = pprReg wordRep r
 558     in
 559     case (base,index) of
 560       (EABaseNone,  EAIndexNone) -> pp_disp
 561       (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
 562       (EABaseRip,   EAIndexNone) -> pp_off (ptext SLIT("%rip"))
 563       (EABaseNone,  EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
 564       (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
 565                                        <> comma <> int i)
 566   where
 567     ppr_disp (ImmInt 0) = empty
 568     ppr_disp imm        = pprImm imm
 569 #endif
 570
 571 -------------------
 572
 573 #if sparc_TARGET_ARCH
 574 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
 575
 576 pprAddr (AddrRegReg r1 r2)
 577   = hcat [ pprReg r1, char '+', pprReg r2 ]
 578
 579 pprAddr (AddrRegImm r1 (ImmInt i))
 580   | i == 0 = pprReg r1
 581   | not (fits13Bits i) = largeOffsetError i
 582   | otherwise = hcat [ pprReg r1, pp_sign, int i ]
 583   where
 584     pp_sign = if i > 0 then char '+' else empty
 585
 586 pprAddr (AddrRegImm r1 (ImmInteger i))
 587   | i == 0 = pprReg r1
 588   | not (fits13Bits i) = largeOffsetError i
 589   | otherwise  = hcat [ pprReg r1, pp_sign, integer i ]
 590   where
 591     pp_sign = if i > 0 then char '+' else empty
 592
 593 pprAddr (AddrRegImm r1 imm)
 594   = hcat [ pprReg r1, char '+', pprImm imm ]
 595 #endif
 596
 597 -------------------
 598
 599 #if powerpc_TARGET_ARCH
 600 pprAddr (AddrRegReg r1 r2)
 601   = pprReg r1 <+> ptext SLIT(", ") <+> pprReg r2
 602
 603 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
 604 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
 605 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
 606 #endif
 607
 608
 609 -- -----------------------------------------------------------------------------
 610 -- pprData: print a 'CmmStatic'
 611
 612 pprSectionHeader Text
 613     = ptext
 614         IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
 615        ,IF_ARCH_sparc(SLIT(".text\n\t.align 4") {-word boundary-}
 616        ,IF_ARCH_i386(IF_OS_darwin(SLIT(".text\n\t.align 2"),
 617                                   SLIT(".text\n\t.align 4,0x90"))
 618                                   {-needs per-OS variation!-}
 619        ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".text\n.align 3"),
 620                                     SLIT(".text\n\t.align 8"))
 621        ,IF_ARCH_powerpc(SLIT(".text\n.align 2")
 622        ,)))))
 623 pprSectionHeader Data
 624     = ptext
 625          IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
 626         ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
 627         ,IF_ARCH_i386(IF_OS_darwin(SLIT(".data\n\t.align 2"),
 628                                    SLIT(".data\n\t.align 4"))
 629         ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".data\n.align 3"),
 630                                      SLIT(".data\n\t.align 8"))
 631         ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
 632         ,)))))
 633 pprSectionHeader ReadOnlyData
 634     = ptext
 635          IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
 636         ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
 637         ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 2"),
 638                                    SLIT(".section .rodata\n\t.align 4"))
 639         ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const\n.align 3"),
 640                                      SLIT(".section .rodata\n\t.align 8"))
 641         ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 2"),
 642                                       SLIT(".section .rodata\n\t.align 2"))
 643         ,)))))
 644 pprSectionHeader RelocatableReadOnlyData
 645     = ptext
 646          IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
 647         ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
 648         ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n.align 2"),
 649                                    SLIT(".section .data\n\t.align 4"))
 650         ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const_data\n.align 3"),
 651                                      SLIT(".section .data\n\t.align 8"))
 652         ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
 653                                       SLIT(".data\n\t.align 2"))
 654         ,)))))
 655 pprSectionHeader UninitialisedData
 656     = ptext
 657          IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3")
 658         ,IF_ARCH_sparc(SLIT(".bss\n\t.align 8") {-<8 will break double constants -}
 659         ,IF_ARCH_i386(IF_OS_darwin(SLIT(".data\n\t.align 2"),
 660                                    SLIT(".section .bss\n\t.align 4"))
 661         ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".data\n\t.align 3"),
 662                                      SLIT(".section .bss\n\t.align 8"))
 663         ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
 664                                       SLIT(".section .bss\n\t.align 2"))
 665         ,)))))
 666 pprSectionHeader ReadOnlyData16
 667     = ptext
 668          IF_ARCH_alpha(SLIT("\t.data\n\t.align 4")
 669         ,IF_ARCH_sparc(SLIT(".data\n\t.align 16")
 670         ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 4"),
 671                                    SLIT(".section .rodata\n\t.align 16"))
 672         ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const\n.align 4"),
 673                                      SLIT(".section .rodata.cst16\n\t.align 16"))
 674         ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 4"),
 675                                       SLIT(".section .rodata\n\t.align 4"))
 676         ,)))))
 677
 678 pprSectionHeader (OtherSection sec)
 679     = panic "PprMach.pprSectionHeader: unknown section"
 680
 681 pprData :: CmmStatic -> Doc
 682 pprData (CmmAlign bytes)         = pprAlign bytes
 683 pprData (CmmDataLabel lbl)       = pprLabel lbl
 684 pprData (CmmString str)          = pprASCII str
 685 pprData (CmmUninitialised bytes) = ptext SLIT(".space ") <> int bytes
 686 pprData (CmmStaticLit lit)       = pprDataItem lit
 687
 688 pprGloblDecl :: CLabel -> Doc
 689 pprGloblDecl lbl
 690   | not (externallyVisibleCLabel lbl) = empty
 691   | otherwise = ptext IF_ARCH_sparc(SLIT(".global "),
 692                                     SLIT(".globl ")) <>
 693                 pprCLabel_asm lbl
 694
 695 pprTypeAndSizeDecl :: CLabel -> Doc
 696 pprTypeAndSizeDecl lbl
 697   | not (externallyVisibleCLabel lbl) = empty
 698   | otherwise = ptext SLIT(".type ") <>
 699                 pprCLabel_asm lbl <> ptext SLIT(", @object")
 700
 701 pprLabel :: CLabel -> Doc
 702 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
 703
 704
 705 pprASCII str
 706   = vcat (map do1 str) $$ do1 0
 707     where
 708        do1 :: Word8 -> Doc
 709        do1 w = ptext SLIT("\t.byte\t") <> int (fromIntegral w)
 710
 711 pprAlign bytes =
 712         IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
 713         IF_ARCH_i386(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
 714         IF_ARCH_x86_64(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
 715         IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
 716         IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))))
 717   where
 718         pow2 = log2 bytes
 719
 720         log2 :: Int -> Int  -- cache the common ones
 721         log2 1 = 0
 722         log2 2 = 1
 723         log2 4 = 2
 724         log2 8 = 3
 725         log2 n = 1 + log2 (n `quot` 2)
 726
 727
 728 pprDataItem :: CmmLit -> Doc
 729 pprDataItem lit
 730   = vcat (ppr_item (cmmLitRep lit) lit)
 731     where
 732         imm = litToImm lit
 733
 734         -- These seem to be common:
 735         ppr_item I8   x = [ptext SLIT("\t.byte\t") <> pprImm imm]
 736         ppr_item I32  x = [ptext SLIT("\t.long\t") <> pprImm imm]
 737         ppr_item F32  (CmmFloat r _)
 738            = let bs = floatToBytes (fromRational r)
 739              in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
 740         ppr_item F64 (CmmFloat r _)
 741            = let bs = doubleToBytes (fromRational r)
 742              in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
 743
 744 #if sparc_TARGET_ARCH
 745         -- copy n paste of x86 version
 746         ppr_item I16  x = [ptext SLIT("\t.short\t") <> pprImm imm]
 747         ppr_item I64  x = [ptext SLIT("\t.quad\t") <> pprImm imm]
 748 #endif
 749 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 750         ppr_item I16  x = [ptext SLIT("\t.word\t") <> pprImm imm]
 751 #endif
 752 #if i386_TARGET_ARCH && darwin_TARGET_OS
 753         ppr_item I64 (CmmInt x _)  =
 754                 [ptext SLIT("\t.long\t")
 755                     <> int (fromIntegral (fromIntegral x :: Word32)),
 756                  ptext SLIT("\t.long\t")
 757                     <> int (fromIntegral
 758                         (fromIntegral (x `shiftR` 32) :: Word32))]
 759 #endif
 760 #if i386_TARGET_ARCH || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
 761         ppr_item I64  x = [ptext SLIT("\t.quad\t") <> pprImm imm]
 762 #endif
 763 #if x86_64_TARGET_ARCH && !darwin_TARGET_OS
 764         -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
 765         -- type, which means we can't do pc-relative 64-bit addresses.
 766         -- Fortunately we're assuming the small memory model, in which
 767         -- all such offsets will fit into 32 bits, so we have to stick
 768         -- to 32-bit offset fields and modify the RTS appropriately
 769         --
 770         -- See Note [x86-64-relative] in includes/InfoTables.h
 771         --
 772         ppr_item I64  x
 773            | isRelativeReloc x =
 774                 [ptext SLIT("\t.long\t") <> pprImm imm,
 775                  ptext SLIT("\t.long\t0")]
 776            | otherwise =
 777                 [ptext SLIT("\t.quad\t") <> pprImm imm]
 778            where
 779                 isRelativeReloc (CmmLabelDiffOff _ _ _) = True
 780                 isRelativeReloc _ = False
 781 #endif
 782 #if powerpc_TARGET_ARCH
 783         ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
 784         ppr_item I64 (CmmInt x _)  =
 785                 [ptext SLIT("\t.long\t")
 786                     <> int (fromIntegral
 787                         (fromIntegral (x `shiftR` 32) :: Word32)),
 788                  ptext SLIT("\t.long\t")
 789                     <> int (fromIntegral (fromIntegral x :: Word32))]
 790 #endif
 791
 792 -- fall through to rest of (machine-specific) pprInstr...
 793
 794 -- -----------------------------------------------------------------------------
 795 -- pprInstr: print an 'Instr'
 796
 797 pprInstr :: Instr -> Doc
 798
 799 --pprInstr (COMMENT s) = empty -- nuke 'em
 800 pprInstr (COMMENT s)
 801    =  IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
 802      ,IF_ARCH_sparc( ((<>) (ptext SLIT("! "))   (ftext s))
 803      ,IF_ARCH_i386( ((<>) (ptext SLIT("# "))   (ftext s))
 804      ,IF_ARCH_x86_64( ((<>) (ptext SLIT("# "))   (ftext s))
 805      ,IF_ARCH_powerpc( IF_OS_linux(
 806         ((<>) (ptext SLIT("# ")) (ftext s)),
 807         ((<>) (ptext SLIT("; ")) (ftext s)))
 808      ,)))))
 809
 810 pprInstr (DELTA d)
 811    = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
 812
 813 pprInstr (NEWBLOCK _)
 814    = panic "PprMach.pprInstr: NEWBLOCK"
 815
 816 pprInstr (LDATA _ _)
 817    = panic "PprMach.pprInstr: LDATA"
 818
 819 -- -----------------------------------------------------------------------------
 820 -- pprInstr for an Alpha
 821
 822 #if alpha_TARGET_ARCH
 823
 824 pprInstr (LD size reg addr)
 825   = hcat [
 826         ptext SLIT("\tld"),
 827         pprSize size,
 828         char '\t',
 829         pprReg reg,
 830         comma,
 831         pprAddr addr
 832     ]
 833
 834 pprInstr (LDA reg addr)
 835   = hcat [
 836         ptext SLIT("\tlda\t"),
 837         pprReg reg,
 838         comma,
 839         pprAddr addr
 840     ]
 841
 842 pprInstr (LDAH reg addr)
 843   = hcat [
 844         ptext SLIT("\tldah\t"),
 845         pprReg reg,
 846         comma,
 847         pprAddr addr
 848     ]
 849
 850 pprInstr (LDGP reg addr)
 851   = hcat [
 852         ptext SLIT("\tldgp\t"),
 853         pprReg reg,
 854         comma,
 855         pprAddr addr
 856     ]
 857
 858 pprInstr (LDI size reg imm)
 859   = hcat [
 860         ptext SLIT("\tldi"),
 861         pprSize size,
 862         char '\t',
 863         pprReg reg,
 864         comma,
 865         pprImm imm
 866     ]
 867
 868 pprInstr (ST size reg addr)
 869   = hcat [
 870         ptext SLIT("\tst"),
 871         pprSize size,
 872         char '\t',
 873         pprReg reg,
 874         comma,
 875         pprAddr addr
 876     ]
 877
 878 pprInstr (CLR reg)
 879   = hcat [
 880         ptext SLIT("\tclr\t"),
 881         pprReg reg
 882     ]
 883
 884 pprInstr (ABS size ri reg)
 885   = hcat [
 886         ptext SLIT("\tabs"),
 887         pprSize size,
 888         char '\t',
 889         pprRI ri,
 890         comma,
 891         pprReg reg
 892     ]
 893
 894 pprInstr (NEG size ov ri reg)
 895   = hcat [
 896         ptext SLIT("\tneg"),
 897         pprSize size,
 898         if ov then ptext SLIT("v\t") else char '\t',
 899         pprRI ri,
 900         comma,
 901         pprReg reg
 902     ]
 903
 904 pprInstr (ADD size ov reg1 ri reg2)
 905   = hcat [
 906         ptext SLIT("\tadd"),
 907         pprSize size,
 908         if ov then ptext SLIT("v\t") else char '\t',
 909         pprReg reg1,
 910         comma,
 911         pprRI ri,
 912         comma,
 913         pprReg reg2
 914     ]
 915
 916 pprInstr (SADD size scale reg1 ri reg2)
 917   = hcat [
 918         ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
 919         ptext SLIT("add"),
 920         pprSize size,
 921         char '\t',
 922         pprReg reg1,
 923         comma,
 924         pprRI ri,
 925         comma,
 926         pprReg reg2
 927     ]
 928
 929 pprInstr (SUB size ov reg1 ri reg2)
 930   = hcat [
 931         ptext SLIT("\tsub"),
 932         pprSize size,
 933         if ov then ptext SLIT("v\t") else char '\t',
 934         pprReg reg1,
 935         comma,
 936         pprRI ri,
 937         comma,
 938         pprReg reg2
 939     ]
 940
 941 pprInstr (SSUB size scale reg1 ri reg2)
 942   = hcat [
 943         ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
 944         ptext SLIT("sub"),
 945         pprSize size,
 946         char '\t',
 947         pprReg reg1,
 948         comma,
 949         pprRI ri,
 950         comma,
 951         pprReg reg2
 952     ]
 953
 954 pprInstr (MUL size ov reg1 ri reg2)
 955   = hcat [
 956         ptext SLIT("\tmul"),
 957         pprSize size,
 958         if ov then ptext SLIT("v\t") else char '\t',
 959         pprReg reg1,
 960         comma,
 961         pprRI ri,
 962         comma,
 963         pprReg reg2
 964     ]
 965
 966 pprInstr (DIV size uns reg1 ri reg2)
 967   = hcat [
 968         ptext SLIT("\tdiv"),
 969         pprSize size,
 970         if uns then ptext SLIT("u\t") else char '\t',
 971         pprReg reg1,
 972         comma,
 973         pprRI ri,
 974         comma,
 975         pprReg reg2
 976     ]
 977
 978 pprInstr (REM size uns reg1 ri reg2)
 979   = hcat [
 980         ptext SLIT("\trem"),
 981         pprSize size,
 982         if uns then ptext SLIT("u\t") else char '\t',
 983         pprReg reg1,
 984         comma,
 985         pprRI ri,
 986         comma,
 987         pprReg reg2
 988     ]
 989
 990 pprInstr (NOT ri reg)
 991   = hcat [
 992         ptext SLIT("\tnot"),
 993         char '\t',
 994         pprRI ri,
 995         comma,
 996         pprReg reg
 997     ]
 998
 999 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
1000 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
1001 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
1002 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
1003 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
1004 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
1005
1006 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
1007 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
1008 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
1009
1010 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
1011 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
1012
1013 pprInstr (NOP) = ptext SLIT("\tnop")
1014
1015 pprInstr (CMP cond reg1 ri reg2)
1016   = hcat [
1017         ptext SLIT("\tcmp"),
1018         pprCond cond,
1019         char '\t',
1020         pprReg reg1,
1021         comma,
1022         pprRI ri,
1023         comma,
1024         pprReg reg2
1025     ]
1026
1027 pprInstr (FCLR reg)
1028   = hcat [
1029         ptext SLIT("\tfclr\t"),
1030         pprReg reg
1031     ]
1032
1033 pprInstr (FABS reg1 reg2)
1034   = hcat [
1035         ptext SLIT("\tfabs\t"),
1036         pprReg reg1,
1037         comma,
1038         pprReg reg2
1039     ]
1040
1041 pprInstr (FNEG size reg1 reg2)
1042   = hcat [
1043         ptext SLIT("\tneg"),
1044         pprSize size,
1045         char '\t',
1046         pprReg reg1,
1047         comma,
1048         pprReg reg2
1049     ]
1050
1051 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
1052 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
1053 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
1054 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
1055
1056 pprInstr (CVTxy size1 size2 reg1 reg2)
1057   = hcat [
1058         ptext SLIT("\tcvt"),
1059         pprSize size1,
1060         case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
1061         char '\t',
1062         pprReg reg1,
1063         comma,
1064         pprReg reg2
1065     ]
1066
1067 pprInstr (FCMP size cond reg1 reg2 reg3)
1068   = hcat [
1069         ptext SLIT("\tcmp"),
1070         pprSize size,
1071         pprCond cond,
1072         char '\t',
1073         pprReg reg1,
1074         comma,
1075         pprReg reg2,
1076         comma,
1077         pprReg reg3
1078     ]
1079
1080 pprInstr (FMOV reg1 reg2)
1081   = hcat [
1082         ptext SLIT("\tfmov\t"),
1083         pprReg reg1,
1084         comma,
1085         pprReg reg2
1086     ]
1087
1088 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
1089
1090 pprInstr (BI NEVER reg lab) = empty
1091
1092 pprInstr (BI cond reg lab)
1093   = hcat [
1094         ptext SLIT("\tb"),
1095         pprCond cond,
1096         char '\t',
1097         pprReg reg,
1098         comma,
1099         pprImm lab
1100     ]
1101
1102 pprInstr (BF cond reg lab)
1103   = hcat [
1104         ptext SLIT("\tfb"),
1105         pprCond cond,
1106         char '\t',
1107         pprReg reg,
1108         comma,
1109         pprImm lab
1110     ]
1111
1112 pprInstr (BR lab)
1113   = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
1114
1115 pprInstr (JMP reg addr hint)
1116   = hcat [
1117         ptext SLIT("\tjmp\t"),
1118         pprReg reg,
1119         comma,
1120         pprAddr addr,
1121         comma,
1122         int hint
1123     ]
1124
1125 pprInstr (BSR imm n)
1126   = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
1127
1128 pprInstr (JSR reg addr n)
1129   = hcat [
1130         ptext SLIT("\tjsr\t"),
1131         pprReg reg,
1132         comma,
1133         pprAddr addr
1134     ]
1135
1136 pprInstr (FUNBEGIN clab)
1137   = hcat [
1138         if (externallyVisibleCLabel clab) then
1139             hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
1140         else
1141             empty,
1142         ptext SLIT("\t.ent "),
1143         pp_lab,
1144         char '\n',
1145         pp_lab,
1146         pp_ldgp,
1147         pp_lab,
1148         pp_frame
1149     ]
1150     where
1151         pp_lab = pprCLabel_asm clab
1152
1153         -- NEVER use commas within those string literals, cpp will ruin your day
1154         pp_ldgp  = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
1155         pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
1156                           ptext SLIT("4240"), char ',',
1157                           ptext SLIT("$26"), char ',',
1158                           ptext SLIT("0\n\t.prologue 1") ]
1159
1160 pprInstr (FUNEND clab)
1161   = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
1162 \end{code}
1163
1164 Continue with Alpha-only printing bits and bobs:
1165 \begin{code}
1166 pprRI :: RI -> Doc
1167
1168 pprRI (RIReg r) = pprReg r
1169 pprRI (RIImm r) = pprImm r
1170
1171 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
1172 pprRegRIReg name reg1 ri reg2
1173   = hcat [
1174         char '\t',
1175         ptext name,
1176         char '\t',
1177         pprReg reg1,
1178         comma,
1179         pprRI ri,
1180         comma,
1181         pprReg reg2
1182     ]
1183
1184 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1185 pprSizeRegRegReg name size reg1 reg2 reg3
1186   = hcat [
1187         char '\t',
1188         ptext name,
1189         pprSize size,
1190         char '\t',
1191         pprReg reg1,
1192         comma,
1193         pprReg reg2,
1194         comma,
1195         pprReg reg3
1196     ]
1197
1198 #endif /* alpha_TARGET_ARCH */
1199
1200
1201 -- -----------------------------------------------------------------------------
1202 -- pprInstr for an x86
1203
1204 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1205
1206 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
1207   | src == dst
1208   =
1209 #if 0 /* #ifdef DEBUG */
1210     (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
1211 #else
1212     empty
1213 #endif
1214
1215 pprInstr (MOV size src dst)
1216   = pprSizeOpOp SLIT("mov") size src dst
1217
1218 pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
1219         -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
1220         -- movl.  But we represent it as a MOVZxL instruction, because
1221         -- the reg alloc would tend to throw away a plain reg-to-reg
1222         -- move, and we still want it to do that.
1223
1224 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 src dst
1225         -- zero-extension only needs to extend to 32 bits: on x86_64,
1226         -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
1227         -- instruction is shorter.
1228
1229 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
1230
1231 -- here we do some patching, since the physical registers are only set late
1232 -- in the code generation.
1233 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1234   | reg1 == reg3
1235   = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1236 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1237   | reg2 == reg3
1238   = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1239 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
1240   | reg1 == reg3
1241   = pprInstr (ADD size (OpImm displ) dst)
1242 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1243
1244 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1245   = pprSizeOp SLIT("dec") size dst
1246 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1247   = pprSizeOp SLIT("inc") size dst
1248 pprInstr (ADD size src dst)
1249   = pprSizeOpOp SLIT("add") size src dst
1250 pprInstr (ADC size src dst)
1251   = pprSizeOpOp SLIT("adc") size src dst
1252 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1253 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1254
1255 {- A hack.  The Intel documentation says that "The two and three
1256    operand forms [of IMUL] may also be used with unsigned operands
1257    because the lower half of the product is the same regardless if
1258    (sic) the operands are signed or unsigned.  The CF and OF flags,
1259    however, cannot be used to determine if the upper half of the
1260    result is non-zero."  So there.
1261 -}
1262 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1263 pprInstr (OR  size src dst) = pprSizeOpOp SLIT("or")  size src dst
1264
1265 pprInstr (XOR F32 src dst)  = pprOpOp SLIT("xorps") F32 src dst
1266 pprInstr (XOR F64 src dst)  = pprOpOp SLIT("xorpd") F64 src dst
1267 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor")  size src dst
1268
1269 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1270 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1271
1272 pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
1273 pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
1274 pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
1275
1276 pprInstr (BT  size imm src) = pprSizeImmOp SLIT("bt") size imm src
1277
1278 pprInstr (CMP size src dst)
1279   | isFloatingRep size =  pprSizeOpOp SLIT("ucomi")  size src dst -- SSE2
1280   | otherwise          =  pprSizeOpOp SLIT("cmp")  size src dst
1281
1282 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test")  size src dst
1283 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1284 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1285
1286 -- both unused (SDM):
1287 -- pprInstr PUSHA = ptext SLIT("\tpushal")
1288 -- pprInstr POPA = ptext SLIT("\tpopal")
1289
1290 pprInstr NOP = ptext SLIT("\tnop")
1291 pprInstr (CLTD I32) = ptext SLIT("\tcltd")
1292 pprInstr (CLTD I64) = ptext SLIT("\tcqto")
1293
1294 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
1295
1296 pprInstr (JXX cond (BlockId id))
1297   = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1298   where lab = mkAsmTempLabel id
1299
1300 pprInstr (JXX_GBL cond imm) = pprCondInstr SLIT("j") cond (pprImm imm)
1301
1302 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1303 pprInstr (JMP op)          = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
1304 pprInstr (JMP_TBL op ids)  = pprInstr (JMP op)
1305 pprInstr (CALL (Left imm) _)    = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1306 pprInstr (CALL (Right reg) _)   = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
1307
1308 pprInstr (IDIV sz op)   = pprSizeOp SLIT("idiv") sz op
1309 pprInstr (DIV sz op)    = pprSizeOp SLIT("div")  sz op
1310 pprInstr (IMUL2 sz op)  = pprSizeOp SLIT("imul") sz op
1311
1312 #if x86_64_TARGET_ARCH
1313 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
1314
1315 pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
1316
1317 pprInstr (CVTSS2SD from to)   = pprRegReg SLIT("cvtss2sd") from to
1318 pprInstr (CVTSD2SS from to)   = pprRegReg SLIT("cvtsd2ss") from to
1319 pprInstr (CVTTSS2SIQ from to) = pprOpReg  SLIT("cvttss2siq") from to
1320 pprInstr (CVTTSD2SIQ from to) = pprOpReg  SLIT("cvttsd2siq") from to
1321 pprInstr (CVTSI2SS from to)   = pprOpReg  SLIT("cvtsi2ssq") from to
1322 pprInstr (CVTSI2SD from to)   = pprOpReg  SLIT("cvtsi2sdq") from to
1323 #endif
1324
1325     -- FETCHGOT for PIC on ELF platforms
1326 pprInstr (FETCHGOT reg)
1327    = vcat [ ptext SLIT("\tcall 1f"),
1328             hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
1329             hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
1330                    pprReg I32 reg ]
1331           ]
1332
1333     -- FETCHPC for PIC on Darwin/x86
1334     -- get the instruction pointer into a register
1335     -- (Terminology note: the IP is called Program Counter on PPC,
1336     --  and it's a good thing to use the same name on both platforms)
1337 pprInstr (FETCHPC reg)
1338    = vcat [ ptext SLIT("\tcall 1f"),
1339             hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ]
1340           ]
1341
1342
1343
1344 #endif
1345
1346 -- -----------------------------------------------------------------------------
1347 -- i386 floating-point
1348
1349 #if i386_TARGET_ARCH
1350 -- Simulating a flat register set on the x86 FP stack is tricky.
1351 -- you have to free %st(7) before pushing anything on the FP reg stack
1352 -- so as to preclude the possibility of a FP stack overflow exception.
1353 pprInstr g@(GMOV src dst)
1354    | src == dst
1355    = empty
1356    | otherwise
1357    = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1358
1359 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1360 pprInstr g@(GLD sz addr dst)
1361  = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1362                  pprAddr addr, gsemi, gpop dst 1])
1363
1364 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1365 pprInstr g@(GST sz src addr)
1366  = pprG g (hcat [gtab, gpush src 0, gsemi,
1367                  text "fstp", pprSize sz, gsp, pprAddr addr])
1368
1369 pprInstr g@(GLDZ dst)
1370  = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1371 pprInstr g@(GLD1 dst)
1372  = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1373
1374 pprInstr g@(GFTOI src dst)
1375    = pprInstr (GDTOI src dst)
1376 pprInstr g@(GDTOI src dst)
1377    = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1378                    gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1379                    pprReg I32 dst])
1380
1381 pprInstr g@(GITOF src dst)
1382    = pprInstr (GITOD src dst)
1383 pprInstr g@(GITOD src dst)
1384    = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
1385                    text " ; ffree %st(7); fildl (%esp) ; ",
1386                    gpop dst 1, text " ; addl $4,%esp"])
1387
1388 {- Gruesome swamp follows.  If you're unfortunate enough to have ventured
1389    this far into the jungle AND you give a Rat's Ass (tm) what's going
1390    on, here's the deal.  Generate code to do a floating point comparison
1391    of src1 and src2, of kind cond, and set the Zero flag if true.
1392
1393    The complications are to do with handling NaNs correctly.  We want the
1394    property that if either argument is NaN, then the result of the
1395    comparison is False ... except if we're comparing for inequality,
1396    in which case the answer is True.
1397
1398    Here's how the general (non-inequality) case works.  As an
1399    example, consider generating the an equality test:
1400
1401      pushl %eax         -- we need to mess with this
1402      <get src1 to top of FPU stack>
1403      fcomp <src2 location in FPU stack> and pop pushed src1
1404                 -- Result of comparison is in FPU Status Register bits
1405                 -- C3 C2 and C0
1406      fstsw %ax  -- Move FPU Status Reg to %ax
1407      sahf       -- move C3 C2 C0 from %ax to integer flag reg
1408      -- now the serious magic begins
1409      setpo %ah     -- %ah = if comparable(neither arg was NaN) then 1 else 0
1410      sete  %al     -- %al = if arg1 == arg2 then 1 else 0
1411      andb %ah,%al  -- %al &= %ah
1412                    -- so %al == 1 iff (comparable && same); else it holds 0
1413      decb %al      -- %al == 0, ZeroFlag=1  iff (comparable && same);
1414                       else %al == 0xFF, ZeroFlag=0
1415      -- the zero flag is now set as we desire.
1416      popl %eax
1417
1418    The special case of inequality differs thusly:
1419
1420      setpe %ah     -- %ah = if incomparable(either arg was NaN) then 1 else 0
1421      setne %al     -- %al = if arg1 /= arg2 then 1 else 0
1422      orb %ah,%al   -- %al = if (incomparable || different) then 1 else 0
1423      decb %al      -- if (incomparable || different) then (%al == 0, ZF=1)
1424                                                      else (%al == 0xFF, ZF=0)
1425 -}
1426 pprInstr g@(GCMP cond src1 src2)
1427    | case cond of { NE -> True; other -> False }
1428    = pprG g (vcat [
1429         hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1430         hcat [gtab, text "fcomp ", greg src2 1,
1431                     text "; fstsw %ax ; sahf ;  setpe %ah"],
1432         hcat [gtab, text "setne %al ;  ",
1433               text "orb %ah,%al ;  decb %al ;  popl %eax"]
1434     ])
1435    | otherwise
1436    = pprG g (vcat [
1437         hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1438         hcat [gtab, text "fcomp ", greg src2 1,
1439                     text "; fstsw %ax ; sahf ;  setpo %ah"],
1440         hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ;  ",
1441               text "andb %ah,%al ;  decb %al ;  popl %eax"]
1442     ])
1443     where
1444         {- On the 486, the flags set by FP compare are the unsigned ones!
1445            (This looks like a HACK to me.  WDP 96/03)
1446         -}
1447         fix_FP_cond :: Cond -> Cond
1448         fix_FP_cond GE   = GEU
1449         fix_FP_cond GTT  = GU
1450         fix_FP_cond LTT  = LU
1451         fix_FP_cond LE   = LEU
1452         fix_FP_cond EQQ  = EQQ
1453         fix_FP_cond NE   = NE
1454         -- there should be no others
1455
1456
1457 pprInstr g@(GABS sz src dst)
1458    = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1459 pprInstr g@(GNEG sz src dst)
1460    = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1461
1462 pprInstr g@(GSQRT sz src dst)
1463    = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1464              hcat [gtab, gcoerceto sz, gpop dst 1])
1465 pprInstr g@(GSIN sz src dst)
1466    = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1467              hcat [gtab, gcoerceto sz, gpop dst 1])
1468 pprInstr g@(GCOS sz src dst)
1469    = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1470              hcat [gtab, gcoerceto sz, gpop dst 1])
1471 pprInstr g@(GTAN sz src dst)
1472    = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1473                    gpush src 0, text " ; fptan ; ",
1474                    text " fstp %st(0)"] $$
1475              hcat [gtab, gcoerceto sz, gpop dst 1])
1476
1477 -- In the translations for GADD, GMUL, GSUB and GDIV,
1478 -- the first two cases are mere optimisations.  The otherwise clause
1479 -- generates correct code under all circumstances.
1480
1481 pprInstr g@(GADD sz src1 src2 dst)
1482    | src1 == dst
1483    = pprG g (text "\t#GADD-xxxcase1" $$
1484              hcat [gtab, gpush src2 0,
1485                    text " ; faddp %st(0),", greg src1 1])
1486    | src2 == dst
1487    = pprG g (text "\t#GADD-xxxcase2" $$
1488              hcat [gtab, gpush src1 0,
1489                    text " ; faddp %st(0),", greg src2 1])
1490    | otherwise
1491    = pprG g (hcat [gtab, gpush src1 0,
1492                    text " ; fadd ", greg src2 1, text ",%st(0)",
1493                    gsemi, gpop dst 1])
1494
1495
1496 pprInstr g@(GMUL sz src1 src2 dst)
1497    | src1 == dst
1498    = pprG g (text "\t#GMUL-xxxcase1" $$
1499              hcat [gtab, gpush src2 0,
1500                    text " ; fmulp %st(0),", greg src1 1])
1501    | src2 == dst
1502    = pprG g (text "\t#GMUL-xxxcase2" $$
1503              hcat [gtab, gpush src1 0,
1504                    text " ; fmulp %st(0),", greg src2 1])
1505    | otherwise
1506    = pprG g (hcat [gtab, gpush src1 0,
1507                    text " ; fmul ", greg src2 1, text ",%st(0)",
1508                    gsemi, gpop dst 1])
1509
1510
1511 pprInstr g@(GSUB sz src1 src2 dst)
1512    | src1 == dst
1513    = pprG g (text "\t#GSUB-xxxcase1" $$
1514              hcat [gtab, gpush src2 0,
1515                    text " ; fsubrp %st(0),", greg src1 1])
1516    | src2 == dst
1517    = pprG g (text "\t#GSUB-xxxcase2" $$
1518              hcat [gtab, gpush src1 0,
1519                    text " ; fsubp %st(0),", greg src2 1])
1520    | otherwise
1521    = pprG g (hcat [gtab, gpush src1 0,
1522                    text " ; fsub ", greg src2 1, text ",%st(0)",
1523                    gsemi, gpop dst 1])
1524
1525
1526 pprInstr g@(GDIV sz src1 src2 dst)
1527    | src1 == dst
1528    = pprG g (text "\t#GDIV-xxxcase1" $$
1529              hcat [gtab, gpush src2 0,
1530                    text " ; fdivrp %st(0),", greg src1 1])
1531    | src2 == dst
1532    = pprG g (text "\t#GDIV-xxxcase2" $$
1533              hcat [gtab, gpush src1 0,
1534                    text " ; fdivp %st(0),", greg src2 1])
1535    | otherwise
1536    = pprG g (hcat [gtab, gpush src1 0,
1537                    text " ; fdiv ", greg src2 1, text ",%st(0)",
1538                    gsemi, gpop dst 1])
1539
1540
1541 pprInstr GFREE
1542    = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1543             ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1544           ]
1545
1546 --------------------------
1547
1548 -- coerce %st(0) to the specified size
1549 gcoerceto F64 = empty
1550 gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1551
1552 gpush reg offset
1553    = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1554 gpop reg offset
1555    = hcat [text "fstp ", greg reg offset]
1556
1557 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1558 gsemi = text " ; "
1559 gtab  = char '\t'
1560 gsp   = char ' '
1561
1562 gregno (RealReg i) = i
1563 gregno other       = --pprPanic "gregno" (ppr other)
1564                      999   -- bogus; only needed for debug printing
1565
1566 pprG :: Instr -> Doc -> Doc
1567 pprG fake actual
1568    = (char '#' <> pprGInstr fake) $$ actual
1569
1570 pprGInstr (GMOV src dst)   = pprSizeRegReg SLIT("gmov") F64 src dst
1571 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1572 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1573
1574 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
1575 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
1576
1577 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32  src dst
1578 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
1579
1580 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32  src dst
1581 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
1582
1583 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
1584 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1585 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1586 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1587 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1588 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1589 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1590
1591 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1592 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1593 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1594 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1595 #endif
1596
1597 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1598
1599 -- Continue with I386-only printing bits and bobs:
1600
1601 pprDollImm :: Imm -> Doc
1602
1603 pprDollImm i =  ptext SLIT("$") <> pprImm i
1604
1605 pprOperand :: MachRep -> Operand -> Doc
1606 pprOperand s (OpReg r)   = pprReg s r
1607 pprOperand s (OpImm i)   = pprDollImm i
1608 pprOperand s (OpAddr ea) = pprAddr ea
1609
1610 pprMnemonic_  :: LitString -> Doc
1611 pprMnemonic_ name =
1612    char '\t' <> ptext name <> space
1613
1614 pprMnemonic  :: LitString -> MachRep -> Doc
1615 pprMnemonic name size =
1616    char '\t' <> ptext name <> pprSize size <> space
1617
1618 pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
1619 pprSizeImmOp name size imm op1
1620   = hcat [
1621         pprMnemonic name size,
1622         char '$',
1623         pprImm imm,
1624         comma,
1625         pprOperand size op1
1626     ]
1627
1628 pprSizeOp :: LitString -> MachRep -> Operand -> Doc
1629 pprSizeOp name size op1
1630   = hcat [
1631         pprMnemonic name size,
1632         pprOperand size op1
1633     ]
1634
1635 pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1636 pprSizeOpOp name size op1 op2
1637   = hcat [
1638         pprMnemonic name size,
1639         pprOperand size op1,
1640         comma,
1641         pprOperand size op2
1642     ]
1643
1644 pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1645 pprOpOp name size op1 op2
1646   = hcat [
1647         pprMnemonic_ name,
1648         pprOperand size op1,
1649         comma,
1650         pprOperand size op2
1651     ]
1652
1653 pprSizeReg :: LitString -> MachRep -> Reg -> Doc
1654 pprSizeReg name size reg1
1655   = hcat [
1656         pprMnemonic name size,
1657         pprReg size reg1
1658     ]
1659
1660 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1661 pprSizeRegReg name size reg1 reg2
1662   = hcat [
1663         pprMnemonic name size,
1664         pprReg size reg1,
1665         comma,
1666         pprReg size reg2
1667     ]
1668
1669 pprRegReg :: LitString -> Reg -> Reg -> Doc
1670 pprRegReg name reg1 reg2
1671   = hcat [
1672         pprMnemonic_ name,
1673         pprReg wordRep reg1,
1674         comma,
1675         pprReg wordRep reg2
1676     ]
1677
1678 pprOpReg :: LitString -> Operand -> Reg -> Doc
1679 pprOpReg name op1 reg2
1680   = hcat [
1681         pprMnemonic_ name,
1682         pprOperand wordRep op1,
1683         comma,
1684         pprReg wordRep reg2
1685     ]
1686
1687 pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
1688 pprCondRegReg name size cond reg1 reg2
1689   = hcat [
1690         char '\t',
1691         ptext name,
1692         pprCond cond,
1693         space,
1694         pprReg size reg1,
1695         comma,
1696         pprReg size reg2
1697     ]
1698
1699 pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
1700 pprSizeSizeRegReg name size1 size2 reg1 reg2
1701   = hcat [
1702         char '\t',
1703         ptext name,
1704         pprSize size1,
1705         pprSize size2,
1706         space,
1707         pprReg size1 reg1,
1708
1709         comma,
1710         pprReg size2 reg2
1711     ]
1712
1713 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1714 pprSizeRegRegReg name size reg1 reg2 reg3
1715   = hcat [
1716         pprMnemonic name size,
1717         pprReg size reg1,
1718         comma,
1719         pprReg size reg2,
1720         comma,
1721         pprReg size reg3
1722     ]
1723
1724 pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
1725 pprSizeAddrReg name size op dst
1726   = hcat [
1727         pprMnemonic name size,
1728         pprAddr op,
1729         comma,
1730         pprReg size dst
1731     ]
1732
1733 pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
1734 pprSizeRegAddr name size src op
1735   = hcat [
1736         pprMnemonic name size,
1737         pprReg size src,
1738         comma,
1739         pprAddr op
1740     ]
1741
1742 pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
1743 pprShift name size src dest
1744   = hcat [
1745         pprMnemonic name size,
1746         pprOperand I8 src,  -- src is 8-bit sized
1747         comma,
1748         pprOperand size dest
1749     ]
1750
1751 pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
1752 pprSizeOpOpCoerce name size1 size2 op1 op2
1753   = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1754         pprOperand size1 op1,
1755         comma,
1756         pprOperand size2 op2
1757     ]
1758
1759 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1760 pprCondInstr name cond arg
1761   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1762
1763 #endif /* i386_TARGET_ARCH */
1764
1765
1766 -- ------------------------------------------------------------------------------- pprInstr for a SPARC
1767
1768 #if sparc_TARGET_ARCH
1769
1770 -- a clumsy hack for now, to handle possible double alignment problems
1771
1772 -- even clumsier, to allow for RegReg regs that show when doing indexed
1773 -- reads (bytearrays).
1774 --
1775
1776 -- Translate to the following:
1777 --    add g1,g2,g1
1778 --    ld  [g1],%fn
1779 --    ld  [g1+4],%f(n+1)
1780 --    sub g1,g2,g1           -- to restore g1
1781
1782 pprInstr (LD F64 (AddrRegReg g1 g2) reg)
1783   = vcat [
1784        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1785        hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1786        hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1787        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1788     ]
1789
1790 -- Translate to
1791 --    ld  [addr],%fn
1792 --    ld  [addr+4],%f(n+1)
1793 pprInstr (LD F64 addr reg) | isJust off_addr
1794   = vcat [
1795        hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1796        hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1797     ]
1798   where
1799     off_addr = addrOffset addr 4
1800     addr2 = case off_addr of Just x -> x
1801
1802
1803 pprInstr (LD size addr reg)
1804   = hcat [
1805        ptext SLIT("\tld"),
1806        pprSize size,
1807        char '\t',
1808        lbrack,
1809        pprAddr addr,
1810        pp_rbracket_comma,
1811        pprReg reg
1812     ]
1813
1814 -- The same clumsy hack as above
1815
1816 -- Translate to the following:
1817 --    add g1,g2,g1
1818 --    st  %fn,[g1]
1819 --    st  %f(n+1),[g1+4]
1820 --    sub g1,g2,g1           -- to restore g1
1821 pprInstr (ST F64 reg (AddrRegReg g1 g2))
1822  = vcat [
1823        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1824        hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1825              pprReg g1, rbrack],
1826        hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1827              pprReg g1, ptext SLIT("+4]")],
1828        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1829     ]
1830
1831 -- Translate to
1832 --    st  %fn,[addr]
1833 --    st  %f(n+1),[addr+4]
1834 pprInstr (ST F64 reg addr) | isJust off_addr
1835  = vcat [
1836       hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1837             pprAddr addr, rbrack],
1838       hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1839             pprAddr addr2, rbrack]
1840     ]
1841   where
1842     off_addr = addrOffset addr 4
1843     addr2 = case off_addr of Just x -> x
1844
1845 -- no distinction is made between signed and unsigned bytes on stores for the
1846 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1847 -- so we call a special-purpose pprSize for ST..
1848
1849 pprInstr (ST size reg addr)
1850   = hcat [
1851        ptext SLIT("\tst"),
1852        pprStSize size,
1853        char '\t',
1854        pprReg reg,
1855        pp_comma_lbracket,
1856        pprAddr addr,
1857        rbrack
1858     ]
1859
1860 pprInstr (ADD x cc reg1 ri reg2)
1861   | not x && not cc && riZero ri
1862   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1863   | otherwise
1864   = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1865
1866 pprInstr (SUB x cc reg1 ri reg2)
1867   | not x && cc && reg2 == g0
1868   = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1869   | not x && not cc && riZero ri
1870   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1871   | otherwise
1872   = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1873
1874 pprInstr (AND  b reg1 ri reg2) = pprRegRIReg SLIT("and")  b reg1 ri reg2
1875 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1876
1877 pprInstr (OR b reg1 ri reg2)
1878   | not b && reg1 == g0
1879   = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1880     in  case ri of
1881            RIReg rrr | rrr == reg2 -> empty
1882            other                   -> doit
1883   | otherwise
1884   = pprRegRIReg SLIT("or") b reg1 ri reg2
1885
1886 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1887
1888 pprInstr (XOR  b reg1 ri reg2) = pprRegRIReg SLIT("xor")  b reg1 ri reg2
1889 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1890
1891 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1892 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1893 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1894
1895 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1896 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul")  b reg1 ri reg2
1897 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul")  b reg1 ri reg2
1898
1899 pprInstr (SETHI imm reg)
1900   = hcat [
1901         ptext SLIT("\tsethi\t"),
1902         pprImm imm,
1903         comma,
1904         pprReg reg
1905     ]
1906
1907 pprInstr NOP = ptext SLIT("\tnop")
1908
1909 pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg SLIT("fabs") F32 reg1 reg2
1910 pprInstr (FABS F64 reg1 reg2)
1911   = (<>) (pprSizeRegReg SLIT("fabs") F32 reg1 reg2)
1912     (if (reg1 == reg2) then empty
1913      else (<>) (char '\n')
1914           (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1915
1916 pprInstr (FADD size reg1 reg2 reg3)
1917   = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1918 pprInstr (FCMP e size reg1 reg2)
1919   = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1920 pprInstr (FDIV size reg1 reg2 reg3)
1921   = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1922
1923 pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg SLIT("fmov") F32 reg1 reg2
1924 pprInstr (FMOV F64 reg1 reg2)
1925   = (<>) (pprSizeRegReg SLIT("fmov") F32 reg1 reg2)
1926     (if (reg1 == reg2) then empty
1927      else (<>) (char '\n')
1928           (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1929
1930 pprInstr (FMUL size reg1 reg2 reg3)
1931   = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1932
1933 pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg SLIT("fneg") F32 reg1 reg2
1934 pprInstr (FNEG F64 reg1 reg2)
1935   = (<>) (pprSizeRegReg SLIT("fneg") F32 reg1 reg2)
1936     (if (reg1 == reg2) then empty
1937      else (<>) (char '\n')
1938           (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1939
1940 pprInstr (FSQRT size reg1 reg2)     = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1941 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1942 pprInstr (FxTOy size1 size2 reg1 reg2)
1943   = hcat [
1944         ptext SLIT("\tf"),
1945         ptext
1946         (case size1 of
1947             I32  -> SLIT("ito")
1948             F32  -> SLIT("sto")
1949             F64  -> SLIT("dto")),
1950         ptext
1951         (case size2 of
1952             I32  -> SLIT("i\t")
1953             F32  -> SLIT("s\t")
1954             F64  -> SLIT("d\t")),
1955         pprReg reg1, comma, pprReg reg2
1956     ]
1957
1958
1959 pprInstr (BI cond b lab)
1960   = hcat [
1961         ptext SLIT("\tb"), pprCond cond,
1962         if b then pp_comma_a else empty,
1963         char '\t',
1964         pprImm lab
1965     ]
1966
1967 pprInstr (BF cond b lab)
1968   = hcat [
1969         ptext SLIT("\tfb"), pprCond cond,
1970         if b then pp_comma_a else empty,
1971         char '\t',
1972         pprImm lab
1973     ]
1974
1975 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1976
1977 pprInstr (CALL (Left imm) n _)
1978   = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1979 pprInstr (CALL (Right reg) n _)
1980   = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1981
1982 pprRI :: RI -> Doc
1983 pprRI (RIReg r) = pprReg r
1984 pprRI (RIImm r) = pprImm r
1985
1986 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1987 pprSizeRegReg name size reg1 reg2
1988   = hcat [
1989         char '\t',
1990         ptext name,
1991         (case size of
1992             F32  -> ptext SLIT("s\t")
1993             F64 -> ptext SLIT("d\t")),
1994         pprReg reg1,
1995         comma,
1996         pprReg reg2
1997     ]
1998
1999 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
2000 pprSizeRegRegReg name size reg1 reg2 reg3
2001   = hcat [
2002         char '\t',
2003         ptext name,
2004         (case size of
2005             F32  -> ptext SLIT("s\t")
2006             F64  -> ptext SLIT("d\t")),
2007         pprReg reg1,
2008         comma,
2009         pprReg reg2,
2010         comma,
2011         pprReg reg3
2012     ]
2013
2014 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
2015 pprRegRIReg name b reg1 ri reg2
2016   = hcat [
2017         char '\t',
2018         ptext name,
2019         if b then ptext SLIT("cc\t") else char '\t',
2020         pprReg reg1,
2021         comma,
2022         pprRI ri,
2023         comma,
2024         pprReg reg2
2025     ]
2026
2027 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
2028 pprRIReg name b ri reg1
2029   = hcat [
2030         char '\t',
2031         ptext name,
2032         if b then ptext SLIT("cc\t") else char '\t',
2033         pprRI ri,
2034         comma,
2035         pprReg reg1
2036     ]
2037
2038 pp_ld_lbracket    = ptext SLIT("\tld\t[")
2039 pp_rbracket_comma = text "],"
2040 pp_comma_lbracket = text ",["
2041 pp_comma_a        = text ",a"
2042
2043 #endif /* sparc_TARGET_ARCH */
2044
2045
2046 -- -----------------------------------------------------------------------------
2047 -- pprInstr for PowerPC
2048
2049 #if powerpc_TARGET_ARCH
2050 pprInstr (LD sz reg addr) = hcat [
2051         char '\t',
2052         ptext SLIT("l"),
2053         ptext (case sz of
2054             I8  -> SLIT("bz")
2055             I16 -> SLIT("hz")
2056             I32 -> SLIT("wz")
2057             F32 -> SLIT("fs")
2058             F64 -> SLIT("fd")),
2059         case addr of AddrRegImm _ _ -> empty
2060                      AddrRegReg _ _ -> char 'x',
2061         char '\t',
2062         pprReg reg,
2063         ptext SLIT(", "),
2064         pprAddr addr
2065     ]
2066 pprInstr (LA sz reg addr) = hcat [
2067         char '\t',
2068         ptext SLIT("l"),
2069         ptext (case sz of
2070             I8  -> SLIT("ba")
2071             I16 -> SLIT("ha")
2072             I32 -> SLIT("wa")
2073             F32 -> SLIT("fs")
2074             F64 -> SLIT("fd")),
2075         case addr of AddrRegImm _ _ -> empty
2076                      AddrRegReg _ _ -> char 'x',
2077         char '\t',
2078         pprReg reg,
2079         ptext SLIT(", "),
2080         pprAddr addr
2081     ]
2082 pprInstr (ST sz reg addr) = hcat [
2083         char '\t',
2084         ptext SLIT("st"),
2085         pprSize sz,
2086         case addr of AddrRegImm _ _ -> empty
2087                      AddrRegReg _ _ -> char 'x',
2088         char '\t',
2089         pprReg reg,
2090         ptext SLIT(", "),
2091         pprAddr addr
2092     ]
2093 pprInstr (STU sz reg addr) = hcat [
2094         char '\t',
2095         ptext SLIT("st"),
2096         pprSize sz,
2097         ptext SLIT("u\t"),
2098         case addr of AddrRegImm _ _ -> empty
2099                      AddrRegReg _ _ -> char 'x',
2100         pprReg reg,
2101         ptext SLIT(", "),
2102         pprAddr addr
2103     ]
2104 pprInstr (LIS reg imm) = hcat [
2105         char '\t',
2106         ptext SLIT("lis"),
2107         char '\t',
2108         pprReg reg,
2109         ptext SLIT(", "),
2110         pprImm imm
2111     ]
2112 pprInstr (LI reg imm) = hcat [
2113         char '\t',
2114         ptext SLIT("li"),
2115         char '\t',
2116         pprReg reg,
2117         ptext SLIT(", "),
2118         pprImm imm
2119     ]
2120 pprInstr (MR reg1 reg2)
2121     | reg1 == reg2 = empty
2122     | otherwise = hcat [
2123         char '\t',
2124         case regClass reg1 of
2125             RcInteger -> ptext SLIT("mr")
2126             _ -> ptext SLIT("fmr"),
2127         char '\t',
2128         pprReg reg1,
2129         ptext SLIT(", "),
2130         pprReg reg2
2131     ]
2132 pprInstr (CMP sz reg ri) = hcat [
2133         char '\t',
2134         op,
2135         char '\t',
2136         pprReg reg,
2137         ptext SLIT(", "),
2138         pprRI ri
2139     ]
2140     where
2141         op = hcat [
2142                 ptext SLIT("cmp"),
2143                 pprSize sz,
2144                 case ri of
2145                     RIReg _ -> empty
2146                     RIImm _ -> char 'i'
2147             ]
2148 pprInstr (CMPL sz reg ri) = hcat [
2149         char '\t',
2150         op,
2151         char '\t',
2152         pprReg reg,
2153         ptext SLIT(", "),
2154         pprRI ri
2155     ]
2156     where
2157         op = hcat [
2158                 ptext SLIT("cmpl"),
2159                 pprSize sz,
2160                 case ri of
2161                     RIReg _ -> empty
2162                     RIImm _ -> char 'i'
2163             ]
2164 pprInstr (BCC cond (BlockId id)) = hcat [
2165         char '\t',
2166         ptext SLIT("b"),
2167         pprCond cond,
2168         char '\t',
2169         pprCLabel_asm lbl
2170     ]
2171     where lbl = mkAsmTempLabel id
2172
2173 pprInstr (BCCFAR cond (BlockId id)) = vcat [
2174         hcat [
2175             ptext SLIT("\tb"),
2176             pprCond (condNegate cond),
2177             ptext SLIT("\t$+8")
2178         ],
2179         hcat [
2180             ptext SLIT("\tb\t"),
2181             pprCLabel_asm lbl
2182         ]
2183     ]
2184     where lbl = mkAsmTempLabel id
2185
2186 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
2187         char '\t',
2188         ptext SLIT("b"),
2189         char '\t',
2190         pprCLabel_asm lbl
2191     ]
2192
2193 pprInstr (MTCTR reg) = hcat [
2194         char '\t',
2195         ptext SLIT("mtctr"),
2196         char '\t',
2197         pprReg reg
2198     ]
2199 pprInstr (BCTR _) = hcat [
2200         char '\t',
2201         ptext SLIT("bctr")
2202     ]
2203 pprInstr (BL lbl _) = hcat [
2204         ptext SLIT("\tbl\t"),
2205         pprCLabel_asm lbl
2206     ]
2207 pprInstr (BCTRL _) = hcat [
2208         char '\t',
2209         ptext SLIT("bctrl")
2210     ]
2211 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
2212 pprInstr (ADDIS reg1 reg2 imm) = hcat [
2213         char '\t',
2214         ptext SLIT("addis"),
2215         char '\t',
2216         pprReg reg1,
2217         ptext SLIT(", "),
2218         pprReg reg2,
2219         ptext SLIT(", "),
2220         pprImm imm
2221     ]
2222
2223 pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
2224 pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
2225 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
2226 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
2227 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
2228 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
2229 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
2230
2231 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
2232          hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
2233                                           pprReg reg2, ptext SLIT(", "),
2234                                           pprReg reg3 ],
2235          hcat [ ptext SLIT("\tmfxer\t"),  pprReg reg1 ],
2236          hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
2237                                           pprReg reg1, ptext SLIT(", "),
2238                                           ptext SLIT("2, 31, 31") ]
2239     ]
2240
2241         -- for some reason, "andi" doesn't exist.
2242         -- we'll use "andi." instead.
2243 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
2244         char '\t',
2245         ptext SLIT("andi."),
2246         char '\t',
2247         pprReg reg1,
2248         ptext SLIT(", "),
2249         pprReg reg2,
2250         ptext SLIT(", "),
2251         pprImm imm
2252     ]
2253 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
2254
2255 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
2256 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
2257
2258 pprInstr (XORIS reg1 reg2 imm) = hcat [
2259         char '\t',
2260         ptext SLIT("xoris"),
2261         char '\t',
2262         pprReg reg1,
2263         ptext SLIT(", "),
2264         pprReg reg2,
2265         ptext SLIT(", "),
2266         pprImm imm
2267     ]
2268
2269 pprInstr (EXTS sz reg1 reg2) = hcat [
2270         char '\t',
2271         ptext SLIT("exts"),
2272         pprSize sz,
2273         char '\t',
2274         pprReg reg1,
2275         ptext SLIT(", "),
2276         pprReg reg2
2277     ]
2278
2279 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2280 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2281
2282 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
2283 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
2284 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
2285 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
2286         ptext SLIT("\trlwinm\t"),
2287         pprReg reg1,
2288         ptext SLIT(", "),
2289         pprReg reg2,
2290         ptext SLIT(", "),
2291         int sh,
2292         ptext SLIT(", "),
2293         int mb,
2294         ptext SLIT(", "),
2295         int me
2296     ]
2297
2298 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2299 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2300 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2301 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2302 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2303
2304 pprInstr (FCMP reg1 reg2) = hcat [
2305         char '\t',
2306         ptext SLIT("fcmpu\tcr0, "),
2307             -- Note: we're using fcmpu, not fcmpo
2308             -- The difference is with fcmpo, compare with NaN is an invalid operation.
2309             -- We don't handle invalid fp ops, so we don't care
2310         pprReg reg1,
2311         ptext SLIT(", "),
2312         pprReg reg2
2313     ]
2314
2315 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2316 pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
2317
2318 pprInstr (CRNOR dst src1 src2) = hcat [
2319         ptext SLIT("\tcrnor\t"),
2320         int dst,
2321         ptext SLIT(", "),
2322         int src1,
2323         ptext SLIT(", "),
2324         int src2
2325     ]
2326
2327 pprInstr (MFCR reg) = hcat [
2328         char '\t',
2329         ptext SLIT("mfcr"),
2330         char '\t',
2331         pprReg reg
2332     ]
2333
2334 pprInstr (MFLR reg) = hcat [
2335         char '\t',
2336         ptext SLIT("mflr"),
2337         char '\t',
2338         pprReg reg
2339     ]
2340
2341 pprInstr (FETCHPC reg) = vcat [
2342         ptext SLIT("\tbcl\t20,31,1f"),
2343         hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
2344     ]
2345
2346 pprInstr LWSYNC = ptext SLIT("\tlwsync")
2347
2348 pprInstr _ = panic "pprInstr (ppc)"
2349
2350 pprLogic op reg1 reg2 ri = hcat [
2351         char '\t',
2352         ptext op,
2353         case ri of
2354             RIReg _ -> empty
2355             RIImm _ -> char 'i',
2356         char '\t',
2357         pprReg reg1,
2358         ptext SLIT(", "),
2359         pprReg reg2,
2360         ptext SLIT(", "),
2361         pprRI ri
2362     ]
2363
2364 pprUnary op reg1 reg2 = hcat [
2365         char '\t',
2366         ptext op,
2367         char '\t',
2368         pprReg reg1,
2369         ptext SLIT(", "),
2370         pprReg reg2
2371     ]
2372
2373 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2374         char '\t',
2375         ptext op,
2376         pprFSize sz,
2377         char '\t',
2378         pprReg reg1,
2379         ptext SLIT(", "),
2380         pprReg reg2,
2381         ptext SLIT(", "),
2382         pprReg reg3
2383     ]
2384
2385 pprRI :: RI -> Doc
2386 pprRI (RIReg r) = pprReg r
2387 pprRI (RIImm r) = pprImm r
2388
2389 pprFSize F64 = empty
2390 pprFSize F32 = char 's'
2391
2392     -- limit immediate argument for shift instruction to range 0..32
2393     -- (yes, the maximum is really 32, not 31)
2394 limitShiftRI :: RI -> RI
2395 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
2396 limitShiftRI x = x
2397
2398 #endif /* powerpc_TARGET_ARCH */
2399
2400
2401 -- -----------------------------------------------------------------------------
2402 -- Converting floating-point literals to integrals for printing
2403
2404 castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2405 castFloatToWord8Array = castSTUArray
2406
2407 castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2408 castDoubleToWord8Array = castSTUArray
2409
2410 -- floatToBytes and doubleToBytes convert to the host's byte
2411 -- order.  Providing that we're not cross-compiling for a
2412 -- target with the opposite endianness, this should work ok
2413 -- on all targets.
2414
2415 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2416 -- could they be merged?
2417
2418 floatToBytes :: Float -> [Int]
2419 floatToBytes f
2420    = runST (do
2421         arr <- newArray_ ((0::Int),3)
2422         writeArray arr 0 f
2423         arr <- castFloatToWord8Array arr
2424         i0 <- readArray arr 0
2425         i1 <- readArray arr 1
2426         i2 <- readArray arr 2
2427         i3 <- readArray arr 3
2428         return (map fromIntegral [i0,i1,i2,i3])
2429      )
2430
2431 doubleToBytes :: Double -> [Int]
2432 doubleToBytes d
2433    = runST (do
2434         arr <- newArray_ ((0::Int),7)
2435         writeArray arr 0 d
2436         arr <- castDoubleToWord8Array arr
2437         i0 <- readArray arr 0
2438         i1 <- readArray arr 1
2439         i2 <- readArray arr 2
2440         i3 <- readArray arr 3
2441         i4 <- readArray arr 4
2442         i5 <- readArray arr 5
2443         i6 <- readArray arr 6
2444         i7 <- readArray arr 7
2445         return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])
2446      )