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