compiler/nativeGen/PprMach.hs

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