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 #if linux_TARGET_OS
 698   | not (externallyVisibleCLabel lbl) = empty
 699   | otherwise = ptext SLIT(".type ") <>
 700                 pprCLabel_asm lbl <> ptext SLIT(", @object")
 701 #else
 702   = empty
 703 #endif
 704
 705 pprLabel :: CLabel -> Doc
 706 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
 707
 708
 709 pprASCII str
 710   = vcat (map do1 str) $$ do1 0
 711     where
 712        do1 :: Word8 -> Doc
 713        do1 w = ptext SLIT("\t.byte\t") <> int (fromIntegral w)
 714
 715 pprAlign bytes =
 716         IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
 717         IF_ARCH_i386(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
 718         IF_ARCH_x86_64(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
 719         IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
 720         IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))))
 721   where
 722         pow2 = log2 bytes
 723
 724         log2 :: Int -> Int  -- cache the common ones
 725         log2 1 = 0
 726         log2 2 = 1
 727         log2 4 = 2
 728         log2 8 = 3
 729         log2 n = 1 + log2 (n `quot` 2)
 730
 731
 732 pprDataItem :: CmmLit -> Doc
 733 pprDataItem lit
 734   = vcat (ppr_item (cmmLitRep lit) lit)
 735     where
 736         imm = litToImm lit
 737
 738         -- These seem to be common:
 739         ppr_item I8   x = [ptext SLIT("\t.byte\t") <> pprImm imm]
 740         ppr_item I32  x = [ptext SLIT("\t.long\t") <> pprImm imm]
 741         ppr_item F32  (CmmFloat r _)
 742            = let bs = floatToBytes (fromRational r)
 743              in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
 744         ppr_item F64 (CmmFloat r _)
 745            = let bs = doubleToBytes (fromRational r)
 746              in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
 747
 748 #if sparc_TARGET_ARCH
 749         -- copy n paste of x86 version
 750         ppr_item I16  x = [ptext SLIT("\t.short\t") <> pprImm imm]
 751         ppr_item I64  x = [ptext SLIT("\t.quad\t") <> pprImm imm]
 752 #endif
 753 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 754         ppr_item I16  x = [ptext SLIT("\t.word\t") <> pprImm imm]
 755 #endif
 756 #if i386_TARGET_ARCH && darwin_TARGET_OS
 757         ppr_item I64 (CmmInt x _)  =
 758                 [ptext SLIT("\t.long\t")
 759                     <> int (fromIntegral (fromIntegral x :: Word32)),
 760                  ptext SLIT("\t.long\t")
 761                     <> int (fromIntegral
 762                         (fromIntegral (x `shiftR` 32) :: Word32))]
 763 #endif
 764 #if i386_TARGET_ARCH || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
 765         ppr_item I64  x = [ptext SLIT("\t.quad\t") <> pprImm imm]
 766 #endif
 767 #if x86_64_TARGET_ARCH && !darwin_TARGET_OS
 768         -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
 769         -- type, which means we can't do pc-relative 64-bit addresses.
 770         -- Fortunately we're assuming the small memory model, in which
 771         -- all such offsets will fit into 32 bits, so we have to stick
 772         -- to 32-bit offset fields and modify the RTS appropriately
 773         --
 774         -- See Note [x86-64-relative] in includes/InfoTables.h
 775         --
 776         ppr_item I64  x
 777            | isRelativeReloc x =
 778                 [ptext SLIT("\t.long\t") <> pprImm imm,
 779                  ptext SLIT("\t.long\t0")]
 780            | otherwise =
 781                 [ptext SLIT("\t.quad\t") <> pprImm imm]
 782            where
 783                 isRelativeReloc (CmmLabelDiffOff _ _ _) = True
 784                 isRelativeReloc _ = False
 785 #endif
 786 #if powerpc_TARGET_ARCH
 787         ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
 788         ppr_item I64 (CmmInt x _)  =
 789                 [ptext SLIT("\t.long\t")
 790                     <> int (fromIntegral
 791                         (fromIntegral (x `shiftR` 32) :: Word32)),
 792                  ptext SLIT("\t.long\t")
 793                     <> int (fromIntegral (fromIntegral x :: Word32))]
 794 #endif
 795
 796 -- fall through to rest of (machine-specific) pprInstr...
 797
 798 -- -----------------------------------------------------------------------------
 799 -- pprInstr: print an 'Instr'
 800
 801 pprInstr :: Instr -> Doc
 802
 803 --pprInstr (COMMENT s) = empty -- nuke 'em
 804 pprInstr (COMMENT s)
 805    =  IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
 806      ,IF_ARCH_sparc( ((<>) (ptext SLIT("! "))   (ftext s))
 807      ,IF_ARCH_i386( ((<>) (ptext SLIT("# "))   (ftext s))
 808      ,IF_ARCH_x86_64( ((<>) (ptext SLIT("# "))   (ftext s))
 809      ,IF_ARCH_powerpc( IF_OS_linux(
 810         ((<>) (ptext SLIT("# ")) (ftext s)),
 811         ((<>) (ptext SLIT("; ")) (ftext s)))
 812      ,)))))
 813
 814 pprInstr (DELTA d)
 815    = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
 816
 817 pprInstr (NEWBLOCK _)
 818    = panic "PprMach.pprInstr: NEWBLOCK"
 819
 820 pprInstr (LDATA _ _)
 821    = panic "PprMach.pprInstr: LDATA"
 822
 823 -- -----------------------------------------------------------------------------
 824 -- pprInstr for an Alpha
 825
 826 #if alpha_TARGET_ARCH
 827
 828 pprInstr (LD size reg addr)
 829   = hcat [
 830         ptext SLIT("\tld"),
 831         pprSize size,
 832         char '\t',
 833         pprReg reg,
 834         comma,
 835         pprAddr addr
 836     ]
 837
 838 pprInstr (LDA reg addr)
 839   = hcat [
 840         ptext SLIT("\tlda\t"),
 841         pprReg reg,
 842         comma,
 843         pprAddr addr
 844     ]
 845
 846 pprInstr (LDAH reg addr)
 847   = hcat [
 848         ptext SLIT("\tldah\t"),
 849         pprReg reg,
 850         comma,
 851         pprAddr addr
 852     ]
 853
 854 pprInstr (LDGP reg addr)
 855   = hcat [
 856         ptext SLIT("\tldgp\t"),
 857         pprReg reg,
 858         comma,
 859         pprAddr addr
 860     ]
 861
 862 pprInstr (LDI size reg imm)
 863   = hcat [
 864         ptext SLIT("\tldi"),
 865         pprSize size,
 866         char '\t',
 867         pprReg reg,
 868         comma,
 869         pprImm imm
 870     ]
 871
 872 pprInstr (ST size reg addr)
 873   = hcat [
 874         ptext SLIT("\tst"),
 875         pprSize size,
 876         char '\t',
 877         pprReg reg,
 878         comma,
 879         pprAddr addr
 880     ]
 881
 882 pprInstr (CLR reg)
 883   = hcat [
 884         ptext SLIT("\tclr\t"),
 885         pprReg reg
 886     ]
 887
 888 pprInstr (ABS size ri reg)
 889   = hcat [
 890         ptext SLIT("\tabs"),
 891         pprSize size,
 892         char '\t',
 893         pprRI ri,
 894         comma,
 895         pprReg reg
 896     ]
 897
 898 pprInstr (NEG size ov ri reg)
 899   = hcat [
 900         ptext SLIT("\tneg"),
 901         pprSize size,
 902         if ov then ptext SLIT("v\t") else char '\t',
 903         pprRI ri,
 904         comma,
 905         pprReg reg
 906     ]
 907
 908 pprInstr (ADD size ov reg1 ri reg2)
 909   = hcat [
 910         ptext SLIT("\tadd"),
 911         pprSize size,
 912         if ov then ptext SLIT("v\t") else char '\t',
 913         pprReg reg1,
 914         comma,
 915         pprRI ri,
 916         comma,
 917         pprReg reg2
 918     ]
 919
 920 pprInstr (SADD size scale reg1 ri reg2)
 921   = hcat [
 922         ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
 923         ptext SLIT("add"),
 924         pprSize size,
 925         char '\t',
 926         pprReg reg1,
 927         comma,
 928         pprRI ri,
 929         comma,
 930         pprReg reg2
 931     ]
 932
 933 pprInstr (SUB size ov reg1 ri reg2)
 934   = hcat [
 935         ptext SLIT("\tsub"),
 936         pprSize size,
 937         if ov then ptext SLIT("v\t") else char '\t',
 938         pprReg reg1,
 939         comma,
 940         pprRI ri,
 941         comma,
 942         pprReg reg2
 943     ]
 944
 945 pprInstr (SSUB size scale reg1 ri reg2)
 946   = hcat [
 947         ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
 948         ptext SLIT("sub"),
 949         pprSize size,
 950         char '\t',
 951         pprReg reg1,
 952         comma,
 953         pprRI ri,
 954         comma,
 955         pprReg reg2
 956     ]
 957
 958 pprInstr (MUL size ov reg1 ri reg2)
 959   = hcat [
 960         ptext SLIT("\tmul"),
 961         pprSize size,
 962         if ov then ptext SLIT("v\t") else char '\t',
 963         pprReg reg1,
 964         comma,
 965         pprRI ri,
 966         comma,
 967         pprReg reg2
 968     ]
 969
 970 pprInstr (DIV size uns reg1 ri reg2)
 971   = hcat [
 972         ptext SLIT("\tdiv"),
 973         pprSize size,
 974         if uns then ptext SLIT("u\t") else char '\t',
 975         pprReg reg1,
 976         comma,
 977         pprRI ri,
 978         comma,
 979         pprReg reg2
 980     ]
 981
 982 pprInstr (REM size uns reg1 ri reg2)
 983   = hcat [
 984         ptext SLIT("\trem"),
 985         pprSize size,
 986         if uns then ptext SLIT("u\t") else char '\t',
 987         pprReg reg1,
 988         comma,
 989         pprRI ri,
 990         comma,
 991         pprReg reg2
 992     ]
 993
 994 pprInstr (NOT ri reg)
 995   = hcat [
 996         ptext SLIT("\tnot"),
 997         char '\t',
 998         pprRI ri,
 999         comma,
1000         pprReg reg
1001     ]
1002
1003 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
1004 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
1005 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
1006 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
1007 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
1008 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
1009
1010 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
1011 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
1012 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
1013
1014 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
1015 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
1016
1017 pprInstr (NOP) = ptext SLIT("\tnop")
1018
1019 pprInstr (CMP cond reg1 ri reg2)
1020   = hcat [
1021         ptext SLIT("\tcmp"),
1022         pprCond cond,
1023         char '\t',
1024         pprReg reg1,
1025         comma,
1026         pprRI ri,
1027         comma,
1028         pprReg reg2
1029     ]
1030
1031 pprInstr (FCLR reg)
1032   = hcat [
1033         ptext SLIT("\tfclr\t"),
1034         pprReg reg
1035     ]
1036
1037 pprInstr (FABS reg1 reg2)
1038   = hcat [
1039         ptext SLIT("\tfabs\t"),
1040         pprReg reg1,
1041         comma,
1042         pprReg reg2
1043     ]
1044
1045 pprInstr (FNEG size reg1 reg2)
1046   = hcat [
1047         ptext SLIT("\tneg"),
1048         pprSize size,
1049         char '\t',
1050         pprReg reg1,
1051         comma,
1052         pprReg reg2
1053     ]
1054
1055 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
1056 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
1057 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
1058 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
1059
1060 pprInstr (CVTxy size1 size2 reg1 reg2)
1061   = hcat [
1062         ptext SLIT("\tcvt"),
1063         pprSize size1,
1064         case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
1065         char '\t',
1066         pprReg reg1,
1067         comma,
1068         pprReg reg2
1069     ]
1070
1071 pprInstr (FCMP size cond reg1 reg2 reg3)
1072   = hcat [
1073         ptext SLIT("\tcmp"),
1074         pprSize size,
1075         pprCond cond,
1076         char '\t',
1077         pprReg reg1,
1078         comma,
1079         pprReg reg2,
1080         comma,
1081         pprReg reg3
1082     ]
1083
1084 pprInstr (FMOV reg1 reg2)
1085   = hcat [
1086         ptext SLIT("\tfmov\t"),
1087         pprReg reg1,
1088         comma,
1089         pprReg reg2
1090     ]
1091
1092 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
1093
1094 pprInstr (BI NEVER reg lab) = empty
1095
1096 pprInstr (BI cond reg lab)
1097   = hcat [
1098         ptext SLIT("\tb"),
1099         pprCond cond,
1100         char '\t',
1101         pprReg reg,
1102         comma,
1103         pprImm lab
1104     ]
1105
1106 pprInstr (BF cond reg lab)
1107   = hcat [
1108         ptext SLIT("\tfb"),
1109         pprCond cond,
1110         char '\t',
1111         pprReg reg,
1112         comma,
1113         pprImm lab
1114     ]
1115
1116 pprInstr (BR lab)
1117   = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
1118
1119 pprInstr (JMP reg addr hint)
1120   = hcat [
1121         ptext SLIT("\tjmp\t"),
1122         pprReg reg,
1123         comma,
1124         pprAddr addr,
1125         comma,
1126         int hint
1127     ]
1128
1129 pprInstr (BSR imm n)
1130   = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
1131
1132 pprInstr (JSR reg addr n)
1133   = hcat [
1134         ptext SLIT("\tjsr\t"),
1135         pprReg reg,
1136         comma,
1137         pprAddr addr
1138     ]
1139
1140 pprInstr (FUNBEGIN clab)
1141   = hcat [
1142         if (externallyVisibleCLabel clab) then
1143             hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
1144         else
1145             empty,
1146         ptext SLIT("\t.ent "),
1147         pp_lab,
1148         char '\n',
1149         pp_lab,
1150         pp_ldgp,
1151         pp_lab,
1152         pp_frame
1153     ]
1154     where
1155         pp_lab = pprCLabel_asm clab
1156
1157         -- NEVER use commas within those string literals, cpp will ruin your day
1158         pp_ldgp  = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
1159         pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
1160                           ptext SLIT("4240"), char ',',
1161                           ptext SLIT("$26"), char ',',
1162                           ptext SLIT("0\n\t.prologue 1") ]
1163
1164 pprInstr (FUNEND clab)
1165   = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
1166 \end{code}
1167
1168 Continue with Alpha-only printing bits and bobs:
1169 \begin{code}
1170 pprRI :: RI -> Doc
1171
1172 pprRI (RIReg r) = pprReg r
1173 pprRI (RIImm r) = pprImm r
1174
1175 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
1176 pprRegRIReg name reg1 ri reg2
1177   = hcat [
1178         char '\t',
1179         ptext name,
1180         char '\t',
1181         pprReg reg1,
1182         comma,
1183         pprRI ri,
1184         comma,
1185         pprReg reg2
1186     ]
1187
1188 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1189 pprSizeRegRegReg name size reg1 reg2 reg3
1190   = hcat [
1191         char '\t',
1192         ptext name,
1193         pprSize size,
1194         char '\t',
1195         pprReg reg1,
1196         comma,
1197         pprReg reg2,
1198         comma,
1199         pprReg reg3
1200     ]
1201
1202 #endif /* alpha_TARGET_ARCH */
1203
1204
1205 -- -----------------------------------------------------------------------------
1206 -- pprInstr for an x86
1207
1208 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1209
1210 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
1211   | src == dst
1212   =
1213 #if 0 /* #ifdef DEBUG */
1214     (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
1215 #else
1216     empty
1217 #endif
1218
1219 pprInstr (MOV size src dst)
1220   = pprSizeOpOp SLIT("mov") size src dst
1221
1222 pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
1223         -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
1224         -- movl.  But we represent it as a MOVZxL instruction, because
1225         -- the reg alloc would tend to throw away a plain reg-to-reg
1226         -- move, and we still want it to do that.
1227
1228 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 src dst
1229         -- zero-extension only needs to extend to 32 bits: on x86_64,
1230         -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
1231         -- instruction is shorter.
1232
1233 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
1234
1235 -- here we do some patching, since the physical registers are only set late
1236 -- in the code generation.
1237 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1238   | reg1 == reg3
1239   = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1240 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1241   | reg2 == reg3
1242   = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1243 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
1244   | reg1 == reg3
1245   = pprInstr (ADD size (OpImm displ) dst)
1246 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1247
1248 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1249   = pprSizeOp SLIT("dec") size dst
1250 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1251   = pprSizeOp SLIT("inc") size dst
1252 pprInstr (ADD size src dst)
1253   = pprSizeOpOp SLIT("add") size src dst
1254 pprInstr (ADC size src dst)
1255   = pprSizeOpOp SLIT("adc") size src dst
1256 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1257 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1258
1259 {- A hack.  The Intel documentation says that "The two and three
1260    operand forms [of IMUL] may also be used with unsigned operands
1261    because the lower half of the product is the same regardless if
1262    (sic) the operands are signed or unsigned.  The CF and OF flags,
1263    however, cannot be used to determine if the upper half of the
1264    result is non-zero."  So there.
1265 -}
1266 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1267 pprInstr (OR  size src dst) = pprSizeOpOp SLIT("or")  size src dst
1268
1269 pprInstr (XOR F32 src dst)  = pprOpOp SLIT("xorps") F32 src dst
1270 pprInstr (XOR F64 src dst)  = pprOpOp SLIT("xorpd") F64 src dst
1271 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor")  size src dst
1272
1273 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1274 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1275
1276 pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
1277 pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
1278 pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
1279
1280 pprInstr (BT  size imm src) = pprSizeImmOp SLIT("bt") size imm src
1281
1282 pprInstr (CMP size src dst)
1283   | isFloatingRep size =  pprSizeOpOp SLIT("ucomi")  size src dst -- SSE2
1284   | otherwise          =  pprSizeOpOp SLIT("cmp")  size src dst
1285
1286 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test")  size src dst
1287 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1288 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1289
1290 -- both unused (SDM):
1291 -- pprInstr PUSHA = ptext SLIT("\tpushal")
1292 -- pprInstr POPA = ptext SLIT("\tpopal")
1293
1294 pprInstr NOP = ptext SLIT("\tnop")
1295 pprInstr (CLTD I32) = ptext SLIT("\tcltd")
1296 pprInstr (CLTD I64) = ptext SLIT("\tcqto")
1297
1298 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
1299
1300 pprInstr (JXX cond (BlockId id))
1301   = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1302   where lab = mkAsmTempLabel id
1303
1304 pprInstr (JXX_GBL cond imm) = pprCondInstr SLIT("j") cond (pprImm imm)
1305
1306 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1307 pprInstr (JMP op)          = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
1308 pprInstr (JMP_TBL op ids)  = pprInstr (JMP op)
1309 pprInstr (CALL (Left imm) _)    = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1310 pprInstr (CALL (Right reg) _)   = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
1311
1312 pprInstr (IDIV sz op)   = pprSizeOp SLIT("idiv") sz op
1313 pprInstr (DIV sz op)    = pprSizeOp SLIT("div")  sz op
1314 pprInstr (IMUL2 sz op)  = pprSizeOp SLIT("imul") sz op
1315
1316 #if x86_64_TARGET_ARCH
1317 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
1318
1319 pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
1320
1321 pprInstr (CVTSS2SD from to)   = pprRegReg SLIT("cvtss2sd") from to
1322 pprInstr (CVTSD2SS from to)   = pprRegReg SLIT("cvtsd2ss") from to
1323 pprInstr (CVTTSS2SIQ from to) = pprOpReg  SLIT("cvttss2siq") from to
1324 pprInstr (CVTTSD2SIQ from to) = pprOpReg  SLIT("cvttsd2siq") from to
1325 pprInstr (CVTSI2SS from to)   = pprOpReg  SLIT("cvtsi2ssq") from to
1326 pprInstr (CVTSI2SD from to)   = pprOpReg  SLIT("cvtsi2sdq") from to
1327 #endif
1328
1329     -- FETCHGOT for PIC on ELF platforms
1330 pprInstr (FETCHGOT reg)
1331    = vcat [ ptext SLIT("\tcall 1f"),
1332             hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
1333             hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
1334                    pprReg I32 reg ]
1335           ]
1336
1337     -- FETCHPC for PIC on Darwin/x86
1338     -- get the instruction pointer into a register
1339     -- (Terminology note: the IP is called Program Counter on PPC,
1340     --  and it's a good thing to use the same name on both platforms)
1341 pprInstr (FETCHPC reg)
1342    = vcat [ ptext SLIT("\tcall 1f"),
1343             hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ]
1344           ]
1345
1346
1347
1348 #endif
1349
1350 -- -----------------------------------------------------------------------------
1351 -- i386 floating-point
1352
1353 #if i386_TARGET_ARCH
1354 -- Simulating a flat register set on the x86 FP stack is tricky.
1355 -- you have to free %st(7) before pushing anything on the FP reg stack
1356 -- so as to preclude the possibility of a FP stack overflow exception.
1357 pprInstr g@(GMOV src dst)
1358    | src == dst
1359    = empty
1360    | otherwise
1361    = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1362
1363 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1364 pprInstr g@(GLD sz addr dst)
1365  = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1366                  pprAddr addr, gsemi, gpop dst 1])
1367
1368 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1369 pprInstr g@(GST sz src addr)
1370  = pprG g (hcat [gtab, gpush src 0, gsemi,
1371                  text "fstp", pprSize sz, gsp, pprAddr addr])
1372
1373 pprInstr g@(GLDZ dst)
1374  = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1375 pprInstr g@(GLD1 dst)
1376  = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1377
1378 pprInstr g@(GFTOI src dst)
1379    = pprInstr (GDTOI src dst)
1380 pprInstr g@(GDTOI src dst)
1381    = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1382                    gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1383                    pprReg I32 dst])
1384
1385 pprInstr g@(GITOF src dst)
1386    = pprInstr (GITOD src dst)
1387 pprInstr g@(GITOD src dst)
1388    = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
1389                    text " ; ffree %st(7); fildl (%esp) ; ",
1390                    gpop dst 1, text " ; addl $4,%esp"])
1391
1392 {- Gruesome swamp follows.  If you're unfortunate enough to have ventured
1393    this far into the jungle AND you give a Rat's Ass (tm) what's going
1394    on, here's the deal.  Generate code to do a floating point comparison
1395    of src1 and src2, of kind cond, and set the Zero flag if true.
1396
1397    The complications are to do with handling NaNs correctly.  We want the
1398    property that if either argument is NaN, then the result of the
1399    comparison is False ... except if we're comparing for inequality,
1400    in which case the answer is True.
1401
1402    Here's how the general (non-inequality) case works.  As an
1403    example, consider generating the an equality test:
1404
1405      pushl %eax         -- we need to mess with this
1406      <get src1 to top of FPU stack>
1407      fcomp <src2 location in FPU stack> and pop pushed src1
1408                 -- Result of comparison is in FPU Status Register bits
1409                 -- C3 C2 and C0
1410      fstsw %ax  -- Move FPU Status Reg to %ax
1411      sahf       -- move C3 C2 C0 from %ax to integer flag reg
1412      -- now the serious magic begins
1413      setpo %ah     -- %ah = if comparable(neither arg was NaN) then 1 else 0
1414      sete  %al     -- %al = if arg1 == arg2 then 1 else 0
1415      andb %ah,%al  -- %al &= %ah
1416                    -- so %al == 1 iff (comparable && same); else it holds 0
1417      decb %al      -- %al == 0, ZeroFlag=1  iff (comparable && same);
1418                       else %al == 0xFF, ZeroFlag=0
1419      -- the zero flag is now set as we desire.
1420      popl %eax
1421
1422    The special case of inequality differs thusly:
1423
1424      setpe %ah     -- %ah = if incomparable(either arg was NaN) then 1 else 0
1425      setne %al     -- %al = if arg1 /= arg2 then 1 else 0
1426      orb %ah,%al   -- %al = if (incomparable || different) then 1 else 0
1427      decb %al      -- if (incomparable || different) then (%al == 0, ZF=1)
1428                                                      else (%al == 0xFF, ZF=0)
1429 -}
1430 pprInstr g@(GCMP cond src1 src2)
1431    | case cond of { NE -> True; other -> False }
1432    = pprG g (vcat [
1433         hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1434         hcat [gtab, text "fcomp ", greg src2 1,
1435                     text "; fstsw %ax ; sahf ;  setpe %ah"],
1436         hcat [gtab, text "setne %al ;  ",
1437               text "orb %ah,%al ;  decb %al ;  popl %eax"]
1438     ])
1439    | otherwise
1440    = pprG g (vcat [
1441         hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1442         hcat [gtab, text "fcomp ", greg src2 1,
1443                     text "; fstsw %ax ; sahf ;  setpo %ah"],
1444         hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ;  ",
1445               text "andb %ah,%al ;  decb %al ;  popl %eax"]
1446     ])
1447     where
1448         {- On the 486, the flags set by FP compare are the unsigned ones!
1449            (This looks like a HACK to me.  WDP 96/03)
1450         -}
1451         fix_FP_cond :: Cond -> Cond
1452         fix_FP_cond GE   = GEU
1453         fix_FP_cond GTT  = GU
1454         fix_FP_cond LTT  = LU
1455         fix_FP_cond LE   = LEU
1456         fix_FP_cond EQQ  = EQQ
1457         fix_FP_cond NE   = NE
1458         -- there should be no others
1459
1460
1461 pprInstr g@(GABS sz src dst)
1462    = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1463 pprInstr g@(GNEG sz src dst)
1464    = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1465
1466 pprInstr g@(GSQRT sz src dst)
1467    = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1468              hcat [gtab, gcoerceto sz, gpop dst 1])
1469 pprInstr g@(GSIN sz src dst)
1470    = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1471              hcat [gtab, gcoerceto sz, gpop dst 1])
1472 pprInstr g@(GCOS sz src dst)
1473    = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1474              hcat [gtab, gcoerceto sz, gpop dst 1])
1475 pprInstr g@(GTAN sz src dst)
1476    = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1477                    gpush src 0, text " ; fptan ; ",
1478                    text " fstp %st(0)"] $$
1479              hcat [gtab, gcoerceto sz, gpop dst 1])
1480
1481 -- In the translations for GADD, GMUL, GSUB and GDIV,
1482 -- the first two cases are mere optimisations.  The otherwise clause
1483 -- generates correct code under all circumstances.
1484
1485 pprInstr g@(GADD sz src1 src2 dst)
1486    | src1 == dst
1487    = pprG g (text "\t#GADD-xxxcase1" $$
1488              hcat [gtab, gpush src2 0,
1489                    text " ; faddp %st(0),", greg src1 1])
1490    | src2 == dst
1491    = pprG g (text "\t#GADD-xxxcase2" $$
1492              hcat [gtab, gpush src1 0,
1493                    text " ; faddp %st(0),", greg src2 1])
1494    | otherwise
1495    = pprG g (hcat [gtab, gpush src1 0,
1496                    text " ; fadd ", greg src2 1, text ",%st(0)",
1497                    gsemi, gpop dst 1])
1498
1499
1500 pprInstr g@(GMUL sz src1 src2 dst)
1501    | src1 == dst
1502    = pprG g (text "\t#GMUL-xxxcase1" $$
1503              hcat [gtab, gpush src2 0,
1504                    text " ; fmulp %st(0),", greg src1 1])
1505    | src2 == dst
1506    = pprG g (text "\t#GMUL-xxxcase2" $$
1507              hcat [gtab, gpush src1 0,
1508                    text " ; fmulp %st(0),", greg src2 1])
1509    | otherwise
1510    = pprG g (hcat [gtab, gpush src1 0,
1511                    text " ; fmul ", greg src2 1, text ",%st(0)",
1512                    gsemi, gpop dst 1])
1513
1514
1515 pprInstr g@(GSUB sz src1 src2 dst)
1516    | src1 == dst
1517    = pprG g (text "\t#GSUB-xxxcase1" $$
1518              hcat [gtab, gpush src2 0,
1519                    text " ; fsubrp %st(0),", greg src1 1])
1520    | src2 == dst
1521    = pprG g (text "\t#GSUB-xxxcase2" $$
1522              hcat [gtab, gpush src1 0,
1523                    text " ; fsubp %st(0),", greg src2 1])
1524    | otherwise
1525    = pprG g (hcat [gtab, gpush src1 0,
1526                    text " ; fsub ", greg src2 1, text ",%st(0)",
1527                    gsemi, gpop dst 1])
1528
1529
1530 pprInstr g@(GDIV sz src1 src2 dst)
1531    | src1 == dst
1532    = pprG g (text "\t#GDIV-xxxcase1" $$
1533              hcat [gtab, gpush src2 0,
1534                    text " ; fdivrp %st(0),", greg src1 1])
1535    | src2 == dst
1536    = pprG g (text "\t#GDIV-xxxcase2" $$
1537              hcat [gtab, gpush src1 0,
1538                    text " ; fdivp %st(0),", greg src2 1])
1539    | otherwise
1540    = pprG g (hcat [gtab, gpush src1 0,
1541                    text " ; fdiv ", greg src2 1, text ",%st(0)",
1542                    gsemi, gpop dst 1])
1543
1544
1545 pprInstr GFREE
1546    = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1547             ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1548           ]
1549
1550 --------------------------
1551
1552 -- coerce %st(0) to the specified size
1553 gcoerceto F64 = empty
1554 gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1555
1556 gpush reg offset
1557    = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1558 gpop reg offset
1559    = hcat [text "fstp ", greg reg offset]
1560
1561 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1562 gsemi = text " ; "
1563 gtab  = char '\t'
1564 gsp   = char ' '
1565
1566 gregno (RealReg i) = i
1567 gregno other       = --pprPanic "gregno" (ppr other)
1568                      999   -- bogus; only needed for debug printing
1569
1570 pprG :: Instr -> Doc -> Doc
1571 pprG fake actual
1572    = (char '#' <> pprGInstr fake) $$ actual
1573
1574 pprGInstr (GMOV src dst)   = pprSizeRegReg SLIT("gmov") F64 src dst
1575 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1576 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1577
1578 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
1579 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
1580
1581 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32  src dst
1582 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
1583
1584 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32  src dst
1585 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
1586
1587 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
1588 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1589 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1590 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1591 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1592 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1593 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1594
1595 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1596 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1597 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1598 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1599 #endif
1600
1601 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1602
1603 -- Continue with I386-only printing bits and bobs:
1604
1605 pprDollImm :: Imm -> Doc
1606
1607 pprDollImm i =  ptext SLIT("$") <> pprImm i
1608
1609 pprOperand :: MachRep -> Operand -> Doc
1610 pprOperand s (OpReg r)   = pprReg s r
1611 pprOperand s (OpImm i)   = pprDollImm i
1612 pprOperand s (OpAddr ea) = pprAddr ea
1613
1614 pprMnemonic_  :: LitString -> Doc
1615 pprMnemonic_ name =
1616    char '\t' <> ptext name <> space
1617
1618 pprMnemonic  :: LitString -> MachRep -> Doc
1619 pprMnemonic name size =
1620    char '\t' <> ptext name <> pprSize size <> space
1621
1622 pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
1623 pprSizeImmOp name size imm op1
1624   = hcat [
1625         pprMnemonic name size,
1626         char '$',
1627         pprImm imm,
1628         comma,
1629         pprOperand size op1
1630     ]
1631
1632 pprSizeOp :: LitString -> MachRep -> Operand -> Doc
1633 pprSizeOp name size op1
1634   = hcat [
1635         pprMnemonic name size,
1636         pprOperand size op1
1637     ]
1638
1639 pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1640 pprSizeOpOp name size op1 op2
1641   = hcat [
1642         pprMnemonic name size,
1643         pprOperand size op1,
1644         comma,
1645         pprOperand size op2
1646     ]
1647
1648 pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1649 pprOpOp name size op1 op2
1650   = hcat [
1651         pprMnemonic_ name,
1652         pprOperand size op1,
1653         comma,
1654         pprOperand size op2
1655     ]
1656
1657 pprSizeReg :: LitString -> MachRep -> Reg -> Doc
1658 pprSizeReg name size reg1
1659   = hcat [
1660         pprMnemonic name size,
1661         pprReg size reg1
1662     ]
1663
1664 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1665 pprSizeRegReg name size reg1 reg2
1666   = hcat [
1667         pprMnemonic name size,
1668         pprReg size reg1,
1669         comma,
1670         pprReg size reg2
1671     ]
1672
1673 pprRegReg :: LitString -> Reg -> Reg -> Doc
1674 pprRegReg name reg1 reg2
1675   = hcat [
1676         pprMnemonic_ name,
1677         pprReg wordRep reg1,
1678         comma,
1679         pprReg wordRep reg2
1680     ]
1681
1682 pprOpReg :: LitString -> Operand -> Reg -> Doc
1683 pprOpReg name op1 reg2
1684   = hcat [
1685         pprMnemonic_ name,
1686         pprOperand wordRep op1,
1687         comma,
1688         pprReg wordRep reg2
1689     ]
1690
1691 pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
1692 pprCondRegReg name size cond reg1 reg2
1693   = hcat [
1694         char '\t',
1695         ptext name,
1696         pprCond cond,
1697         space,
1698         pprReg size reg1,
1699         comma,
1700         pprReg size reg2
1701     ]
1702
1703 pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
1704 pprSizeSizeRegReg name size1 size2 reg1 reg2
1705   = hcat [
1706         char '\t',
1707         ptext name,
1708         pprSize size1,
1709         pprSize size2,
1710         space,
1711         pprReg size1 reg1,
1712
1713         comma,
1714         pprReg size2 reg2
1715     ]
1716
1717 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1718 pprSizeRegRegReg name size reg1 reg2 reg3
1719   = hcat [
1720         pprMnemonic name size,
1721         pprReg size reg1,
1722         comma,
1723         pprReg size reg2,
1724         comma,
1725         pprReg size reg3
1726     ]
1727
1728 pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
1729 pprSizeAddrReg name size op dst
1730   = hcat [
1731         pprMnemonic name size,
1732         pprAddr op,
1733         comma,
1734         pprReg size dst
1735     ]
1736
1737 pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
1738 pprSizeRegAddr name size src op
1739   = hcat [
1740         pprMnemonic name size,
1741         pprReg size src,
1742         comma,
1743         pprAddr op
1744     ]
1745
1746 pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
1747 pprShift name size src dest
1748   = hcat [
1749         pprMnemonic name size,
1750         pprOperand I8 src,  -- src is 8-bit sized
1751         comma,
1752         pprOperand size dest
1753     ]
1754
1755 pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
1756 pprSizeOpOpCoerce name size1 size2 op1 op2
1757   = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1758         pprOperand size1 op1,
1759         comma,
1760         pprOperand size2 op2
1761     ]
1762
1763 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1764 pprCondInstr name cond arg
1765   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1766
1767 #endif /* i386_TARGET_ARCH */
1768
1769
1770 -- ------------------------------------------------------------------------------- pprInstr for a SPARC
1771
1772 #if sparc_TARGET_ARCH
1773
1774 -- a clumsy hack for now, to handle possible double alignment problems
1775
1776 -- even clumsier, to allow for RegReg regs that show when doing indexed
1777 -- reads (bytearrays).
1778 --
1779
1780 -- Translate to the following:
1781 --    add g1,g2,g1
1782 --    ld  [g1],%fn
1783 --    ld  [g1+4],%f(n+1)
1784 --    sub g1,g2,g1           -- to restore g1
1785
1786 pprInstr (LD F64 (AddrRegReg g1 g2) reg)
1787   = vcat [
1788        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1789        hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1790        hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1791        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1792     ]
1793
1794 -- Translate to
1795 --    ld  [addr],%fn
1796 --    ld  [addr+4],%f(n+1)
1797 pprInstr (LD F64 addr reg) | isJust off_addr
1798   = vcat [
1799        hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1800        hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1801     ]
1802   where
1803     off_addr = addrOffset addr 4
1804     addr2 = case off_addr of Just x -> x
1805
1806
1807 pprInstr (LD size addr reg)
1808   = hcat [
1809        ptext SLIT("\tld"),
1810        pprSize size,
1811        char '\t',
1812        lbrack,
1813        pprAddr addr,
1814        pp_rbracket_comma,
1815        pprReg reg
1816     ]
1817
1818 -- The same clumsy hack as above
1819
1820 -- Translate to the following:
1821 --    add g1,g2,g1
1822 --    st  %fn,[g1]
1823 --    st  %f(n+1),[g1+4]
1824 --    sub g1,g2,g1           -- to restore g1
1825 pprInstr (ST F64 reg (AddrRegReg g1 g2))
1826  = vcat [
1827        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1828        hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1829              pprReg g1, rbrack],
1830        hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1831              pprReg g1, ptext SLIT("+4]")],
1832        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1833     ]
1834
1835 -- Translate to
1836 --    st  %fn,[addr]
1837 --    st  %f(n+1),[addr+4]
1838 pprInstr (ST F64 reg addr) | isJust off_addr
1839  = vcat [
1840       hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1841             pprAddr addr, rbrack],
1842       hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1843             pprAddr addr2, rbrack]
1844     ]
1845   where
1846     off_addr = addrOffset addr 4
1847     addr2 = case off_addr of Just x -> x
1848
1849 -- no distinction is made between signed and unsigned bytes on stores for the
1850 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1851 -- so we call a special-purpose pprSize for ST..
1852
1853 pprInstr (ST size reg addr)
1854   = hcat [
1855        ptext SLIT("\tst"),
1856        pprStSize size,
1857        char '\t',
1858        pprReg reg,
1859        pp_comma_lbracket,
1860        pprAddr addr,
1861        rbrack
1862     ]
1863
1864 pprInstr (ADD x cc reg1 ri reg2)
1865   | not x && not cc && riZero ri
1866   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1867   | otherwise
1868   = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1869
1870 pprInstr (SUB x cc reg1 ri reg2)
1871   | not x && cc && reg2 == g0
1872   = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1873   | not x && not cc && riZero ri
1874   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1875   | otherwise
1876   = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1877
1878 pprInstr (AND  b reg1 ri reg2) = pprRegRIReg SLIT("and")  b reg1 ri reg2
1879 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1880
1881 pprInstr (OR b reg1 ri reg2)
1882   | not b && reg1 == g0
1883   = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1884     in  case ri of
1885            RIReg rrr | rrr == reg2 -> empty
1886            other                   -> doit
1887   | otherwise
1888   = pprRegRIReg SLIT("or") b reg1 ri reg2
1889
1890 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1891
1892 pprInstr (XOR  b reg1 ri reg2) = pprRegRIReg SLIT("xor")  b reg1 ri reg2
1893 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1894
1895 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1896 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1897 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1898
1899 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1900 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul")  b reg1 ri reg2
1901 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul")  b reg1 ri reg2
1902
1903 pprInstr (SETHI imm reg)
1904   = hcat [
1905         ptext SLIT("\tsethi\t"),
1906         pprImm imm,
1907         comma,
1908         pprReg reg
1909     ]
1910
1911 pprInstr NOP = ptext SLIT("\tnop")
1912
1913 pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg SLIT("fabs") F32 reg1 reg2
1914 pprInstr (FABS F64 reg1 reg2)
1915   = (<>) (pprSizeRegReg SLIT("fabs") F32 reg1 reg2)
1916     (if (reg1 == reg2) then empty
1917      else (<>) (char '\n')
1918           (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1919
1920 pprInstr (FADD size reg1 reg2 reg3)
1921   = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1922 pprInstr (FCMP e size reg1 reg2)
1923   = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1924 pprInstr (FDIV size reg1 reg2 reg3)
1925   = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1926
1927 pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg SLIT("fmov") F32 reg1 reg2
1928 pprInstr (FMOV F64 reg1 reg2)
1929   = (<>) (pprSizeRegReg SLIT("fmov") F32 reg1 reg2)
1930     (if (reg1 == reg2) then empty
1931      else (<>) (char '\n')
1932           (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1933
1934 pprInstr (FMUL size reg1 reg2 reg3)
1935   = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1936
1937 pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg SLIT("fneg") F32 reg1 reg2
1938 pprInstr (FNEG F64 reg1 reg2)
1939   = (<>) (pprSizeRegReg SLIT("fneg") F32 reg1 reg2)
1940     (if (reg1 == reg2) then empty
1941      else (<>) (char '\n')
1942           (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1943
1944 pprInstr (FSQRT size reg1 reg2)     = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1945 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1946 pprInstr (FxTOy size1 size2 reg1 reg2)
1947   = hcat [
1948         ptext SLIT("\tf"),
1949         ptext
1950         (case size1 of
1951             I32  -> SLIT("ito")
1952             F32  -> SLIT("sto")
1953             F64  -> SLIT("dto")),
1954         ptext
1955         (case size2 of
1956             I32  -> SLIT("i\t")
1957             F32  -> SLIT("s\t")
1958             F64  -> SLIT("d\t")),
1959         pprReg reg1, comma, pprReg reg2
1960     ]
1961
1962
1963 pprInstr (BI cond b lab)
1964   = hcat [
1965         ptext SLIT("\tb"), pprCond cond,
1966         if b then pp_comma_a else empty,
1967         char '\t',
1968         pprImm lab
1969     ]
1970
1971 pprInstr (BF cond b lab)
1972   = hcat [
1973         ptext SLIT("\tfb"), pprCond cond,
1974         if b then pp_comma_a else empty,
1975         char '\t',
1976         pprImm lab
1977     ]
1978
1979 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1980
1981 pprInstr (CALL (Left imm) n _)
1982   = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1983 pprInstr (CALL (Right reg) n _)
1984   = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1985
1986 pprRI :: RI -> Doc
1987 pprRI (RIReg r) = pprReg r
1988 pprRI (RIImm r) = pprImm r
1989
1990 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1991 pprSizeRegReg name size reg1 reg2
1992   = hcat [
1993         char '\t',
1994         ptext name,
1995         (case size of
1996             F32  -> ptext SLIT("s\t")
1997             F64 -> ptext SLIT("d\t")),
1998         pprReg reg1,
1999         comma,
2000         pprReg reg2
2001     ]
2002
2003 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
2004 pprSizeRegRegReg name size reg1 reg2 reg3
2005   = hcat [
2006         char '\t',
2007         ptext name,
2008         (case size of
2009             F32  -> ptext SLIT("s\t")
2010             F64  -> ptext SLIT("d\t")),
2011         pprReg reg1,
2012         comma,
2013         pprReg reg2,
2014         comma,
2015         pprReg reg3
2016     ]
2017
2018 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
2019 pprRegRIReg name b reg1 ri reg2
2020   = hcat [
2021         char '\t',
2022         ptext name,
2023         if b then ptext SLIT("cc\t") else char '\t',
2024         pprReg reg1,
2025         comma,
2026         pprRI ri,
2027         comma,
2028         pprReg reg2
2029     ]
2030
2031 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
2032 pprRIReg name b ri reg1
2033   = hcat [
2034         char '\t',
2035         ptext name,
2036         if b then ptext SLIT("cc\t") else char '\t',
2037         pprRI ri,
2038         comma,
2039         pprReg reg1
2040     ]
2041
2042 pp_ld_lbracket    = ptext SLIT("\tld\t[")
2043 pp_rbracket_comma = text "],"
2044 pp_comma_lbracket = text ",["
2045 pp_comma_a        = text ",a"
2046
2047 #endif /* sparc_TARGET_ARCH */
2048
2049
2050 -- -----------------------------------------------------------------------------
2051 -- pprInstr for PowerPC
2052
2053 #if powerpc_TARGET_ARCH
2054 pprInstr (LD sz reg addr) = hcat [
2055         char '\t',
2056         ptext SLIT("l"),
2057         ptext (case sz of
2058             I8  -> SLIT("bz")
2059             I16 -> SLIT("hz")
2060             I32 -> SLIT("wz")
2061             F32 -> SLIT("fs")
2062             F64 -> SLIT("fd")),
2063         case addr of AddrRegImm _ _ -> empty
2064                      AddrRegReg _ _ -> char 'x',
2065         char '\t',
2066         pprReg reg,
2067         ptext SLIT(", "),
2068         pprAddr addr
2069     ]
2070 pprInstr (LA sz reg addr) = hcat [
2071         char '\t',
2072         ptext SLIT("l"),
2073         ptext (case sz of
2074             I8  -> SLIT("ba")
2075             I16 -> SLIT("ha")
2076             I32 -> SLIT("wa")
2077             F32 -> SLIT("fs")
2078             F64 -> SLIT("fd")),
2079         case addr of AddrRegImm _ _ -> empty
2080                      AddrRegReg _ _ -> char 'x',
2081         char '\t',
2082         pprReg reg,
2083         ptext SLIT(", "),
2084         pprAddr addr
2085     ]
2086 pprInstr (ST sz reg addr) = hcat [
2087         char '\t',
2088         ptext SLIT("st"),
2089         pprSize sz,
2090         case addr of AddrRegImm _ _ -> empty
2091                      AddrRegReg _ _ -> char 'x',
2092         char '\t',
2093         pprReg reg,
2094         ptext SLIT(", "),
2095         pprAddr addr
2096     ]
2097 pprInstr (STU sz reg addr) = hcat [
2098         char '\t',
2099         ptext SLIT("st"),
2100         pprSize sz,
2101         ptext SLIT("u\t"),
2102         case addr of AddrRegImm _ _ -> empty
2103                      AddrRegReg _ _ -> char 'x',
2104         pprReg reg,
2105         ptext SLIT(", "),
2106         pprAddr addr
2107     ]
2108 pprInstr (LIS reg imm) = hcat [
2109         char '\t',
2110         ptext SLIT("lis"),
2111         char '\t',
2112         pprReg reg,
2113         ptext SLIT(", "),
2114         pprImm imm
2115     ]
2116 pprInstr (LI reg imm) = hcat [
2117         char '\t',
2118         ptext SLIT("li"),
2119         char '\t',
2120         pprReg reg,
2121         ptext SLIT(", "),
2122         pprImm imm
2123     ]
2124 pprInstr (MR reg1 reg2)
2125     | reg1 == reg2 = empty
2126     | otherwise = hcat [
2127         char '\t',
2128         case regClass reg1 of
2129             RcInteger -> ptext SLIT("mr")
2130             _ -> ptext SLIT("fmr"),
2131         char '\t',
2132         pprReg reg1,
2133         ptext SLIT(", "),
2134         pprReg reg2
2135     ]
2136 pprInstr (CMP sz reg ri) = hcat [
2137         char '\t',
2138         op,
2139         char '\t',
2140         pprReg reg,
2141         ptext SLIT(", "),
2142         pprRI ri
2143     ]
2144     where
2145         op = hcat [
2146                 ptext SLIT("cmp"),
2147                 pprSize sz,
2148                 case ri of
2149                     RIReg _ -> empty
2150                     RIImm _ -> char 'i'
2151             ]
2152 pprInstr (CMPL sz reg ri) = hcat [
2153         char '\t',
2154         op,
2155         char '\t',
2156         pprReg reg,
2157         ptext SLIT(", "),
2158         pprRI ri
2159     ]
2160     where
2161         op = hcat [
2162                 ptext SLIT("cmpl"),
2163                 pprSize sz,
2164                 case ri of
2165                     RIReg _ -> empty
2166                     RIImm _ -> char 'i'
2167             ]
2168 pprInstr (BCC cond (BlockId id)) = hcat [
2169         char '\t',
2170         ptext SLIT("b"),
2171         pprCond cond,
2172         char '\t',
2173         pprCLabel_asm lbl
2174     ]
2175     where lbl = mkAsmTempLabel id
2176
2177 pprInstr (BCCFAR cond (BlockId id)) = vcat [
2178         hcat [
2179             ptext SLIT("\tb"),
2180             pprCond (condNegate cond),
2181             ptext SLIT("\t$+8")
2182         ],
2183         hcat [
2184             ptext SLIT("\tb\t"),
2185             pprCLabel_asm lbl
2186         ]
2187     ]
2188     where lbl = mkAsmTempLabel id
2189
2190 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
2191         char '\t',
2192         ptext SLIT("b"),
2193         char '\t',
2194         pprCLabel_asm lbl
2195     ]
2196
2197 pprInstr (MTCTR reg) = hcat [
2198         char '\t',
2199         ptext SLIT("mtctr"),
2200         char '\t',
2201         pprReg reg
2202     ]
2203 pprInstr (BCTR _) = hcat [
2204         char '\t',
2205         ptext SLIT("bctr")
2206     ]
2207 pprInstr (BL lbl _) = hcat [
2208         ptext SLIT("\tbl\t"),
2209         pprCLabel_asm lbl
2210     ]
2211 pprInstr (BCTRL _) = hcat [
2212         char '\t',
2213         ptext SLIT("bctrl")
2214     ]
2215 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
2216 pprInstr (ADDIS reg1 reg2 imm) = hcat [
2217         char '\t',
2218         ptext SLIT("addis"),
2219         char '\t',
2220         pprReg reg1,
2221         ptext SLIT(", "),
2222         pprReg reg2,
2223         ptext SLIT(", "),
2224         pprImm imm
2225     ]
2226
2227 pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
2228 pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
2229 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
2230 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
2231 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
2232 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
2233 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
2234
2235 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
2236          hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
2237                                           pprReg reg2, ptext SLIT(", "),
2238                                           pprReg reg3 ],
2239          hcat [ ptext SLIT("\tmfxer\t"),  pprReg reg1 ],
2240          hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
2241                                           pprReg reg1, ptext SLIT(", "),
2242                                           ptext SLIT("2, 31, 31") ]
2243     ]
2244
2245         -- for some reason, "andi" doesn't exist.
2246         -- we'll use "andi." instead.
2247 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
2248         char '\t',
2249         ptext SLIT("andi."),
2250         char '\t',
2251         pprReg reg1,
2252         ptext SLIT(", "),
2253         pprReg reg2,
2254         ptext SLIT(", "),
2255         pprImm imm
2256     ]
2257 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
2258
2259 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
2260 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
2261
2262 pprInstr (XORIS reg1 reg2 imm) = hcat [
2263         char '\t',
2264         ptext SLIT("xoris"),
2265         char '\t',
2266         pprReg reg1,
2267         ptext SLIT(", "),
2268         pprReg reg2,
2269         ptext SLIT(", "),
2270         pprImm imm
2271     ]
2272
2273 pprInstr (EXTS sz reg1 reg2) = hcat [
2274         char '\t',
2275         ptext SLIT("exts"),
2276         pprSize sz,
2277         char '\t',
2278         pprReg reg1,
2279         ptext SLIT(", "),
2280         pprReg reg2
2281     ]
2282
2283 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2284 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2285
2286 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
2287 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
2288 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
2289 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
2290         ptext SLIT("\trlwinm\t"),
2291         pprReg reg1,
2292         ptext SLIT(", "),
2293         pprReg reg2,
2294         ptext SLIT(", "),
2295         int sh,
2296         ptext SLIT(", "),
2297         int mb,
2298         ptext SLIT(", "),
2299         int me
2300     ]
2301
2302 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2303 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2304 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2305 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2306 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2307
2308 pprInstr (FCMP reg1 reg2) = hcat [
2309         char '\t',
2310         ptext SLIT("fcmpu\tcr0, "),
2311             -- Note: we're using fcmpu, not fcmpo
2312             -- The difference is with fcmpo, compare with NaN is an invalid operation.
2313             -- We don't handle invalid fp ops, so we don't care
2314         pprReg reg1,
2315         ptext SLIT(", "),
2316         pprReg reg2
2317     ]
2318
2319 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2320 pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
2321
2322 pprInstr (CRNOR dst src1 src2) = hcat [
2323         ptext SLIT("\tcrnor\t"),
2324         int dst,
2325         ptext SLIT(", "),
2326         int src1,
2327         ptext SLIT(", "),
2328         int src2
2329     ]
2330
2331 pprInstr (MFCR reg) = hcat [
2332         char '\t',
2333         ptext SLIT("mfcr"),
2334         char '\t',
2335         pprReg reg
2336     ]
2337
2338 pprInstr (MFLR reg) = hcat [
2339         char '\t',
2340         ptext SLIT("mflr"),
2341         char '\t',
2342         pprReg reg
2343     ]
2344
2345 pprInstr (FETCHPC reg) = vcat [
2346         ptext SLIT("\tbcl\t20,31,1f"),
2347         hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
2348     ]
2349
2350 pprInstr LWSYNC = ptext SLIT("\tlwsync")
2351
2352 pprInstr _ = panic "pprInstr (ppc)"
2353
2354 pprLogic op reg1 reg2 ri = hcat [
2355         char '\t',
2356         ptext op,
2357         case ri of
2358             RIReg _ -> empty
2359             RIImm _ -> char 'i',
2360         char '\t',
2361         pprReg reg1,
2362         ptext SLIT(", "),
2363         pprReg reg2,
2364         ptext SLIT(", "),
2365         pprRI ri
2366     ]
2367
2368 pprUnary op reg1 reg2 = hcat [
2369         char '\t',
2370         ptext op,
2371         char '\t',
2372         pprReg reg1,
2373         ptext SLIT(", "),
2374         pprReg reg2
2375     ]
2376
2377 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2378         char '\t',
2379         ptext op,
2380         pprFSize sz,
2381         char '\t',
2382         pprReg reg1,
2383         ptext SLIT(", "),
2384         pprReg reg2,
2385         ptext SLIT(", "),
2386         pprReg reg3
2387     ]
2388
2389 pprRI :: RI -> Doc
2390 pprRI (RIReg r) = pprReg r
2391 pprRI (RIImm r) = pprImm r
2392
2393 pprFSize F64 = empty
2394 pprFSize F32 = char 's'
2395
2396     -- limit immediate argument for shift instruction to range 0..32
2397     -- (yes, the maximum is really 32, not 31)
2398 limitShiftRI :: RI -> RI
2399 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
2400 limitShiftRI x = x
2401
2402 #endif /* powerpc_TARGET_ARCH */
2403
2404
2405 -- -----------------------------------------------------------------------------
2406 -- Converting floating-point literals to integrals for printing
2407
2408 castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2409 castFloatToWord8Array = castSTUArray
2410
2411 castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2412 castDoubleToWord8Array = castSTUArray
2413
2414 -- floatToBytes and doubleToBytes convert to the host's byte
2415 -- order.  Providing that we're not cross-compiling for a
2416 -- target with the opposite endianness, this should work ok
2417 -- on all targets.
2418
2419 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2420 -- could they be merged?
2421
2422 floatToBytes :: Float -> [Int]
2423 floatToBytes f
2424    = runST (do
2425         arr <- newArray_ ((0::Int),3)
2426         writeArray arr 0 f
2427         arr <- castFloatToWord8Array arr
2428         i0 <- readArray arr 0
2429         i1 <- readArray arr 1
2430         i2 <- readArray arr 2
2431         i3 <- readArray arr 3
2432         return (map fromIntegral [i0,i1,i2,i3])
2433      )
2434
2435 doubleToBytes :: Double -> [Int]
2436 doubleToBytes d
2437    = runST (do
2438         arr <- newArray_ ((0::Int),7)
2439         writeArray arr 0 d
2440         arr <- castDoubleToWord8Array arr
2441         i0 <- readArray arr 0
2442         i1 <- readArray arr 1
2443         i2 <- readArray arr 2
2444         i3 <- readArray arr 3
2445         i4 <- readArray arr 4
2446         i5 <- readArray arr 5
2447         i6 <- readArray arr 6
2448         i7 <- readArray arr 7
2449         return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])
2450      )