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