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