ghc/compiler/nativeGen/PprMach.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996-1998
   3 %
   4 \section[PprMach]{Pretty-printing assembly language}
   5
   6 We start with the @pprXXX@s with some cross-platform commonality
   7 (e.g., @pprReg@); we conclude with the no-commonality monster,
   8 @pprInstr@.
   9
  10 \begin{code}
  11 #include "nativeGen/NCG.h"
  12
  13 module PprMach ( pprInstr, pprSize, pprUserReg ) where
  14
  15 #include "HsVersions.h"
  16
  17 import MachRegs         -- may differ per-platform
  18 import MachMisc
  19
  20 import CLabel           ( pprCLabel, externallyVisibleCLabel, labelDynamic )
  21 import Stix             ( CodeSegment(..) )
  22 import Unique           ( pprUnique )
  23 import Panic            ( panic )
  24 import Pretty
  25 import qualified Outputable
  26
  27 import ST
  28 import MutableArray
  29 import Char             ( chr, ord )
  30 import Maybe            ( isJust )
  31 import FastString
  32
  33 asmSDoc d = Outputable.withPprStyleDoc (
  34               Outputable.mkCodeStyle Outputable.AsmStyle) d
  35 pprCLabel_asm l = asmSDoc (pprCLabel l)
  36 \end{code}
  37
  38 %************************************************************************
  39 %*                                                                      *
  40 \subsection{@pprReg@: print a @Reg@}
  41 %*                                                                      *
  42 %************************************************************************
  43
  44 For x86, the way we print a register name depends
  45 on which bit of it we care about.  Yurgh.
  46 \begin{code}
  47 pprUserReg :: Reg -> Doc
  48 pprUserReg = pprReg IF_ARCH_i386(L,)
  49
  50 pprReg :: IF_ARCH_i386(Size ->,) Reg -> Doc
  51
  52 pprReg IF_ARCH_i386(s,) r
  53   = case r of
  54       RealReg i      -> ppr_reg_no IF_ARCH_i386(s,) i
  55       VirtualRegI u  -> text "%vI_" <> asmSDoc (pprVRegUnique u)
  56       VirtualRegF u  -> text "%vF_" <> asmSDoc (pprVRegUnique u)
  57   where
  58 #if alpha_TARGET_ARCH
  59     ppr_reg_no :: Int -> Doc
  60     ppr_reg_no i = ptext
  61       (case i of {
  62          0 -> SLIT("$0");    1 -> SLIT("$1");
  63          2 -> SLIT("$2");    3 -> SLIT("$3");
  64          4 -> SLIT("$4");    5 -> SLIT("$5");
  65          6 -> SLIT("$6");    7 -> SLIT("$7");
  66          8 -> SLIT("$8");    9 -> SLIT("$9");
  67         10 -> SLIT("$10");  11 -> SLIT("$11");
  68         12 -> SLIT("$12");  13 -> SLIT("$13");
  69         14 -> SLIT("$14");  15 -> SLIT("$15");
  70         16 -> SLIT("$16");  17 -> SLIT("$17");
  71         18 -> SLIT("$18");  19 -> SLIT("$19");
  72         20 -> SLIT("$20");  21 -> SLIT("$21");
  73         22 -> SLIT("$22");  23 -> SLIT("$23");
  74         24 -> SLIT("$24");  25 -> SLIT("$25");
  75         26 -> SLIT("$26");  27 -> SLIT("$27");
  76         28 -> SLIT("$28");  29 -> SLIT("$29");
  77         30 -> SLIT("$30");  31 -> SLIT("$31");
  78         32 -> SLIT("$f0");  33 -> SLIT("$f1");
  79         34 -> SLIT("$f2");  35 -> SLIT("$f3");
  80         36 -> SLIT("$f4");  37 -> SLIT("$f5");
  81         38 -> SLIT("$f6");  39 -> SLIT("$f7");
  82         40 -> SLIT("$f8");  41 -> SLIT("$f9");
  83         42 -> SLIT("$f10"); 43 -> SLIT("$f11");
  84         44 -> SLIT("$f12"); 45 -> SLIT("$f13");
  85         46 -> SLIT("$f14"); 47 -> SLIT("$f15");
  86         48 -> SLIT("$f16"); 49 -> SLIT("$f17");
  87         50 -> SLIT("$f18"); 51 -> SLIT("$f19");
  88         52 -> SLIT("$f20"); 53 -> SLIT("$f21");
  89         54 -> SLIT("$f22"); 55 -> SLIT("$f23");
  90         56 -> SLIT("$f24"); 57 -> SLIT("$f25");
  91         58 -> SLIT("$f26"); 59 -> SLIT("$f27");
  92         60 -> SLIT("$f28"); 61 -> SLIT("$f29");
  93         62 -> SLIT("$f30"); 63 -> SLIT("$f31");
  94         _  -> SLIT("very naughty alpha register")
  95       })
  96 #endif
  97 #if i386_TARGET_ARCH
  98     ppr_reg_no :: Size -> Int -> Doc
  99     ppr_reg_no B  = ppr_reg_byte
 100     ppr_reg_no Bu = ppr_reg_byte
 101     ppr_reg_no W  = ppr_reg_word
 102     ppr_reg_no Wu = ppr_reg_word
 103     ppr_reg_no _  = ppr_reg_long
 104
 105     ppr_reg_byte i = ptext
 106       (case i of {
 107          0 -> SLIT("%al");     1 -> SLIT("%bl");
 108          2 -> SLIT("%cl");     3 -> SLIT("%dl");
 109         _  -> SLIT("very naughty I386 byte register")
 110       })
 111
 112     ppr_reg_word i = ptext
 113       (case i of {
 114          0 -> SLIT("%ax");     1 -> SLIT("%bx");
 115          2 -> SLIT("%cx");     3 -> SLIT("%dx");
 116          4 -> SLIT("%si");     5 -> SLIT("%di");
 117          6 -> SLIT("%bp");     7 -> SLIT("%sp");
 118         _  -> SLIT("very naughty I386 word register")
 119       })
 120
 121     ppr_reg_long i = ptext
 122       (case i of {
 123          0 -> SLIT("%eax");    1 -> SLIT("%ebx");
 124          2 -> SLIT("%ecx");    3 -> SLIT("%edx");
 125          4 -> SLIT("%esi");    5 -> SLIT("%edi");
 126          6 -> SLIT("%ebp");    7 -> SLIT("%esp");
 127          8 -> SLIT("%fake0");  9 -> SLIT("%fake1");
 128         10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
 129         12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
 130         _  -> SLIT("very naughty I386 register")
 131       })
 132 #endif
 133 #if sparc_TARGET_ARCH
 134     ppr_reg_no :: Int -> Doc
 135     ppr_reg_no i = ptext
 136       (case i of {
 137          0 -> SLIT("%g0");   1 -> SLIT("%g1");
 138          2 -> SLIT("%g2");   3 -> SLIT("%g3");
 139          4 -> SLIT("%g4");   5 -> SLIT("%g5");
 140          6 -> SLIT("%g6");   7 -> SLIT("%g7");
 141          8 -> SLIT("%o0");   9 -> SLIT("%o1");
 142         10 -> SLIT("%o2");  11 -> SLIT("%o3");
 143         12 -> SLIT("%o4");  13 -> SLIT("%o5");
 144         14 -> SLIT("%o6");  15 -> SLIT("%o7");
 145         16 -> SLIT("%l0");  17 -> SLIT("%l1");
 146         18 -> SLIT("%l2");  19 -> SLIT("%l3");
 147         20 -> SLIT("%l4");  21 -> SLIT("%l5");
 148         22 -> SLIT("%l6");  23 -> SLIT("%l7");
 149         24 -> SLIT("%i0");  25 -> SLIT("%i1");
 150         26 -> SLIT("%i2");  27 -> SLIT("%i3");
 151         28 -> SLIT("%i4");  29 -> SLIT("%i5");
 152         30 -> SLIT("%i6");  31 -> SLIT("%i7");
 153         32 -> SLIT("%f0");  33 -> SLIT("%f1");
 154         34 -> SLIT("%f2");  35 -> SLIT("%f3");
 155         36 -> SLIT("%f4");  37 -> SLIT("%f5");
 156         38 -> SLIT("%f6");  39 -> SLIT("%f7");
 157         40 -> SLIT("%f8");  41 -> SLIT("%f9");
 158         42 -> SLIT("%f10"); 43 -> SLIT("%f11");
 159         44 -> SLIT("%f12"); 45 -> SLIT("%f13");
 160         46 -> SLIT("%f14"); 47 -> SLIT("%f15");
 161         48 -> SLIT("%f16"); 49 -> SLIT("%f17");
 162         50 -> SLIT("%f18"); 51 -> SLIT("%f19");
 163         52 -> SLIT("%f20"); 53 -> SLIT("%f21");
 164         54 -> SLIT("%f22"); 55 -> SLIT("%f23");
 165         56 -> SLIT("%f24"); 57 -> SLIT("%f25");
 166         58 -> SLIT("%f26"); 59 -> SLIT("%f27");
 167         60 -> SLIT("%f28"); 61 -> SLIT("%f29");
 168         62 -> SLIT("%f30"); 63 -> SLIT("%f31");
 169         _  -> SLIT("very naughty sparc register")
 170       })
 171 #endif
 172 \end{code}
 173
 174 %************************************************************************
 175 %*                                                                      *
 176 \subsection{@pprSize@: print a @Size@}
 177 %*                                                                      *
 178 %************************************************************************
 179
 180 \begin{code}
 181 pprSize :: Size -> Doc
 182
 183 pprSize x = ptext (case x of
 184 #if alpha_TARGET_ARCH
 185          B  -> SLIT("b")
 186          Bu -> SLIT("bu")
 187 --       W  -> SLIT("w") UNUSED
 188 --       Wu -> SLIT("wu") UNUSED
 189          L  -> SLIT("l")
 190          Q  -> SLIT("q")
 191 --       FF -> SLIT("f") UNUSED
 192 --       DF -> SLIT("d") UNUSED
 193 --       GF -> SLIT("g") UNUSED
 194 --       SF -> SLIT("s") UNUSED
 195          TF -> SLIT("t")
 196 #endif
 197 #if i386_TARGET_ARCH
 198         B   -> SLIT("b")
 199         Bu  -> SLIT("b")
 200         W   -> SLIT("w")
 201         Wu  -> SLIT("w")
 202         L   -> SLIT("l")
 203         Lu  -> SLIT("l")
 204         F   -> SLIT("s")
 205         DF  -> SLIT("l")
 206         F80 -> SLIT("t")
 207 #endif
 208 #if sparc_TARGET_ARCH
 209         B   -> SLIT("sb")
 210         Bu  -> SLIT("ub")
 211         H   -> SLIT("sh")
 212         Hu  -> SLIT("uh")
 213         W   -> SLIT("")
 214         F   -> SLIT("")
 215         DF  -> SLIT("d")
 216     )
 217 pprStSize :: Size -> Doc
 218 pprStSize x = ptext (case x of
 219         B   -> SLIT("b")
 220         Bu  -> SLIT("b")
 221         H   -> SLIT("h")
 222         Hu  -> SLIT("h")
 223         W   -> SLIT("")
 224         F   -> SLIT("")
 225         DF  -> SLIT("d")
 226 #endif
 227     )
 228 \end{code}
 229
 230 %************************************************************************
 231 %*                                                                      *
 232 \subsection{@pprCond@: print a @Cond@}
 233 %*                                                                      *
 234 %************************************************************************
 235
 236 \begin{code}
 237 pprCond :: Cond -> Doc
 238
 239 pprCond c = ptext (case c of {
 240 #if alpha_TARGET_ARCH
 241         EQQ  -> SLIT("eq");
 242         LTT  -> SLIT("lt");
 243         LE  -> SLIT("le");
 244         ULT -> SLIT("ult");
 245         ULE -> SLIT("ule");
 246         NE  -> SLIT("ne");
 247         GTT  -> SLIT("gt");
 248         GE  -> SLIT("ge")
 249 #endif
 250 #if i386_TARGET_ARCH
 251         GEU     -> SLIT("ae");  LU    -> SLIT("b");
 252         EQQ     -> SLIT("e");   GTT    -> SLIT("g");
 253         GE      -> SLIT("ge");  GU    -> SLIT("a");
 254         LTT     -> SLIT("l");   LE    -> SLIT("le");
 255         LEU     -> SLIT("be");  NE    -> SLIT("ne");
 256         NEG     -> SLIT("s");   POS   -> SLIT("ns");
 257         CARRY   -> SLIT("c");   OFLO  -> SLIT("o");
 258         ALWAYS  -> SLIT("mp")   -- hack
 259 #endif
 260 #if sparc_TARGET_ARCH
 261         ALWAYS  -> SLIT("");    NEVER -> SLIT("n");
 262         GEU     -> SLIT("geu"); LU    -> SLIT("lu");
 263         EQQ     -> SLIT("e");   GTT   -> SLIT("g");
 264         GE      -> SLIT("ge");  GU    -> SLIT("gu");
 265         LTT     -> SLIT("l");   LE    -> SLIT("le");
 266         LEU     -> SLIT("leu"); NE    -> SLIT("ne");
 267         NEG     -> SLIT("neg"); POS   -> SLIT("pos");
 268         VC      -> SLIT("vc");  VS    -> SLIT("vs")
 269 #endif
 270     })
 271 \end{code}
 272
 273 %************************************************************************
 274 %*                                                                      *
 275 \subsection{@pprImm@: print an @Imm@}
 276 %*                                                                      *
 277 %************************************************************************
 278
 279 \begin{code}
 280 pprImm :: Imm -> Doc
 281
 282 pprImm (ImmInt i)     = int i
 283 pprImm (ImmInteger i) = integer i
 284 pprImm (ImmCLbl l)    = (if labelDynamic l then text "__imp_" else empty)
 285                         <> pprCLabel_asm l
 286 pprImm (ImmIndex l i) = (if labelDynamic l then text "__imp_" else empty)
 287                         <> pprCLabel_asm l <> char '+' <> int i
 288 pprImm (ImmLit s)     = s
 289
 290 pprImm (ImmLab dll s) = (if underscorePrefix then char '_' else empty)
 291                         <> (if dll then text "_imp__" else empty)
 292                         <> s
 293
 294 #if sparc_TARGET_ARCH
 295 pprImm (LO i)
 296   = hcat [ pp_lo, pprImm i, rparen ]
 297   where
 298     pp_lo = text "%lo("
 299
 300 pprImm (HI i)
 301   = hcat [ pp_hi, pprImm i, rparen ]
 302   where
 303     pp_hi = text "%hi("
 304 #endif
 305 \end{code}
 306
 307 %************************************************************************
 308 %*                                                                      *
 309 \subsection{@pprAddr@: print an @Addr@}
 310 %*                                                                      *
 311 %************************************************************************
 312
 313 \begin{code}
 314 pprAddr :: MachRegsAddr -> Doc
 315
 316 #if alpha_TARGET_ARCH
 317 pprAddr (AddrReg r) = parens (pprReg r)
 318 pprAddr (AddrImm i) = pprImm i
 319 pprAddr (AddrRegImm r1 i)
 320   = (<>) (pprImm i) (parens (pprReg r1))
 321 #endif
 322
 323 -------------------
 324
 325 #if i386_TARGET_ARCH
 326 pprAddr (ImmAddr imm off)
 327   = let pp_imm = pprImm imm
 328     in
 329     if (off == 0) then
 330         pp_imm
 331     else if (off < 0) then
 332         pp_imm <> int off
 333     else
 334         pp_imm <> char '+' <> int off
 335
 336 pprAddr (AddrBaseIndex base index displacement)
 337   = let
 338         pp_disp  = ppr_disp displacement
 339         pp_off p = pp_disp <> char '(' <> p <> char ')'
 340         pp_reg r = pprReg L r
 341     in
 342     case (base,index) of
 343       (Nothing, Nothing)    -> pp_disp
 344       (Just b,  Nothing)    -> pp_off (pp_reg b)
 345       (Nothing, Just (r,i)) -> pp_off (pp_reg r <> comma <> int i)
 346       (Just b,  Just (r,i)) -> pp_off (pp_reg b <> comma <> pp_reg r
 347                                        <> comma <> int i)
 348   where
 349     ppr_disp (ImmInt 0) = empty
 350     ppr_disp imm        = pprImm imm
 351 #endif
 352
 353 -------------------
 354
 355 #if sparc_TARGET_ARCH
 356 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
 357
 358 pprAddr (AddrRegReg r1 r2)
 359   = hcat [ pprReg r1, char '+', pprReg r2 ]
 360
 361 pprAddr (AddrRegImm r1 (ImmInt i))
 362   | i == 0 = pprReg r1
 363   | not (fits13Bits i) = largeOffsetError i
 364   | otherwise = hcat [ pprReg r1, pp_sign, int i ]
 365   where
 366     pp_sign = if i > 0 then char '+' else empty
 367
 368 pprAddr (AddrRegImm r1 (ImmInteger i))
 369   | i == 0 = pprReg r1
 370   | not (fits13Bits i) = largeOffsetError i
 371   | otherwise  = hcat [ pprReg r1, pp_sign, integer i ]
 372   where
 373     pp_sign = if i > 0 then char '+' else empty
 374
 375 pprAddr (AddrRegImm r1 imm)
 376   = hcat [ pprReg r1, char '+', pprImm imm ]
 377 #endif
 378 \end{code}
 379
 380 %************************************************************************
 381 %*                                                                      *
 382 \subsection{@pprInstr@: print an @Instr@}
 383 %*                                                                      *
 384 %************************************************************************
 385
 386 \begin{code}
 387 pprInstr :: Instr -> Doc
 388
 389 --pprInstr (COMMENT s) = empty -- nuke 'em
 390 pprInstr (COMMENT s)
 391    =  IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
 392      ,IF_ARCH_sparc( ((<>) (ptext SLIT("! "))   (ftext s))
 393      ,IF_ARCH_i386( ((<>) (ptext SLIT("# "))   (ftext s))
 394      ,)))
 395
 396 pprInstr (DELTA d)
 397    = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
 398
 399 pprInstr (SEGMENT TextSegment)
 400     =  IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-}
 401       ,IF_ARCH_sparc(ptext SLIT(".text\n\t.align 4") {-word boundary-}
 402       ,IF_ARCH_i386((text ".text\n\t.align 4,0x90") {-needs per-OS variation!-}
 403       ,)))
 404
 405 pprInstr (SEGMENT DataSegment)
 406     = ptext
 407          IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
 408         ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
 409         ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
 410         ,)))
 411
 412 pprInstr (SEGMENT RoDataSegment)
 413     = ptext
 414          IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
 415         ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
 416         ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
 417         ,)))
 418
 419 pprInstr (LABEL clab)
 420   = let
 421         pp_lab = pprCLabel_asm clab
 422     in
 423     hcat [
 424         if not (externallyVisibleCLabel clab) then
 425             empty
 426         else
 427             hcat [ptext
 428                          IF_ARCH_alpha(SLIT("\t.globl\t")
 429                         ,IF_ARCH_i386(SLIT(".globl ")
 430                         ,IF_ARCH_sparc(SLIT(".global\t")
 431                         ,)))
 432                         , pp_lab, char '\n'],
 433         pp_lab,
 434         char ':'
 435     ]
 436
 437 pprInstr (ASCII False{-no backslash conversion-} str)
 438   = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
 439
 440 pprInstr (ASCII True str)
 441   = vcat (map do1 (str ++ [chr 0]))
 442     where
 443        do1 :: Char -> Doc
 444        do1 c = ptext SLIT("\t.byte\t0x") <> hshow (ord c)
 445
 446        hshow :: Int -> Doc
 447        hshow n | n >= 0 && n <= 255
 448                = char (tab !! (n `div` 16)) <> char (tab !! (n `mod` 16))
 449        tab = "0123456789ABCDEF"
 450
 451
 452 pprInstr (DATA s xs)
 453   = vcat (concatMap (ppr_item s) xs)
 454     where
 455
 456 #if alpha_TARGET_ARCH
 457             ppr_item = error "ppr_item on Alpha"
 458 #endif
 459 #if sparc_TARGET_ARCH
 460         -- copy n paste of x86 version
 461         ppr_item B  x = [ptext SLIT("\t.byte\t") <> pprImm x]
 462         ppr_item W  x = [ptext SLIT("\t.long\t") <> pprImm x]
 463         ppr_item F  (ImmFloat r)
 464            = let bs = floatToBytes (fromRational r)
 465              in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
 466         ppr_item DF (ImmDouble r)
 467            = let bs = doubleToBytes (fromRational r)
 468              in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
 469 #endif
 470 #if i386_TARGET_ARCH
 471         ppr_item B  x = [ptext SLIT("\t.byte\t") <> pprImm x]
 472         ppr_item L  x = [ptext SLIT("\t.long\t") <> pprImm x]
 473         ppr_item F  (ImmFloat r)
 474            = let bs = floatToBytes (fromRational r)
 475              in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
 476         ppr_item DF (ImmDouble r)
 477            = let bs = doubleToBytes (fromRational r)
 478              in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
 479 #endif
 480
 481         -- floatToBytes and doubleToBytes convert to the host's byte
 482         -- order.  Providing that we're not cross-compiling for a
 483         -- target with the opposite endianness, this should work ok
 484         -- on all targets.
 485         floatToBytes :: Float -> [Int]
 486         floatToBytes f
 487            = runST (do
 488                 arr <- newFloatArray ((0::Int),3)
 489                 writeFloatArray arr 0 f
 490                 i0 <- readCharArray arr 0
 491                 i1 <- readCharArray arr 1
 492                 i2 <- readCharArray arr 2
 493                 i3 <- readCharArray arr 3
 494                 return (map ord [i0,i1,i2,i3])
 495              )
 496
 497         doubleToBytes :: Double -> [Int]
 498         doubleToBytes d
 499            = runST (do
 500                 arr <- newDoubleArray ((0::Int),7)
 501                 writeDoubleArray arr 0 d
 502                 i0 <- readCharArray arr 0
 503                 i1 <- readCharArray arr 1
 504                 i2 <- readCharArray arr 2
 505                 i3 <- readCharArray arr 3
 506                 i4 <- readCharArray arr 4
 507                 i5 <- readCharArray arr 5
 508                 i6 <- readCharArray arr 6
 509                 i7 <- readCharArray arr 7
 510                 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
 511              )
 512
 513 -- fall through to rest of (machine-specific) pprInstr...
 514 \end{code}
 515
 516 %************************************************************************
 517 %*                                                                      *
 518 \subsubsection{@pprInstr@ for an Alpha}
 519 %*                                                                      *
 520 %************************************************************************
 521
 522 \begin{code}
 523 #if alpha_TARGET_ARCH
 524
 525 pprInstr (LD size reg addr)
 526   = hcat [
 527         ptext SLIT("\tld"),
 528         pprSize size,
 529         char '\t',
 530         pprReg reg,
 531         comma,
 532         pprAddr addr
 533     ]
 534
 535 pprInstr (LDA reg addr)
 536   = hcat [
 537         ptext SLIT("\tlda\t"),
 538         pprReg reg,
 539         comma,
 540         pprAddr addr
 541     ]
 542
 543 pprInstr (LDAH reg addr)
 544   = hcat [
 545         ptext SLIT("\tldah\t"),
 546         pprReg reg,
 547         comma,
 548         pprAddr addr
 549     ]
 550
 551 pprInstr (LDGP reg addr)
 552   = hcat [
 553         ptext SLIT("\tldgp\t"),
 554         pprReg reg,
 555         comma,
 556         pprAddr addr
 557     ]
 558
 559 pprInstr (LDI size reg imm)
 560   = hcat [
 561         ptext SLIT("\tldi"),
 562         pprSize size,
 563         char '\t',
 564         pprReg reg,
 565         comma,
 566         pprImm imm
 567     ]
 568
 569 pprInstr (ST size reg addr)
 570   = hcat [
 571         ptext SLIT("\tst"),
 572         pprSize size,
 573         char '\t',
 574         pprReg reg,
 575         comma,
 576         pprAddr addr
 577     ]
 578
 579 pprInstr (CLR reg)
 580   = hcat [
 581         ptext SLIT("\tclr\t"),
 582         pprReg reg
 583     ]
 584
 585 pprInstr (ABS size ri reg)
 586   = hcat [
 587         ptext SLIT("\tabs"),
 588         pprSize size,
 589         char '\t',
 590         pprRI ri,
 591         comma,
 592         pprReg reg
 593     ]
 594
 595 pprInstr (NEG size ov ri reg)
 596   = hcat [
 597         ptext SLIT("\tneg"),
 598         pprSize size,
 599         if ov then ptext SLIT("v\t") else char '\t',
 600         pprRI ri,
 601         comma,
 602         pprReg reg
 603     ]
 604
 605 pprInstr (ADD size ov reg1 ri reg2)
 606   = hcat [
 607         ptext SLIT("\tadd"),
 608         pprSize size,
 609         if ov then ptext SLIT("v\t") else char '\t',
 610         pprReg reg1,
 611         comma,
 612         pprRI ri,
 613         comma,
 614         pprReg reg2
 615     ]
 616
 617 pprInstr (SADD size scale reg1 ri reg2)
 618   = hcat [
 619         ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
 620         ptext SLIT("add"),
 621         pprSize size,
 622         char '\t',
 623         pprReg reg1,
 624         comma,
 625         pprRI ri,
 626         comma,
 627         pprReg reg2
 628     ]
 629
 630 pprInstr (SUB size ov reg1 ri reg2)
 631   = hcat [
 632         ptext SLIT("\tsub"),
 633         pprSize size,
 634         if ov then ptext SLIT("v\t") else char '\t',
 635         pprReg reg1,
 636         comma,
 637         pprRI ri,
 638         comma,
 639         pprReg reg2
 640     ]
 641
 642 pprInstr (SSUB size scale reg1 ri reg2)
 643   = hcat [
 644         ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
 645         ptext SLIT("sub"),
 646         pprSize size,
 647         char '\t',
 648         pprReg reg1,
 649         comma,
 650         pprRI ri,
 651         comma,
 652         pprReg reg2
 653     ]
 654
 655 pprInstr (MUL size ov reg1 ri reg2)
 656   = hcat [
 657         ptext SLIT("\tmul"),
 658         pprSize size,
 659         if ov then ptext SLIT("v\t") else char '\t',
 660         pprReg reg1,
 661         comma,
 662         pprRI ri,
 663         comma,
 664         pprReg reg2
 665     ]
 666
 667 pprInstr (DIV size uns reg1 ri reg2)
 668   = hcat [
 669         ptext SLIT("\tdiv"),
 670         pprSize size,
 671         if uns then ptext SLIT("u\t") else char '\t',
 672         pprReg reg1,
 673         comma,
 674         pprRI ri,
 675         comma,
 676         pprReg reg2
 677     ]
 678
 679 pprInstr (REM size uns reg1 ri reg2)
 680   = hcat [
 681         ptext SLIT("\trem"),
 682         pprSize size,
 683         if uns then ptext SLIT("u\t") else char '\t',
 684         pprReg reg1,
 685         comma,
 686         pprRI ri,
 687         comma,
 688         pprReg reg2
 689     ]
 690
 691 pprInstr (NOT ri reg)
 692   = hcat [
 693         ptext SLIT("\tnot"),
 694         char '\t',
 695         pprRI ri,
 696         comma,
 697         pprReg reg
 698     ]
 699
 700 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
 701 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
 702 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
 703 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
 704 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
 705 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
 706
 707 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
 708 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
 709 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
 710
 711 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
 712 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
 713
 714 pprInstr (NOP) = ptext SLIT("\tnop")
 715
 716 pprInstr (CMP cond reg1 ri reg2)
 717   = hcat [
 718         ptext SLIT("\tcmp"),
 719         pprCond cond,
 720         char '\t',
 721         pprReg reg1,
 722         comma,
 723         pprRI ri,
 724         comma,
 725         pprReg reg2
 726     ]
 727
 728 pprInstr (FCLR reg)
 729   = hcat [
 730         ptext SLIT("\tfclr\t"),
 731         pprReg reg
 732     ]
 733
 734 pprInstr (FABS reg1 reg2)
 735   = hcat [
 736         ptext SLIT("\tfabs\t"),
 737         pprReg reg1,
 738         comma,
 739         pprReg reg2
 740     ]
 741
 742 pprInstr (FNEG size reg1 reg2)
 743   = hcat [
 744         ptext SLIT("\tneg"),
 745         pprSize size,
 746         char '\t',
 747         pprReg reg1,
 748         comma,
 749         pprReg reg2
 750     ]
 751
 752 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
 753 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
 754 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
 755 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
 756
 757 pprInstr (CVTxy size1 size2 reg1 reg2)
 758   = hcat [
 759         ptext SLIT("\tcvt"),
 760         pprSize size1,
 761         case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
 762         char '\t',
 763         pprReg reg1,
 764         comma,
 765         pprReg reg2
 766     ]
 767
 768 pprInstr (FCMP size cond reg1 reg2 reg3)
 769   = hcat [
 770         ptext SLIT("\tcmp"),
 771         pprSize size,
 772         pprCond cond,
 773         char '\t',
 774         pprReg reg1,
 775         comma,
 776         pprReg reg2,
 777         comma,
 778         pprReg reg3
 779     ]
 780
 781 pprInstr (FMOV reg1 reg2)
 782   = hcat [
 783         ptext SLIT("\tfmov\t"),
 784         pprReg reg1,
 785         comma,
 786         pprReg reg2
 787     ]
 788
 789 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
 790
 791 pprInstr (BI NEVER reg lab) = empty
 792
 793 pprInstr (BI cond reg lab)
 794   = hcat [
 795         ptext SLIT("\tb"),
 796         pprCond cond,
 797         char '\t',
 798         pprReg reg,
 799         comma,
 800         pprImm lab
 801     ]
 802
 803 pprInstr (BF cond reg lab)
 804   = hcat [
 805         ptext SLIT("\tfb"),
 806         pprCond cond,
 807         char '\t',
 808         pprReg reg,
 809         comma,
 810         pprImm lab
 811     ]
 812
 813 pprInstr (BR lab)
 814   = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
 815
 816 pprInstr (JMP reg addr hint)
 817   = hcat [
 818         ptext SLIT("\tjmp\t"),
 819         pprReg reg,
 820         comma,
 821         pprAddr addr,
 822         comma,
 823         int hint
 824     ]
 825
 826 pprInstr (BSR imm n)
 827   = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
 828
 829 pprInstr (JSR reg addr n)
 830   = hcat [
 831         ptext SLIT("\tjsr\t"),
 832         pprReg reg,
 833         comma,
 834         pprAddr addr
 835     ]
 836
 837 pprInstr (FUNBEGIN clab)
 838   = hcat [
 839         if (externallyVisibleCLabel clab) then
 840             hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
 841         else
 842             empty,
 843         ptext SLIT("\t.ent "),
 844         pp_lab,
 845         char '\n',
 846         pp_lab,
 847         pp_ldgp,
 848         pp_lab,
 849         pp_frame
 850     ]
 851     where
 852         pp_lab = pprCLabel_asm clab
 853
 854         -- NEVER use commas within those string literals, cpp will ruin your day
 855         pp_ldgp  = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
 856         pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
 857                           ptext SLIT("4240"), char ',',
 858                           ptext SLIT("$26"), char ',',
 859                           ptext SLIT("0\n\t.prologue 1") ]
 860
 861 pprInstr (FUNEND clab)
 862   = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
 863 \end{code}
 864
 865 Continue with Alpha-only printing bits and bobs:
 866 \begin{code}
 867 pprRI :: RI -> Doc
 868
 869 pprRI (RIReg r) = pprReg r
 870 pprRI (RIImm r) = pprImm r
 871
 872 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
 873 pprRegRIReg name reg1 ri reg2
 874   = hcat [
 875         char '\t',
 876         ptext name,
 877         char '\t',
 878         pprReg reg1,
 879         comma,
 880         pprRI ri,
 881         comma,
 882         pprReg reg2
 883     ]
 884
 885 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
 886 pprSizeRegRegReg name size reg1 reg2 reg3
 887   = hcat [
 888         char '\t',
 889         ptext name,
 890         pprSize size,
 891         char '\t',
 892         pprReg reg1,
 893         comma,
 894         pprReg reg2,
 895         comma,
 896         pprReg reg3
 897     ]
 898
 899 #endif {-alpha_TARGET_ARCH-}
 900 \end{code}
 901
 902 %************************************************************************
 903 %*                                                                      *
 904 \subsubsection{@pprInstr@ for an I386}
 905 %*                                                                      *
 906 %************************************************************************
 907
 908 \begin{code}
 909 #if i386_TARGET_ARCH
 910
 911 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
 912   | src == dst
 913   =
 914 #if 0 /* #ifdef DEBUG */
 915     (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
 916 #else
 917     empty
 918 #endif
 919 pprInstr (MOV size src dst)
 920   = pprSizeOpOp SLIT("mov") size src dst
 921 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes L src dst
 922 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes L src dst
 923
 924 -- here we do some patching, since the physical registers are only set late
 925 -- in the code generation.
 926 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
 927   | reg1 == reg3
 928   = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
 929 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
 930   | reg2 == reg3
 931   = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
 932 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
 933   | reg1 == reg3
 934   = pprInstr (ADD size (OpImm displ) dst)
 935 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
 936
 937 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
 938   = pprSizeOp SLIT("dec") size dst
 939 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
 940   = pprSizeOp SLIT("inc") size dst
 941 pprInstr (ADD size src dst)
 942   = pprSizeOpOp SLIT("add") size src dst
 943 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
 944 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
 945
 946 {- A hack.  The Intel documentation says that "The two and three
 947    operand forms [of IMUL] may also be used with unsigned operands
 948    because the lower half of the product is the same regardless if
 949    (sic) the operands are signed or unsigned.  The CF and OF flags,
 950    however, cannot be used to determine if the upper half of the
 951    result is non-zero."  So there.
 952 -}
 953 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
 954
 955 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
 956 pprInstr (OR  size src dst) = pprSizeOpOp SLIT("or")  size src dst
 957 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor")  size src dst
 958 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
 959 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
 960
 961 pprInstr (SHL size imm dst) = pprSizeImmOp SLIT("shl") size imm dst
 962 pprInstr (SAR size imm dst) = pprSizeImmOp SLIT("sar") size imm dst
 963 pprInstr (SHR size imm dst) = pprSizeImmOp SLIT("shr") size imm dst
 964 pprInstr (BT  size imm src) = pprSizeImmOp SLIT("bt")  size imm src
 965
 966 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp")  size src dst
 967 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test")  size src dst
 968 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
 969 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
 970 pprInstr PUSHA = ptext SLIT("\tpushal")
 971 pprInstr POPA = ptext SLIT("\tpopal")
 972
 973 pprInstr NOP = ptext SLIT("\tnop")
 974 pprInstr CLTD = ptext SLIT("\tcltd")
 975
 976 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
 977
 978 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
 979
 980 pprInstr (JMP dsts (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
 981 pprInstr (JMP dsts op)          = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
 982 pprInstr (CALL (Left imm))      = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
 983 pprInstr (CALL (Right reg))     = (<>) (ptext SLIT("\tcall *")) (pprReg L reg)
 984
 985 -- First bool indicates signedness; second whether quot or rem
 986 pprInstr (IQUOT sz src dst) = pprInstr_quotRem True True sz src dst
 987 pprInstr (IREM  sz src dst) = pprInstr_quotRem True False sz src dst
 988
 989 pprInstr (QUOT sz src dst) = pprInstr_quotRem False True sz src dst
 990 pprInstr (REM  sz src dst) = pprInstr_quotRem False False sz src dst
 991
 992 pprInstr (IMUL64 sd_hi sd_lo) = pprInstr_imul64 sd_hi sd_lo
 993
 994
 995 -- Simulating a flat register set on the x86 FP stack is tricky.
 996 -- you have to free %st(7) before pushing anything on the FP reg stack
 997 -- so as to preclude the possibility of a FP stack overflow exception.
 998 pprInstr g@(GMOV src dst)
 999    | src == dst
1000    = empty
1001    | otherwise
1002    = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1003
1004 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1005 pprInstr g@(GLD sz addr dst)
1006  = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1007                  pprAddr addr, gsemi, gpop dst 1])
1008
1009 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1010 pprInstr g@(GST sz src addr)
1011  = pprG g (hcat [gtab, gpush src 0, gsemi,
1012                  text "fstp", pprSize sz, gsp, pprAddr addr])
1013
1014 pprInstr g@(GLDZ dst)
1015  = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1016 pprInstr g@(GLD1 dst)
1017  = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1018
1019 pprInstr g@(GFTOI src dst)
1020    = pprInstr (GDTOI src dst)
1021 pprInstr g@(GDTOI src dst)
1022    = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1023                    gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1024                    pprReg L dst])
1025
1026 pprInstr g@(GITOF src dst)
1027    = pprInstr (GITOD src dst)
1028 pprInstr g@(GITOD src dst)
1029    = pprG g (hcat [gtab, text "pushl ", pprReg L src,
1030                    text " ; ffree %st(7); fildl (%esp) ; ",
1031                    gpop dst 1, text " ; addl $4,%esp"])
1032
1033 {- Gruesome swamp follows.  If you're unfortunate enough to have ventured
1034    this far into the jungle AND you give a Rat's Ass (tm) what's going
1035    on, here's the deal.  Generate code to do a floating point comparison
1036    of src1 and src2, of kind cond, and set the Zero flag if true.
1037
1038    The complications are to do with handling NaNs correctly.  We want the
1039    property that if either argument is NaN, then the result of the
1040    comparison is False ... except if we're comparing for inequality,
1041    in which case the answer is True.
1042
1043    Here's how the general (non-inequality) case works.  As an
1044    example, consider generating the an equality test:
1045
1046      pushl %eax         -- we need to mess with this
1047      <get src1 to top of FPU stack>
1048      fcomp <src2 location in FPU stack> and pop pushed src1
1049                 -- Result of comparison is in FPU Status Register bits
1050                 -- C3 C2 and C0
1051      fstsw %ax  -- Move FPU Status Reg to %ax
1052      sahf       -- move C3 C2 C0 from %ax to integer flag reg
1053      -- now the serious magic begins
1054      setpo %ah     -- %ah = if comparable(neither arg was NaN) then 1 else 0
1055      sete  %al     -- %al = if arg1 == arg2 then 1 else 0
1056      andb %ah,%al  -- %al &= %ah
1057                    -- so %al == 1 iff (comparable && same); else it holds 0
1058      decb %al      -- %al == 0, ZeroFlag=1  iff (comparable && same);
1059                       else %al == 0xFF, ZeroFlag=0
1060      -- the zero flag is now set as we desire.
1061      popl %eax
1062
1063    The special case of inequality differs thusly:
1064
1065      setpe %ah     -- %ah = if incomparable(either arg was NaN) then 1 else 0
1066      setne %al     -- %al = if arg1 /= arg2 then 1 else 0
1067      orb %ah,%al   -- %al = if (incomparable || different) then 1 else 0
1068      decb %al      -- if (incomparable || different) then (%al == 0, ZF=1)
1069                                                      else (%al == 0xFF, ZF=0)
1070 -}
1071 pprInstr g@(GCMP cond src1 src2)
1072    | case cond of { NE -> True; other -> False }
1073    = pprG g (vcat [
1074         hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1075         hcat [gtab, text "fcomp ", greg src2 1,
1076                     text "; fstsw %ax ; sahf ;  setpe %ah"],
1077         hcat [gtab, text "setne %al ;  ",
1078               text "orb %ah,%al ;  decb %al ;  popl %eax"]
1079     ])
1080    | otherwise
1081    = pprG g (vcat [
1082         hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1083         hcat [gtab, text "fcomp ", greg src2 1,
1084                     text "; fstsw %ax ; sahf ;  setpo %ah"],
1085         hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ;  ",
1086               text "andb %ah,%al ;  decb %al ;  popl %eax"]
1087     ])
1088     where
1089         {- On the 486, the flags set by FP compare are the unsigned ones!
1090            (This looks like a HACK to me.  WDP 96/03)
1091         -}
1092         fix_FP_cond :: Cond -> Cond
1093         fix_FP_cond GE   = GEU
1094         fix_FP_cond GTT  = GU
1095         fix_FP_cond LTT  = LU
1096         fix_FP_cond LE   = LEU
1097         fix_FP_cond EQQ  = EQQ
1098         fix_FP_cond NE   = NE
1099         -- there should be no others
1100
1101
1102 pprInstr g@(GABS sz src dst)
1103    = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1104 pprInstr g@(GNEG sz src dst)
1105    = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1106
1107 pprInstr g@(GSQRT sz src dst)
1108    = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1109              hcat [gtab, gcoerceto sz, gpop dst 1])
1110 pprInstr g@(GSIN sz src dst)
1111    = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1112              hcat [gtab, gcoerceto sz, gpop dst 1])
1113 pprInstr g@(GCOS sz src dst)
1114    = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1115              hcat [gtab, gcoerceto sz, gpop dst 1])
1116 pprInstr g@(GTAN sz src dst)
1117    = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1118                    gpush src 0, text " ; fptan ; ",
1119                    text " fstp %st(0)"] $$
1120              hcat [gtab, gcoerceto sz, gpop dst 1])
1121
1122 -- In the translations for GADD, GMUL, GSUB and GDIV,
1123 -- the first two cases are mere optimisations.  The otherwise clause
1124 -- generates correct code under all circumstances.
1125
1126 pprInstr g@(GADD sz src1 src2 dst)
1127    | src1 == dst
1128    = pprG g (text "\t#GADD-xxxcase1" $$
1129              hcat [gtab, gpush src2 0,
1130                    text " ; faddp %st(0),", greg src1 1])
1131    | src2 == dst
1132    = pprG g (text "\t#GADD-xxxcase2" $$
1133              hcat [gtab, gpush src1 0,
1134                    text " ; faddp %st(0),", greg src2 1])
1135    | otherwise
1136    = pprG g (hcat [gtab, gpush src1 0,
1137                    text " ; fadd ", greg src2 1, text ",%st(0)",
1138                    gsemi, gpop dst 1])
1139
1140
1141 pprInstr g@(GMUL sz src1 src2 dst)
1142    | src1 == dst
1143    = pprG g (text "\t#GMUL-xxxcase1" $$
1144              hcat [gtab, gpush src2 0,
1145                    text " ; fmulp %st(0),", greg src1 1])
1146    | src2 == dst
1147    = pprG g (text "\t#GMUL-xxxcase2" $$
1148              hcat [gtab, gpush src1 0,
1149                    text " ; fmulp %st(0),", greg src2 1])
1150    | otherwise
1151    = pprG g (hcat [gtab, gpush src1 0,
1152                    text " ; fmul ", greg src2 1, text ",%st(0)",
1153                    gsemi, gpop dst 1])
1154
1155
1156 pprInstr g@(GSUB sz src1 src2 dst)
1157    | src1 == dst
1158    = pprG g (text "\t#GSUB-xxxcase1" $$
1159              hcat [gtab, gpush src2 0,
1160                    text " ; fsubrp %st(0),", greg src1 1])
1161    | src2 == dst
1162    = pprG g (text "\t#GSUB-xxxcase2" $$
1163              hcat [gtab, gpush src1 0,
1164                    text " ; fsubp %st(0),", greg src2 1])
1165    | otherwise
1166    = pprG g (hcat [gtab, gpush src1 0,
1167                    text " ; fsub ", greg src2 1, text ",%st(0)",
1168                    gsemi, gpop dst 1])
1169
1170
1171 pprInstr g@(GDIV sz src1 src2 dst)
1172    | src1 == dst
1173    = pprG g (text "\t#GDIV-xxxcase1" $$
1174              hcat [gtab, gpush src2 0,
1175                    text " ; fdivrp %st(0),", greg src1 1])
1176    | src2 == dst
1177    = pprG g (text "\t#GDIV-xxxcase2" $$
1178              hcat [gtab, gpush src1 0,
1179                    text " ; fdivp %st(0),", greg src2 1])
1180    | otherwise
1181    = pprG g (hcat [gtab, gpush src1 0,
1182                    text " ; fdiv ", greg src2 1, text ",%st(0)",
1183                    gsemi, gpop dst 1])
1184
1185
1186 pprInstr GFREE
1187    = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1188             ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1189           ]
1190
1191
1192 pprInstr_quotRem signed isQuot sz src dst
1193    | case sz of L -> False; _ -> True
1194    = panic "pprInstr_quotRem: dunno how to do non-32bit operands"
1195    | otherwise
1196    = vcat [
1197      (text "\t# BEGIN " <> fakeInsn),
1198      (text "\tpushl $0;  pushl %eax;  pushl %edx;  pushl " <> pprOperand sz src),
1199      (text "\tmovl " <> pprOperand sz dst <> text ",%eax;  " <> widen_to_64),
1200      (x86op <> text " 0(%esp);  movl " <> text resReg <> text ",12(%esp)"),
1201      (text "\tpopl %edx;  popl %edx;  popl %eax;  popl " <> pprOperand sz dst),
1202      (text "\t# END   " <> fakeInsn)
1203      ]
1204      where
1205         widen_to_64 | signed     = text "cltd"
1206                     | not signed = text "xorl %edx,%edx"
1207         x86op = if signed then text "\tidivl" else text "\tdivl"
1208         resReg = if isQuot then "%eax" else "%edx"
1209         opStr  | signed     = if isQuot then "IQUOT" else "IREM"
1210                | not signed = if isQuot then "QUOT"  else "REM"
1211         fakeInsn = text opStr <+> pprOperand sz src
1212                               <> char ',' <+> pprOperand sz dst
1213
1214 -- Emit code to make hi_reg:lo_reg be the 64-bit product of hi_reg and lo_reg
1215 pprInstr_imul64 hi_reg lo_reg
1216    = let fakeInsn = text "imul64" <+> pp_hi_reg <> comma <+> pp_lo_reg
1217          pp_hi_reg = pprReg L hi_reg
1218          pp_lo_reg = pprReg L lo_reg
1219      in
1220          vcat [
1221             text "\t# BEGIN " <> fakeInsn,
1222             text "\tpushl" <+> pp_hi_reg <> text" ;  pushl" <+> pp_lo_reg,
1223             text "\tpushl %eax ; pushl %edx",
1224             text "\tmovl 12(%esp), %eax ; imull 8(%esp)",
1225             text "\tmovl %edx, 12(%esp) ; movl %eax, 8(%esp)",
1226             text "\tpopl %edx ; popl %eax",
1227             text "\tpopl" <+> pp_lo_reg <> text " ;  popl" <+> pp_hi_reg,
1228             text "\t# END   " <> fakeInsn
1229          ]
1230
1231
1232 --------------------------
1233
1234 -- coerce %st(0) to the specified size
1235 gcoerceto DF = empty
1236 gcoerceto  F = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1237
1238 gpush reg offset
1239    = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1240 gpop reg offset
1241    = hcat [text "fstp ", greg reg offset]
1242
1243 bogus = text "\tbogus"
1244 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1245 gsemi = text " ; "
1246 gtab  = char '\t'
1247 gsp   = char ' '
1248
1249 gregno (RealReg i) = i
1250 gregno other       = --pprPanic "gregno" (ppr other)
1251                      999   -- bogus; only needed for debug printing
1252
1253 pprG :: Instr -> Doc -> Doc
1254 pprG fake actual
1255    = (char '#' <> pprGInstr fake) $$ actual
1256
1257 pprGInstr (GMOV src dst)   = pprSizeRegReg SLIT("gmov") DF src dst
1258 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1259 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1260
1261 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") DF dst
1262 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") DF dst
1263
1264 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L  src dst
1265 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
1266
1267 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F  src dst
1268 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
1269
1270 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") DF co src dst
1271 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1272 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1273 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1274 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1275 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1276 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1277
1278 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1279 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1280 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1281 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1282 \end{code}
1283
1284 Continue with I386-only printing bits and bobs:
1285 \begin{code}
1286 pprDollImm :: Imm -> Doc
1287
1288 pprDollImm i =  ptext SLIT("$") <> pprImm i
1289
1290 pprOperand :: Size -> Operand -> Doc
1291 pprOperand s (OpReg r)   = pprReg s r
1292 pprOperand s (OpImm i)   = pprDollImm i
1293 pprOperand s (OpAddr ea) = pprAddr ea
1294
1295 pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> Doc
1296 pprSizeImmOp name size imm op1
1297   = hcat [
1298         char '\t',
1299         ptext name,
1300         pprSize size,
1301         space,
1302         char '$',
1303         pprImm imm,
1304         comma,
1305         pprOperand size op1
1306     ]
1307
1308 pprSizeOp :: LitString -> Size -> Operand -> Doc
1309 pprSizeOp name size op1
1310   = hcat [
1311         char '\t',
1312         ptext name,
1313         pprSize size,
1314         space,
1315         pprOperand size op1
1316     ]
1317
1318 pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1319 pprSizeOpOp name size op1 op2
1320   = hcat [
1321         char '\t',
1322         ptext name,
1323         pprSize size,
1324         space,
1325         pprOperand size op1,
1326         comma,
1327         pprOperand size op2
1328     ]
1329
1330 pprSizeByteOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1331 pprSizeByteOpOp name size op1 op2
1332   = hcat [
1333         char '\t',
1334         ptext name,
1335         pprSize size,
1336         space,
1337         pprOperand B op1,
1338         comma,
1339         pprOperand size op2
1340     ]
1341
1342 pprSizeOpReg :: LitString -> Size -> Operand -> Reg -> Doc
1343 pprSizeOpReg name size op1 reg
1344   = hcat [
1345         char '\t',
1346         ptext name,
1347         pprSize size,
1348         space,
1349         pprOperand size op1,
1350         comma,
1351         pprReg size reg
1352     ]
1353
1354 pprSizeReg :: LitString -> Size -> Reg -> Doc
1355 pprSizeReg name size reg1
1356   = hcat [
1357         char '\t',
1358         ptext name,
1359         pprSize size,
1360         space,
1361         pprReg size reg1
1362     ]
1363
1364 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1365 pprSizeRegReg name size reg1 reg2
1366   = hcat [
1367         char '\t',
1368         ptext name,
1369         pprSize size,
1370         space,
1371         pprReg size reg1,
1372         comma,
1373         pprReg size reg2
1374     ]
1375
1376 pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc
1377 pprCondRegReg name size cond reg1 reg2
1378   = hcat [
1379         char '\t',
1380         ptext name,
1381         pprCond cond,
1382         space,
1383         pprReg size reg1,
1384         comma,
1385         pprReg size reg2
1386     ]
1387
1388 pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> Doc
1389 pprSizeSizeRegReg name size1 size2 reg1 reg2
1390   = hcat [
1391         char '\t',
1392         ptext name,
1393         pprSize size1,
1394         pprSize size2,
1395         space,
1396         pprReg size1 reg1,
1397
1398         comma,
1399         pprReg size2 reg2
1400     ]
1401
1402 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1403 pprSizeRegRegReg name size reg1 reg2 reg3
1404   = hcat [
1405         char '\t',
1406         ptext name,
1407         pprSize size,
1408         space,
1409         pprReg size reg1,
1410         comma,
1411         pprReg size reg2,
1412         comma,
1413         pprReg size reg3
1414     ]
1415
1416 pprSizeAddr :: LitString -> Size -> MachRegsAddr -> Doc
1417 pprSizeAddr name size op
1418   = hcat [
1419         char '\t',
1420         ptext name,
1421         pprSize size,
1422         space,
1423         pprAddr op
1424     ]
1425
1426 pprSizeAddrReg :: LitString -> Size -> MachRegsAddr -> Reg -> Doc
1427 pprSizeAddrReg name size op dst
1428   = hcat [
1429         char '\t',
1430         ptext name,
1431         pprSize size,
1432         space,
1433         pprAddr op,
1434         comma,
1435         pprReg size dst
1436     ]
1437
1438 pprSizeRegAddr :: LitString -> Size -> Reg -> MachRegsAddr -> Doc
1439 pprSizeRegAddr name size src op
1440   = hcat [
1441         char '\t',
1442         ptext name,
1443         pprSize size,
1444         space,
1445         pprReg size src,
1446         comma,
1447         pprAddr op
1448     ]
1449
1450 pprOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1451 pprOpOp name size op1 op2
1452   = hcat [
1453         char '\t',
1454         ptext name, space,
1455         pprOperand size op1,
1456         comma,
1457         pprOperand size op2
1458     ]
1459
1460 pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> Doc
1461 pprSizeOpOpCoerce name size1 size2 op1 op2
1462   = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1463         pprOperand size1 op1,
1464         comma,
1465         pprOperand size2 op2
1466     ]
1467
1468 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1469 pprCondInstr name cond arg
1470   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1471
1472 #endif {-i386_TARGET_ARCH-}
1473 \end{code}
1474
1475 %************************************************************************
1476 %*                                                                      *
1477 \subsubsection{@pprInstr@ for a SPARC}
1478 %*                                                                      *
1479 %************************************************************************
1480
1481 \begin{code}
1482 #if sparc_TARGET_ARCH
1483
1484 -- a clumsy hack for now, to handle possible double alignment problems
1485
1486 -- even clumsier, to allow for RegReg regs that show when doing indexed
1487 -- reads (bytearrays).
1488 --
1489
1490 -- Translate to the following:
1491 --    add g1,g2,g1
1492 --    ld  [g1],%fn
1493 --    ld  [g1+4],%f(n+1)
1494 --    sub g1,g2,g1           -- to restore g1
1495 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1496   = vcat [
1497        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1498        hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1499        hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1500        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1501     ]
1502
1503 -- Translate to
1504 --    ld  [addr],%fn
1505 --    ld  [addr+4],%f(n+1)
1506 pprInstr (LD DF addr reg) | isJust off_addr
1507   = vcat [
1508        hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1509        hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1510     ]
1511   where
1512     off_addr = addrOffset addr 4
1513     addr2 = case off_addr of Just x -> x
1514
1515
1516 pprInstr (LD size addr reg)
1517   = hcat [
1518        ptext SLIT("\tld"),
1519        pprSize size,
1520        char '\t',
1521        lbrack,
1522        pprAddr addr,
1523        pp_rbracket_comma,
1524        pprReg reg
1525     ]
1526
1527 -- The same clumsy hack as above
1528
1529 -- Translate to the following:
1530 --    add g1,g2,g1
1531 --    st  %fn,[g1]
1532 --    st  %f(n+1),[g1+4]
1533 --    sub g1,g2,g1           -- to restore g1
1534 pprInstr (ST DF reg (AddrRegReg g1 g2))
1535  = vcat [
1536        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1537        hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1538              pprReg g1, rbrack],
1539        hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1540              pprReg g1, ptext SLIT("+4]")],
1541        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1542     ]
1543
1544 -- Translate to
1545 --    st  %fn,[addr]
1546 --    st  %f(n+1),[addr+4]
1547 pprInstr (ST DF reg addr) | isJust off_addr
1548  = vcat [
1549       hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1550             pprAddr addr, rbrack],
1551       hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1552             pprAddr addr2, rbrack]
1553     ]
1554   where
1555     off_addr = addrOffset addr 4
1556     addr2 = case off_addr of Just x -> x
1557
1558 -- no distinction is made between signed and unsigned bytes on stores for the
1559 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1560 -- so we call a special-purpose pprSize for ST..
1561
1562 pprInstr (ST size reg addr)
1563   = hcat [
1564        ptext SLIT("\tst"),
1565        pprStSize size,
1566        char '\t',
1567        pprReg reg,
1568        pp_comma_lbracket,
1569        pprAddr addr,
1570        rbrack
1571     ]
1572
1573 pprInstr (ADD x cc reg1 ri reg2)
1574   | not x && not cc && riZero ri
1575   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1576   | otherwise
1577   = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1578
1579 pprInstr (SUB x cc reg1 ri reg2)
1580   | not x && cc && reg2 == g0
1581   = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1582   | not x && not cc && riZero ri
1583   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1584   | otherwise
1585   = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1586
1587 pprInstr (AND  b reg1 ri reg2) = pprRegRIReg SLIT("and")  b reg1 ri reg2
1588 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1589
1590 pprInstr (OR b reg1 ri reg2)
1591   | not b && reg1 == g0
1592   = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1593     in  case ri of
1594            RIReg rrr | rrr == reg2 -> empty
1595            other                   -> doit
1596   | otherwise
1597   = pprRegRIReg SLIT("or") b reg1 ri reg2
1598
1599 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1600
1601 pprInstr (XOR  b reg1 ri reg2) = pprRegRIReg SLIT("xor")  b reg1 ri reg2
1602 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1603
1604 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1605 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1606 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1607
1608 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1609 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul")  b reg1 ri reg2
1610 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul")  b reg1 ri reg2
1611
1612 pprInstr (SETHI imm reg)
1613   = hcat [
1614         ptext SLIT("\tsethi\t"),
1615         pprImm imm,
1616         comma,
1617         pprReg reg
1618     ]
1619
1620 pprInstr NOP = ptext SLIT("\tnop")
1621
1622 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1623 pprInstr (FABS DF reg1 reg2)
1624   = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1625     (if (reg1 == reg2) then empty
1626      else (<>) (char '\n')
1627           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1628
1629 pprInstr (FADD size reg1 reg2 reg3)
1630   = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1631 pprInstr (FCMP e size reg1 reg2)
1632   = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1633 pprInstr (FDIV size reg1 reg2 reg3)
1634   = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1635
1636 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1637 pprInstr (FMOV DF reg1 reg2)
1638   = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1639     (if (reg1 == reg2) then empty
1640      else (<>) (char '\n')
1641           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1642
1643 pprInstr (FMUL size reg1 reg2 reg3)
1644   = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1645
1646 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1647 pprInstr (FNEG DF reg1 reg2)
1648   = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1649     (if (reg1 == reg2) then empty
1650      else (<>) (char '\n')
1651           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1652
1653 pprInstr (FSQRT size reg1 reg2)     = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1654 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1655 pprInstr (FxTOy size1 size2 reg1 reg2)
1656   = hcat [
1657         ptext SLIT("\tf"),
1658         ptext
1659         (case size1 of
1660             W  -> SLIT("ito")
1661             F  -> SLIT("sto")
1662             DF -> SLIT("dto")),
1663         ptext
1664         (case size2 of
1665             W  -> SLIT("i\t")
1666             F  -> SLIT("s\t")
1667             DF -> SLIT("d\t")),
1668         pprReg reg1, comma, pprReg reg2
1669     ]
1670
1671
1672 pprInstr (BI cond b lab)
1673   = hcat [
1674         ptext SLIT("\tb"), pprCond cond,
1675         if b then pp_comma_a else empty,
1676         char '\t',
1677         pprImm lab
1678     ]
1679
1680 pprInstr (BF cond b lab)
1681   = hcat [
1682         ptext SLIT("\tfb"), pprCond cond,
1683         if b then pp_comma_a else empty,
1684         char '\t',
1685         pprImm lab
1686     ]
1687
1688 pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1689
1690 pprInstr (CALL (Left imm) n _)
1691   = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1692 pprInstr (CALL (Right reg) n _)
1693   = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1694 \end{code}
1695
1696 Continue with SPARC-only printing bits and bobs:
1697 \begin{code}
1698 pprRI :: RI -> Doc
1699 pprRI (RIReg r) = pprReg r
1700 pprRI (RIImm r) = pprImm r
1701
1702 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1703 pprSizeRegReg name size reg1 reg2
1704   = hcat [
1705         char '\t',
1706         ptext name,
1707         (case size of
1708             F  -> ptext SLIT("s\t")
1709             DF -> ptext SLIT("d\t")),
1710         pprReg reg1,
1711         comma,
1712         pprReg reg2
1713     ]
1714
1715 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1716 pprSizeRegRegReg name size reg1 reg2 reg3
1717   = hcat [
1718         char '\t',
1719         ptext name,
1720         (case size of
1721             F  -> ptext SLIT("s\t")
1722             DF -> ptext SLIT("d\t")),
1723         pprReg reg1,
1724         comma,
1725         pprReg reg2,
1726         comma,
1727         pprReg reg3
1728     ]
1729
1730 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
1731 pprRegRIReg name b reg1 ri reg2
1732   = hcat [
1733         char '\t',
1734         ptext name,
1735         if b then ptext SLIT("cc\t") else char '\t',
1736         pprReg reg1,
1737         comma,
1738         pprRI ri,
1739         comma,
1740         pprReg reg2
1741     ]
1742
1743 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
1744 pprRIReg name b ri reg1
1745   = hcat [
1746         char '\t',
1747         ptext name,
1748         if b then ptext SLIT("cc\t") else char '\t',
1749         pprRI ri,
1750         comma,
1751         pprReg reg1
1752     ]
1753
1754 pp_ld_lbracket    = ptext SLIT("\tld\t[")
1755 pp_rbracket_comma = text "],"
1756 pp_comma_lbracket = text ",["
1757 pp_comma_a        = text ",a"
1758
1759 #endif {-sparc_TARGET_ARCH-}
1760 \end{code}