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