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