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 {-                                                                      -- BUGS: changed for coloring allocator
1231 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack               -- write a pass for this and patch linear allocator with it
1232   | src == dst
1233   =
1234 #if 0 /* #ifdef DEBUG */
1235     (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
1236 #else
1237     empty
1238 #endif
1239 -}
1240
1241 pprInstr (SPILL reg slot)
1242    = hcat [
1243         ptext SLIT("\tSPILL"),
1244         char ' ',
1245         pprUserReg reg,
1246         comma,
1247         ptext SLIT("SLOT") <> parens (int slot)]
1248
1249 pprInstr (RELOAD slot reg)
1250    = hcat [
1251         ptext SLIT("\tRELOAD"),
1252         char ' ',
1253         ptext SLIT("SLOT") <> parens (int slot),
1254         comma,
1255         pprUserReg reg]
1256
1257 pprInstr (MOV size src dst)
1258   = pprSizeOpOp SLIT("mov") size src dst
1259
1260 pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
1261         -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
1262         -- movl.  But we represent it as a MOVZxL instruction, because
1263         -- the reg alloc would tend to throw away a plain reg-to-reg
1264         -- move, and we still want it to do that.
1265
1266 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 src dst
1267         -- zero-extension only needs to extend to 32 bits: on x86_64,
1268         -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
1269         -- instruction is shorter.
1270
1271 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
1272
1273 -- here we do some patching, since the physical registers are only set late
1274 -- in the code generation.
1275 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1276   | reg1 == reg3
1277   = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1278 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1279   | reg2 == reg3
1280   = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1281 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
1282   | reg1 == reg3
1283   = pprInstr (ADD size (OpImm displ) dst)
1284 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1285
1286 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1287   = pprSizeOp SLIT("dec") size dst
1288 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1289   = pprSizeOp SLIT("inc") size dst
1290 pprInstr (ADD size src dst)
1291   = pprSizeOpOp SLIT("add") size src dst
1292 pprInstr (ADC size src dst)
1293   = pprSizeOpOp SLIT("adc") size src dst
1294 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1295 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1296
1297 {- A hack.  The Intel documentation says that "The two and three
1298    operand forms [of IMUL] may also be used with unsigned operands
1299    because the lower half of the product is the same regardless if
1300    (sic) the operands are signed or unsigned.  The CF and OF flags,
1301    however, cannot be used to determine if the upper half of the
1302    result is non-zero."  So there.
1303 -}
1304 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1305 pprInstr (OR  size src dst) = pprSizeOpOp SLIT("or")  size src dst
1306
1307 pprInstr (XOR F32 src dst)  = pprOpOp SLIT("xorps") F32 src dst
1308 pprInstr (XOR F64 src dst)  = pprOpOp SLIT("xorpd") F64 src dst
1309 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor")  size src dst
1310
1311 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1312 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1313
1314 pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
1315 pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
1316 pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
1317
1318 pprInstr (BT  size imm src) = pprSizeImmOp SLIT("bt") size imm src
1319
1320 pprInstr (CMP size src dst)
1321   | isFloatingRep size =  pprSizeOpOp SLIT("ucomi")  size src dst -- SSE2
1322   | otherwise          =  pprSizeOpOp SLIT("cmp")  size src dst
1323
1324 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test")  size src dst
1325 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1326 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1327
1328 -- both unused (SDM):
1329 -- pprInstr PUSHA = ptext SLIT("\tpushal")
1330 -- pprInstr POPA = ptext SLIT("\tpopal")
1331
1332 pprInstr NOP = ptext SLIT("\tnop")
1333 pprInstr (CLTD I32) = ptext SLIT("\tcltd")
1334 pprInstr (CLTD I64) = ptext SLIT("\tcqto")
1335
1336 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
1337
1338 pprInstr (JXX cond (BlockId id))
1339   = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1340   where lab = mkAsmTempLabel id
1341
1342 pprInstr (JXX_GBL cond imm) = pprCondInstr SLIT("j") cond (pprImm imm)
1343
1344 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1345 pprInstr (JMP op)          = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
1346 pprInstr (JMP_TBL op ids)  = pprInstr (JMP op)
1347 pprInstr (CALL (Left imm) _)    = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1348 pprInstr (CALL (Right reg) _)   = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
1349
1350 pprInstr (IDIV sz op)   = pprSizeOp SLIT("idiv") sz op
1351 pprInstr (DIV sz op)    = pprSizeOp SLIT("div")  sz op
1352 pprInstr (IMUL2 sz op)  = pprSizeOp SLIT("imul") sz op
1353
1354 #if x86_64_TARGET_ARCH
1355 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
1356
1357 pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
1358
1359 pprInstr (CVTSS2SD from to)   = pprRegReg SLIT("cvtss2sd") from to
1360 pprInstr (CVTSD2SS from to)   = pprRegReg SLIT("cvtsd2ss") from to
1361 pprInstr (CVTTSS2SIQ from to) = pprOpReg  SLIT("cvttss2siq") from to
1362 pprInstr (CVTTSD2SIQ from to) = pprOpReg  SLIT("cvttsd2siq") from to
1363 pprInstr (CVTSI2SS from to)   = pprOpReg  SLIT("cvtsi2ssq") from to
1364 pprInstr (CVTSI2SD from to)   = pprOpReg  SLIT("cvtsi2sdq") from to
1365 #endif
1366
1367     -- FETCHGOT for PIC on ELF platforms
1368 pprInstr (FETCHGOT reg)
1369    = vcat [ ptext SLIT("\tcall 1f"),
1370             hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
1371             hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
1372                    pprReg I32 reg ]
1373           ]
1374
1375     -- FETCHPC for PIC on Darwin/x86
1376     -- get the instruction pointer into a register
1377     -- (Terminology note: the IP is called Program Counter on PPC,
1378     --  and it's a good thing to use the same name on both platforms)
1379 pprInstr (FETCHPC reg)
1380    = vcat [ ptext SLIT("\tcall 1f"),
1381             hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ]
1382           ]
1383
1384
1385
1386 #endif
1387
1388 -- -----------------------------------------------------------------------------
1389 -- i386 floating-point
1390
1391 #if i386_TARGET_ARCH
1392 -- Simulating a flat register set on the x86 FP stack is tricky.
1393 -- you have to free %st(7) before pushing anything on the FP reg stack
1394 -- so as to preclude the possibility of a FP stack overflow exception.
1395 pprInstr g@(GMOV src dst)
1396    | src == dst
1397    = empty
1398    | otherwise
1399    = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1400
1401 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1402 pprInstr g@(GLD sz addr dst)
1403  = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1404                  pprAddr addr, gsemi, gpop dst 1])
1405
1406 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1407 pprInstr g@(GST sz src addr)
1408  = pprG g (hcat [gtab, gpush src 0, gsemi,
1409                  text "fstp", pprSize sz, gsp, pprAddr addr])
1410
1411 pprInstr g@(GLDZ dst)
1412  = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1413 pprInstr g@(GLD1 dst)
1414  = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1415
1416 pprInstr g@(GFTOI src dst)
1417    = pprInstr (GDTOI src dst)
1418 pprInstr g@(GDTOI src dst)
1419    = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1420                    gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1421                    pprReg I32 dst])
1422
1423 pprInstr g@(GITOF src dst)
1424    = pprInstr (GITOD src dst)
1425 pprInstr g@(GITOD src dst)
1426    = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
1427                    text " ; ffree %st(7); fildl (%esp) ; ",
1428                    gpop dst 1, text " ; addl $4,%esp"])
1429
1430 {- Gruesome swamp follows.  If you're unfortunate enough to have ventured
1431    this far into the jungle AND you give a Rat's Ass (tm) what's going
1432    on, here's the deal.  Generate code to do a floating point comparison
1433    of src1 and src2, of kind cond, and set the Zero flag if true.
1434
1435    The complications are to do with handling NaNs correctly.  We want the
1436    property that if either argument is NaN, then the result of the
1437    comparison is False ... except if we're comparing for inequality,
1438    in which case the answer is True.
1439
1440    Here's how the general (non-inequality) case works.  As an
1441    example, consider generating the an equality test:
1442
1443      pushl %eax         -- we need to mess with this
1444      <get src1 to top of FPU stack>
1445      fcomp <src2 location in FPU stack> and pop pushed src1
1446                 -- Result of comparison is in FPU Status Register bits
1447                 -- C3 C2 and C0
1448      fstsw %ax  -- Move FPU Status Reg to %ax
1449      sahf       -- move C3 C2 C0 from %ax to integer flag reg
1450      -- now the serious magic begins
1451      setpo %ah     -- %ah = if comparable(neither arg was NaN) then 1 else 0
1452      sete  %al     -- %al = if arg1 == arg2 then 1 else 0
1453      andb %ah,%al  -- %al &= %ah
1454                    -- so %al == 1 iff (comparable && same); else it holds 0
1455      decb %al      -- %al == 0, ZeroFlag=1  iff (comparable && same);
1456                       else %al == 0xFF, ZeroFlag=0
1457      -- the zero flag is now set as we desire.
1458      popl %eax
1459
1460    The special case of inequality differs thusly:
1461
1462      setpe %ah     -- %ah = if incomparable(either arg was NaN) then 1 else 0
1463      setne %al     -- %al = if arg1 /= arg2 then 1 else 0
1464      orb %ah,%al   -- %al = if (incomparable || different) then 1 else 0
1465      decb %al      -- if (incomparable || different) then (%al == 0, ZF=1)
1466                                                      else (%al == 0xFF, ZF=0)
1467 -}
1468 pprInstr g@(GCMP cond src1 src2)
1469    | case cond of { NE -> True; other -> False }
1470    = pprG g (vcat [
1471         hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1472         hcat [gtab, text "fcomp ", greg src2 1,
1473                     text "; fstsw %ax ; sahf ;  setpe %ah"],
1474         hcat [gtab, text "setne %al ;  ",
1475               text "orb %ah,%al ;  decb %al ;  popl %eax"]
1476     ])
1477    | otherwise
1478    = pprG g (vcat [
1479         hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1480         hcat [gtab, text "fcomp ", greg src2 1,
1481                     text "; fstsw %ax ; sahf ;  setpo %ah"],
1482         hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ;  ",
1483               text "andb %ah,%al ;  decb %al ;  popl %eax"]
1484     ])
1485     where
1486         {- On the 486, the flags set by FP compare are the unsigned ones!
1487            (This looks like a HACK to me.  WDP 96/03)
1488         -}
1489         fix_FP_cond :: Cond -> Cond
1490         fix_FP_cond GE   = GEU
1491         fix_FP_cond GTT  = GU
1492         fix_FP_cond LTT  = LU
1493         fix_FP_cond LE   = LEU
1494         fix_FP_cond EQQ  = EQQ
1495         fix_FP_cond NE   = NE
1496         -- there should be no others
1497
1498
1499 pprInstr g@(GABS sz src dst)
1500    = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1501 pprInstr g@(GNEG sz src dst)
1502    = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1503
1504 pprInstr g@(GSQRT sz src dst)
1505    = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1506              hcat [gtab, gcoerceto sz, gpop dst 1])
1507 pprInstr g@(GSIN sz src dst)
1508    = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1509              hcat [gtab, gcoerceto sz, gpop dst 1])
1510 pprInstr g@(GCOS sz src dst)
1511    = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1512              hcat [gtab, gcoerceto sz, gpop dst 1])
1513 pprInstr g@(GTAN sz src dst)
1514    = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1515                    gpush src 0, text " ; fptan ; ",
1516                    text " fstp %st(0)"] $$
1517              hcat [gtab, gcoerceto sz, gpop dst 1])
1518
1519 -- In the translations for GADD, GMUL, GSUB and GDIV,
1520 -- the first two cases are mere optimisations.  The otherwise clause
1521 -- generates correct code under all circumstances.
1522
1523 pprInstr g@(GADD sz src1 src2 dst)
1524    | src1 == dst
1525    = pprG g (text "\t#GADD-xxxcase1" $$
1526              hcat [gtab, gpush src2 0,
1527                    text " ; faddp %st(0),", greg src1 1])
1528    | src2 == dst
1529    = pprG g (text "\t#GADD-xxxcase2" $$
1530              hcat [gtab, gpush src1 0,
1531                    text " ; faddp %st(0),", greg src2 1])
1532    | otherwise
1533    = pprG g (hcat [gtab, gpush src1 0,
1534                    text " ; fadd ", greg src2 1, text ",%st(0)",
1535                    gsemi, gpop dst 1])
1536
1537
1538 pprInstr g@(GMUL sz src1 src2 dst)
1539    | src1 == dst
1540    = pprG g (text "\t#GMUL-xxxcase1" $$
1541              hcat [gtab, gpush src2 0,
1542                    text " ; fmulp %st(0),", greg src1 1])
1543    | src2 == dst
1544    = pprG g (text "\t#GMUL-xxxcase2" $$
1545              hcat [gtab, gpush src1 0,
1546                    text " ; fmulp %st(0),", greg src2 1])
1547    | otherwise
1548    = pprG g (hcat [gtab, gpush src1 0,
1549                    text " ; fmul ", greg src2 1, text ",%st(0)",
1550                    gsemi, gpop dst 1])
1551
1552
1553 pprInstr g@(GSUB sz src1 src2 dst)
1554    | src1 == dst
1555    = pprG g (text "\t#GSUB-xxxcase1" $$
1556              hcat [gtab, gpush src2 0,
1557                    text " ; fsubrp %st(0),", greg src1 1])
1558    | src2 == dst
1559    = pprG g (text "\t#GSUB-xxxcase2" $$
1560              hcat [gtab, gpush src1 0,
1561                    text " ; fsubp %st(0),", greg src2 1])
1562    | otherwise
1563    = pprG g (hcat [gtab, gpush src1 0,
1564                    text " ; fsub ", greg src2 1, text ",%st(0)",
1565                    gsemi, gpop dst 1])
1566
1567
1568 pprInstr g@(GDIV sz src1 src2 dst)
1569    | src1 == dst
1570    = pprG g (text "\t#GDIV-xxxcase1" $$
1571              hcat [gtab, gpush src2 0,
1572                    text " ; fdivrp %st(0),", greg src1 1])
1573    | src2 == dst
1574    = pprG g (text "\t#GDIV-xxxcase2" $$
1575              hcat [gtab, gpush src1 0,
1576                    text " ; fdivp %st(0),", greg src2 1])
1577    | otherwise
1578    = pprG g (hcat [gtab, gpush src1 0,
1579                    text " ; fdiv ", greg src2 1, text ",%st(0)",
1580                    gsemi, gpop dst 1])
1581
1582
1583 pprInstr GFREE
1584    = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1585             ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1586           ]
1587
1588 --------------------------
1589
1590 -- coerce %st(0) to the specified size
1591 gcoerceto F64 = empty
1592 gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1593
1594 gpush reg offset
1595    = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1596 gpop reg offset
1597    = hcat [text "fstp ", greg reg offset]
1598
1599 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1600 gsemi = text " ; "
1601 gtab  = char '\t'
1602 gsp   = char ' '
1603
1604 gregno (RealReg i) = i
1605 gregno other       = --pprPanic "gregno" (ppr other)
1606                      999   -- bogus; only needed for debug printing
1607
1608 pprG :: Instr -> Doc -> Doc
1609 pprG fake actual
1610    = (char '#' <> pprGInstr fake) $$ actual
1611
1612 pprGInstr (GMOV src dst)   = pprSizeRegReg SLIT("gmov") F64 src dst
1613 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1614 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1615
1616 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
1617 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
1618
1619 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32  src dst
1620 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
1621
1622 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32  src dst
1623 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
1624
1625 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
1626 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1627 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1628 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1629 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1630 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1631 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1632
1633 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1634 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1635 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1636 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1637 #endif
1638
1639 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1640
1641 -- Continue with I386-only printing bits and bobs:
1642
1643 pprDollImm :: Imm -> Doc
1644
1645 pprDollImm i =  ptext SLIT("$") <> pprImm i
1646
1647 pprOperand :: MachRep -> Operand -> Doc
1648 pprOperand s (OpReg r)   = pprReg s r
1649 pprOperand s (OpImm i)   = pprDollImm i
1650 pprOperand s (OpAddr ea) = pprAddr ea
1651
1652 pprMnemonic_  :: LitString -> Doc
1653 pprMnemonic_ name =
1654    char '\t' <> ptext name <> space
1655
1656 pprMnemonic  :: LitString -> MachRep -> Doc
1657 pprMnemonic name size =
1658    char '\t' <> ptext name <> pprSize size <> space
1659
1660 pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
1661 pprSizeImmOp name size imm op1
1662   = hcat [
1663         pprMnemonic name size,
1664         char '$',
1665         pprImm imm,
1666         comma,
1667         pprOperand size op1
1668     ]
1669
1670 pprSizeOp :: LitString -> MachRep -> Operand -> Doc
1671 pprSizeOp name size op1
1672   = hcat [
1673         pprMnemonic name size,
1674         pprOperand size op1
1675     ]
1676
1677 pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1678 pprSizeOpOp name size op1 op2
1679   = hcat [
1680         pprMnemonic name size,
1681         pprOperand size op1,
1682         comma,
1683         pprOperand size op2
1684     ]
1685
1686 pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1687 pprOpOp name size op1 op2
1688   = hcat [
1689         pprMnemonic_ name,
1690         pprOperand size op1,
1691         comma,
1692         pprOperand size op2
1693     ]
1694
1695 pprSizeReg :: LitString -> MachRep -> Reg -> Doc
1696 pprSizeReg name size reg1
1697   = hcat [
1698         pprMnemonic name size,
1699         pprReg size reg1
1700     ]
1701
1702 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1703 pprSizeRegReg name size reg1 reg2
1704   = hcat [
1705         pprMnemonic name size,
1706         pprReg size reg1,
1707         comma,
1708         pprReg size reg2
1709     ]
1710
1711 pprRegReg :: LitString -> Reg -> Reg -> Doc
1712 pprRegReg name reg1 reg2
1713   = hcat [
1714         pprMnemonic_ name,
1715         pprReg wordRep reg1,
1716         comma,
1717         pprReg wordRep reg2
1718     ]
1719
1720 pprOpReg :: LitString -> Operand -> Reg -> Doc
1721 pprOpReg name op1 reg2
1722   = hcat [
1723         pprMnemonic_ name,
1724         pprOperand wordRep op1,
1725         comma,
1726         pprReg wordRep reg2
1727     ]
1728
1729 pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
1730 pprCondRegReg name size cond reg1 reg2
1731   = hcat [
1732         char '\t',
1733         ptext name,
1734         pprCond cond,
1735         space,
1736         pprReg size reg1,
1737         comma,
1738         pprReg size reg2
1739     ]
1740
1741 pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
1742 pprSizeSizeRegReg name size1 size2 reg1 reg2
1743   = hcat [
1744         char '\t',
1745         ptext name,
1746         pprSize size1,
1747         pprSize size2,
1748         space,
1749         pprReg size1 reg1,
1750
1751         comma,
1752         pprReg size2 reg2
1753     ]
1754
1755 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1756 pprSizeRegRegReg name size reg1 reg2 reg3
1757   = hcat [
1758         pprMnemonic name size,
1759         pprReg size reg1,
1760         comma,
1761         pprReg size reg2,
1762         comma,
1763         pprReg size reg3
1764     ]
1765
1766 pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
1767 pprSizeAddrReg name size op dst
1768   = hcat [
1769         pprMnemonic name size,
1770         pprAddr op,
1771         comma,
1772         pprReg size dst
1773     ]
1774
1775 pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
1776 pprSizeRegAddr name size src op
1777   = hcat [
1778         pprMnemonic name size,
1779         pprReg size src,
1780         comma,
1781         pprAddr op
1782     ]
1783
1784 pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
1785 pprShift name size src dest
1786   = hcat [
1787         pprMnemonic name size,
1788         pprOperand I8 src,  -- src is 8-bit sized
1789         comma,
1790         pprOperand size dest
1791     ]
1792
1793 pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
1794 pprSizeOpOpCoerce name size1 size2 op1 op2
1795   = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1796         pprOperand size1 op1,
1797         comma,
1798         pprOperand size2 op2
1799     ]
1800
1801 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1802 pprCondInstr name cond arg
1803   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1804
1805 #endif /* i386_TARGET_ARCH */
1806
1807
1808 -- ------------------------------------------------------------------------------- pprInstr for a SPARC
1809
1810 #if sparc_TARGET_ARCH
1811
1812 -- a clumsy hack for now, to handle possible double alignment problems
1813
1814 -- even clumsier, to allow for RegReg regs that show when doing indexed
1815 -- reads (bytearrays).
1816 --
1817
1818 pprInstr (SPILL reg slot)
1819    = hcat [
1820         ptext SLIT("\tSPILL"),
1821         char '\t',
1822         pprReg reg,
1823         comma,
1824         ptext SLIT("SLOT") <> parens (int slot)]
1825
1826 pprInstr (RELOAD slot reg)
1827    = hcat [
1828         ptext SLIT("\tRELOAD"),
1829         char '\t',
1830         ptext SLIT("SLOT") <> parens (int slot),
1831         comma,
1832         pprReg reg]
1833
1834 -- Translate to the following:
1835 --    add g1,g2,g1
1836 --    ld  [g1],%fn
1837 --    ld  [g1+4],%f(n+1)
1838 --    sub g1,g2,g1           -- to restore g1
1839
1840 pprInstr (LD F64 (AddrRegReg g1 g2) reg)
1841   = vcat [
1842        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1843        hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1844        hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1845        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1846     ]
1847
1848 -- Translate to
1849 --    ld  [addr],%fn
1850 --    ld  [addr+4],%f(n+1)
1851 pprInstr (LD F64 addr reg) | isJust off_addr
1852   = vcat [
1853        hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1854        hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1855     ]
1856   where
1857     off_addr = addrOffset addr 4
1858     addr2 = case off_addr of Just x -> x
1859
1860
1861 pprInstr (LD size addr reg)
1862   = hcat [
1863        ptext SLIT("\tld"),
1864        pprSize size,
1865        char '\t',
1866        lbrack,
1867        pprAddr addr,
1868        pp_rbracket_comma,
1869        pprReg reg
1870     ]
1871
1872 -- The same clumsy hack as above
1873
1874 -- Translate to the following:
1875 --    add g1,g2,g1
1876 --    st  %fn,[g1]
1877 --    st  %f(n+1),[g1+4]
1878 --    sub g1,g2,g1           -- to restore g1
1879 pprInstr (ST F64 reg (AddrRegReg g1 g2))
1880  = vcat [
1881        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1882        hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1883              pprReg g1, rbrack],
1884        hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1885              pprReg g1, ptext SLIT("+4]")],
1886        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1887     ]
1888
1889 -- Translate to
1890 --    st  %fn,[addr]
1891 --    st  %f(n+1),[addr+4]
1892 pprInstr (ST F64 reg addr) | isJust off_addr
1893  = vcat [
1894       hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1895             pprAddr addr, rbrack],
1896       hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1897             pprAddr addr2, rbrack]
1898     ]
1899   where
1900     off_addr = addrOffset addr 4
1901     addr2 = case off_addr of Just x -> x
1902
1903 -- no distinction is made between signed and unsigned bytes on stores for the
1904 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1905 -- so we call a special-purpose pprSize for ST..
1906
1907 pprInstr (ST size reg addr)
1908   = hcat [
1909        ptext SLIT("\tst"),
1910        pprStSize size,
1911        char '\t',
1912        pprReg reg,
1913        pp_comma_lbracket,
1914        pprAddr addr,
1915        rbrack
1916     ]
1917
1918 pprInstr (ADD x cc reg1 ri reg2)
1919   | not x && not cc && riZero ri
1920   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1921   | otherwise
1922   = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1923
1924 pprInstr (SUB x cc reg1 ri reg2)
1925   | not x && cc && reg2 == g0
1926   = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1927   | not x && not cc && riZero ri
1928   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1929   | otherwise
1930   = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1931
1932 pprInstr (AND  b reg1 ri reg2) = pprRegRIReg SLIT("and")  b reg1 ri reg2
1933 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1934
1935 pprInstr (OR b reg1 ri reg2)
1936   | not b && reg1 == g0
1937   = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1938     in  case ri of
1939            RIReg rrr | rrr == reg2 -> empty
1940            other                   -> doit
1941   | otherwise
1942   = pprRegRIReg SLIT("or") b reg1 ri reg2
1943
1944 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1945
1946 pprInstr (XOR  b reg1 ri reg2) = pprRegRIReg SLIT("xor")  b reg1 ri reg2
1947 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1948
1949 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1950 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1951 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1952
1953 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1954 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul")  b reg1 ri reg2
1955 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul")  b reg1 ri reg2
1956
1957 pprInstr (SETHI imm reg)
1958   = hcat [
1959         ptext SLIT("\tsethi\t"),
1960         pprImm imm,
1961         comma,
1962         pprReg reg
1963     ]
1964
1965 pprInstr NOP = ptext SLIT("\tnop")
1966
1967 pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg SLIT("fabs") F32 reg1 reg2
1968 pprInstr (FABS F64 reg1 reg2)
1969   = (<>) (pprSizeRegReg SLIT("fabs") F32 reg1 reg2)
1970     (if (reg1 == reg2) then empty
1971      else (<>) (char '\n')
1972           (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1973
1974 pprInstr (FADD size reg1 reg2 reg3)
1975   = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1976 pprInstr (FCMP e size reg1 reg2)
1977   = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1978 pprInstr (FDIV size reg1 reg2 reg3)
1979   = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1980
1981 pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg SLIT("fmov") F32 reg1 reg2
1982 pprInstr (FMOV F64 reg1 reg2)
1983   = (<>) (pprSizeRegReg SLIT("fmov") F32 reg1 reg2)
1984     (if (reg1 == reg2) then empty
1985      else (<>) (char '\n')
1986           (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1987
1988 pprInstr (FMUL size reg1 reg2 reg3)
1989   = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1990
1991 pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg SLIT("fneg") F32 reg1 reg2
1992 pprInstr (FNEG F64 reg1 reg2)
1993   = (<>) (pprSizeRegReg SLIT("fneg") F32 reg1 reg2)
1994     (if (reg1 == reg2) then empty
1995      else (<>) (char '\n')
1996           (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1997
1998 pprInstr (FSQRT size reg1 reg2)     = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1999 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
2000 pprInstr (FxTOy size1 size2 reg1 reg2)
2001   = hcat [
2002         ptext SLIT("\tf"),
2003         ptext
2004         (case size1 of
2005             I32  -> SLIT("ito")
2006             F32  -> SLIT("sto")
2007             F64  -> SLIT("dto")),
2008         ptext
2009         (case size2 of
2010             I32  -> SLIT("i\t")
2011             F32  -> SLIT("s\t")
2012             F64  -> SLIT("d\t")),
2013         pprReg reg1, comma, pprReg reg2
2014     ]
2015
2016
2017 pprInstr (BI cond b lab)
2018   = hcat [
2019         ptext SLIT("\tb"), pprCond cond,
2020         if b then pp_comma_a else empty,
2021         char '\t',
2022         pprImm lab
2023     ]
2024
2025 pprInstr (BF cond b lab)
2026   = hcat [
2027         ptext SLIT("\tfb"), pprCond cond,
2028         if b then pp_comma_a else empty,
2029         char '\t',
2030         pprImm lab
2031     ]
2032
2033 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
2034
2035 pprInstr (CALL (Left imm) n _)
2036   = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
2037 pprInstr (CALL (Right reg) n _)
2038   = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
2039
2040 pprRI :: RI -> Doc
2041 pprRI (RIReg r) = pprReg r
2042 pprRI (RIImm r) = pprImm r
2043
2044 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
2045 pprSizeRegReg name size reg1 reg2
2046   = hcat [
2047         char '\t',
2048         ptext name,
2049         (case size of
2050             F32  -> ptext SLIT("s\t")
2051             F64 -> ptext SLIT("d\t")),
2052         pprReg reg1,
2053         comma,
2054         pprReg reg2
2055     ]
2056
2057 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
2058 pprSizeRegRegReg name size reg1 reg2 reg3
2059   = hcat [
2060         char '\t',
2061         ptext name,
2062         (case size of
2063             F32  -> ptext SLIT("s\t")
2064             F64  -> ptext SLIT("d\t")),
2065         pprReg reg1,
2066         comma,
2067         pprReg reg2,
2068         comma,
2069         pprReg reg3
2070     ]
2071
2072 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
2073 pprRegRIReg name b reg1 ri reg2
2074   = hcat [
2075         char '\t',
2076         ptext name,
2077         if b then ptext SLIT("cc\t") else char '\t',
2078         pprReg reg1,
2079         comma,
2080         pprRI ri,
2081         comma,
2082         pprReg reg2
2083     ]
2084
2085 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
2086 pprRIReg name b ri reg1
2087   = hcat [
2088         char '\t',
2089         ptext name,
2090         if b then ptext SLIT("cc\t") else char '\t',
2091         pprRI ri,
2092         comma,
2093         pprReg reg1
2094     ]
2095
2096 pp_ld_lbracket    = ptext SLIT("\tld\t[")
2097 pp_rbracket_comma = text "],"
2098 pp_comma_lbracket = text ",["
2099 pp_comma_a        = text ",a"
2100
2101 #endif /* sparc_TARGET_ARCH */
2102
2103
2104 -- -----------------------------------------------------------------------------
2105 -- pprInstr for PowerPC
2106
2107 #if powerpc_TARGET_ARCH
2108
2109 pprInstr (SPILL reg slot)
2110    = hcat [
2111         ptext SLIT("\tSPILL"),
2112         char '\t',
2113         pprReg reg,
2114         comma,
2115         ptext SLIT("SLOT") <> parens (int slot)]
2116
2117 pprInstr (RELOAD slot reg)
2118    = hcat [
2119         ptext SLIT("\tRELOAD"),
2120         char '\t',
2121         ptext SLIT("SLOT") <> parens (int slot),
2122         comma,
2123         pprReg reg]
2124
2125 pprInstr (LD sz reg addr) = hcat [
2126         char '\t',
2127         ptext SLIT("l"),
2128         ptext (case sz of
2129             I8  -> SLIT("bz")
2130             I16 -> SLIT("hz")
2131             I32 -> SLIT("wz")
2132             F32 -> SLIT("fs")
2133             F64 -> SLIT("fd")),
2134         case addr of AddrRegImm _ _ -> empty
2135                      AddrRegReg _ _ -> char 'x',
2136         char '\t',
2137         pprReg reg,
2138         ptext SLIT(", "),
2139         pprAddr addr
2140     ]
2141 pprInstr (LA sz reg addr) = hcat [
2142         char '\t',
2143         ptext SLIT("l"),
2144         ptext (case sz of
2145             I8  -> SLIT("ba")
2146             I16 -> SLIT("ha")
2147             I32 -> SLIT("wa")
2148             F32 -> SLIT("fs")
2149             F64 -> SLIT("fd")),
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 (ST sz reg addr) = hcat [
2158         char '\t',
2159         ptext SLIT("st"),
2160         pprSize sz,
2161         case addr of AddrRegImm _ _ -> empty
2162                      AddrRegReg _ _ -> char 'x',
2163         char '\t',
2164         pprReg reg,
2165         ptext SLIT(", "),
2166         pprAddr addr
2167     ]
2168 pprInstr (STU sz reg addr) = hcat [
2169         char '\t',
2170         ptext SLIT("st"),
2171         pprSize sz,
2172         ptext SLIT("u\t"),
2173         case addr of AddrRegImm _ _ -> empty
2174                      AddrRegReg _ _ -> char 'x',
2175         pprReg reg,
2176         ptext SLIT(", "),
2177         pprAddr addr
2178     ]
2179 pprInstr (LIS reg imm) = hcat [
2180         char '\t',
2181         ptext SLIT("lis"),
2182         char '\t',
2183         pprReg reg,
2184         ptext SLIT(", "),
2185         pprImm imm
2186     ]
2187 pprInstr (LI reg imm) = hcat [
2188         char '\t',
2189         ptext SLIT("li"),
2190         char '\t',
2191         pprReg reg,
2192         ptext SLIT(", "),
2193         pprImm imm
2194     ]
2195 pprInstr (MR reg1 reg2)
2196     | reg1 == reg2 = empty
2197     | otherwise = hcat [
2198         char '\t',
2199         case regClass reg1 of
2200             RcInteger -> ptext SLIT("mr")
2201             _ -> ptext SLIT("fmr"),
2202         char '\t',
2203         pprReg reg1,
2204         ptext SLIT(", "),
2205         pprReg reg2
2206     ]
2207 pprInstr (CMP sz reg ri) = hcat [
2208         char '\t',
2209         op,
2210         char '\t',
2211         pprReg reg,
2212         ptext SLIT(", "),
2213         pprRI ri
2214     ]
2215     where
2216         op = hcat [
2217                 ptext SLIT("cmp"),
2218                 pprSize sz,
2219                 case ri of
2220                     RIReg _ -> empty
2221                     RIImm _ -> char 'i'
2222             ]
2223 pprInstr (CMPL sz reg ri) = hcat [
2224         char '\t',
2225         op,
2226         char '\t',
2227         pprReg reg,
2228         ptext SLIT(", "),
2229         pprRI ri
2230     ]
2231     where
2232         op = hcat [
2233                 ptext SLIT("cmpl"),
2234                 pprSize sz,
2235                 case ri of
2236                     RIReg _ -> empty
2237                     RIImm _ -> char 'i'
2238             ]
2239 pprInstr (BCC cond (BlockId id)) = hcat [
2240         char '\t',
2241         ptext SLIT("b"),
2242         pprCond cond,
2243         char '\t',
2244         pprCLabel_asm lbl
2245     ]
2246     where lbl = mkAsmTempLabel id
2247
2248 pprInstr (BCCFAR cond (BlockId id)) = vcat [
2249         hcat [
2250             ptext SLIT("\tb"),
2251             pprCond (condNegate cond),
2252             ptext SLIT("\t$+8")
2253         ],
2254         hcat [
2255             ptext SLIT("\tb\t"),
2256             pprCLabel_asm lbl
2257         ]
2258     ]
2259     where lbl = mkAsmTempLabel id
2260
2261 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
2262         char '\t',
2263         ptext SLIT("b"),
2264         char '\t',
2265         pprCLabel_asm lbl
2266     ]
2267
2268 pprInstr (MTCTR reg) = hcat [
2269         char '\t',
2270         ptext SLIT("mtctr"),
2271         char '\t',
2272         pprReg reg
2273     ]
2274 pprInstr (BCTR _) = hcat [
2275         char '\t',
2276         ptext SLIT("bctr")
2277     ]
2278 pprInstr (BL lbl _) = hcat [
2279         ptext SLIT("\tbl\t"),
2280         pprCLabel_asm lbl
2281     ]
2282 pprInstr (BCTRL _) = hcat [
2283         char '\t',
2284         ptext SLIT("bctrl")
2285     ]
2286 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
2287 pprInstr (ADDIS reg1 reg2 imm) = hcat [
2288         char '\t',
2289         ptext SLIT("addis"),
2290         char '\t',
2291         pprReg reg1,
2292         ptext SLIT(", "),
2293         pprReg reg2,
2294         ptext SLIT(", "),
2295         pprImm imm
2296     ]
2297
2298 pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
2299 pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
2300 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
2301 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
2302 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
2303 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
2304 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
2305
2306 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
2307          hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
2308                                           pprReg reg2, ptext SLIT(", "),
2309                                           pprReg reg3 ],
2310          hcat [ ptext SLIT("\tmfxer\t"),  pprReg reg1 ],
2311          hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
2312                                           pprReg reg1, ptext SLIT(", "),
2313                                           ptext SLIT("2, 31, 31") ]
2314     ]
2315
2316         -- for some reason, "andi" doesn't exist.
2317         -- we'll use "andi." instead.
2318 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
2319         char '\t',
2320         ptext SLIT("andi."),
2321         char '\t',
2322         pprReg reg1,
2323         ptext SLIT(", "),
2324         pprReg reg2,
2325         ptext SLIT(", "),
2326         pprImm imm
2327     ]
2328 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
2329
2330 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
2331 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
2332
2333 pprInstr (XORIS reg1 reg2 imm) = hcat [
2334         char '\t',
2335         ptext SLIT("xoris"),
2336         char '\t',
2337         pprReg reg1,
2338         ptext SLIT(", "),
2339         pprReg reg2,
2340         ptext SLIT(", "),
2341         pprImm imm
2342     ]
2343
2344 pprInstr (EXTS sz reg1 reg2) = hcat [
2345         char '\t',
2346         ptext SLIT("exts"),
2347         pprSize sz,
2348         char '\t',
2349         pprReg reg1,
2350         ptext SLIT(", "),
2351         pprReg reg2
2352     ]
2353
2354 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2355 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2356
2357 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
2358 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
2359 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
2360 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
2361         ptext SLIT("\trlwinm\t"),
2362         pprReg reg1,
2363         ptext SLIT(", "),
2364         pprReg reg2,
2365         ptext SLIT(", "),
2366         int sh,
2367         ptext SLIT(", "),
2368         int mb,
2369         ptext SLIT(", "),
2370         int me
2371     ]
2372
2373 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2374 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2375 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2376 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2377 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2378
2379 pprInstr (FCMP reg1 reg2) = hcat [
2380         char '\t',
2381         ptext SLIT("fcmpu\tcr0, "),
2382             -- Note: we're using fcmpu, not fcmpo
2383             -- The difference is with fcmpo, compare with NaN is an invalid operation.
2384             -- We don't handle invalid fp ops, so we don't care
2385         pprReg reg1,
2386         ptext SLIT(", "),
2387         pprReg reg2
2388     ]
2389
2390 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2391 pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
2392
2393 pprInstr (CRNOR dst src1 src2) = hcat [
2394         ptext SLIT("\tcrnor\t"),
2395         int dst,
2396         ptext SLIT(", "),
2397         int src1,
2398         ptext SLIT(", "),
2399         int src2
2400     ]
2401
2402 pprInstr (MFCR reg) = hcat [
2403         char '\t',
2404         ptext SLIT("mfcr"),
2405         char '\t',
2406         pprReg reg
2407     ]
2408
2409 pprInstr (MFLR reg) = hcat [
2410         char '\t',
2411         ptext SLIT("mflr"),
2412         char '\t',
2413         pprReg reg
2414     ]
2415
2416 pprInstr (FETCHPC reg) = vcat [
2417         ptext SLIT("\tbcl\t20,31,1f"),
2418         hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
2419     ]
2420
2421 pprInstr LWSYNC = ptext SLIT("\tlwsync")
2422
2423 pprInstr _ = panic "pprInstr (ppc)"
2424
2425 pprLogic op reg1 reg2 ri = hcat [
2426         char '\t',
2427         ptext op,
2428         case ri of
2429             RIReg _ -> empty
2430             RIImm _ -> char 'i',
2431         char '\t',
2432         pprReg reg1,
2433         ptext SLIT(", "),
2434         pprReg reg2,
2435         ptext SLIT(", "),
2436         pprRI ri
2437     ]
2438
2439 pprUnary op reg1 reg2 = hcat [
2440         char '\t',
2441         ptext op,
2442         char '\t',
2443         pprReg reg1,
2444         ptext SLIT(", "),
2445         pprReg reg2
2446     ]
2447
2448 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2449         char '\t',
2450         ptext op,
2451         pprFSize sz,
2452         char '\t',
2453         pprReg reg1,
2454         ptext SLIT(", "),
2455         pprReg reg2,
2456         ptext SLIT(", "),
2457         pprReg reg3
2458     ]
2459
2460 pprRI :: RI -> Doc
2461 pprRI (RIReg r) = pprReg r
2462 pprRI (RIImm r) = pprImm r
2463
2464 pprFSize F64 = empty
2465 pprFSize F32 = char 's'
2466
2467     -- limit immediate argument for shift instruction to range 0..32
2468     -- (yes, the maximum is really 32, not 31)
2469 limitShiftRI :: RI -> RI
2470 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
2471 limitShiftRI x = x
2472
2473 #endif /* powerpc_TARGET_ARCH */
2474
2475
2476 -- -----------------------------------------------------------------------------
2477 -- Converting floating-point literals to integrals for printing
2478
2479 castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2480 castFloatToWord8Array = castSTUArray
2481
2482 castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2483 castDoubleToWord8Array = castSTUArray
2484
2485 -- floatToBytes and doubleToBytes convert to the host's byte
2486 -- order.  Providing that we're not cross-compiling for a
2487 -- target with the opposite endianness, this should work ok
2488 -- on all targets.
2489
2490 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2491 -- could they be merged?
2492
2493 floatToBytes :: Float -> [Int]
2494 floatToBytes f
2495    = runST (do
2496         arr <- newArray_ ((0::Int),3)
2497         writeArray arr 0 f
2498         arr <- castFloatToWord8Array arr
2499         i0 <- readArray arr 0
2500         i1 <- readArray arr 1
2501         i2 <- readArray arr 2
2502         i3 <- readArray arr 3
2503         return (map fromIntegral [i0,i1,i2,i3])
2504      )
2505
2506 doubleToBytes :: Double -> [Int]
2507 doubleToBytes d
2508    = runST (do
2509         arr <- newArray_ ((0::Int),7)
2510         writeArray arr 0 d
2511         arr <- castDoubleToWord8Array arr
2512         i0 <- readArray arr 0
2513         i1 <- readArray arr 1
2514         i2 <- readArray arr 2
2515         i3 <- readArray arr 3
2516         i4 <- readArray arr 4
2517         i5 <- readArray arr 5
2518         i6 <- readArray arr 6
2519         i7 <- readArray arr 7
2520         return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])
2521      )