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