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