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 imm)             = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
 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 :: FAST_STRING -> 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 :: FAST_STRING -> 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 :: FAST_STRING -> 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 :: FAST_STRING -> 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 :: FAST_STRING -> 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 :: FAST_STRING -> 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 :: FAST_STRING -> 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 :: FAST_STRING -> 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 :: FAST_STRING -> 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         comma,
1398         pprReg size2 reg2
1399     ]
1400
1401 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
1402 pprSizeRegRegReg name size reg1 reg2 reg3
1403   = hcat [
1404         char '\t',
1405         ptext name,
1406         pprSize size,
1407         space,
1408         pprReg size reg1,
1409         comma,
1410         pprReg size reg2,
1411         comma,
1412         pprReg size reg3
1413     ]
1414
1415 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> Doc
1416 pprSizeAddr name size op
1417   = hcat [
1418         char '\t',
1419         ptext name,
1420         pprSize size,
1421         space,
1422         pprAddr op
1423     ]
1424
1425 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> Doc
1426 pprSizeAddrReg name size op dst
1427   = hcat [
1428         char '\t',
1429         ptext name,
1430         pprSize size,
1431         space,
1432         pprAddr op,
1433         comma,
1434         pprReg size dst
1435     ]
1436
1437 pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> Doc
1438 pprSizeRegAddr name size src op
1439   = hcat [
1440         char '\t',
1441         ptext name,
1442         pprSize size,
1443         space,
1444         pprReg size src,
1445         comma,
1446         pprAddr op
1447     ]
1448
1449 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
1450 pprOpOp name size op1 op2
1451   = hcat [
1452         char '\t',
1453         ptext name, space,
1454         pprOperand size op1,
1455         comma,
1456         pprOperand size op2
1457     ]
1458
1459 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> Doc
1460 pprSizeOpOpCoerce name size1 size2 op1 op2
1461   = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1462         pprOperand size1 op1,
1463         comma,
1464         pprOperand size2 op2
1465     ]
1466
1467 pprCondInstr :: FAST_STRING -> Cond -> Doc -> Doc
1468 pprCondInstr name cond arg
1469   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1470
1471 #endif {-i386_TARGET_ARCH-}
1472 \end{code}
1473
1474 %************************************************************************
1475 %*                                                                      *
1476 \subsubsection{@pprInstr@ for a SPARC}
1477 %*                                                                      *
1478 %************************************************************************
1479
1480 \begin{code}
1481 #if sparc_TARGET_ARCH
1482
1483 -- a clumsy hack for now, to handle possible double alignment problems
1484
1485 -- even clumsier, to allow for RegReg regs that show when doing indexed
1486 -- reads (bytearrays).
1487 --
1488
1489 -- Translate to the following:
1490 --    add g1,g2,g1
1491 --    ld  [g1],%fn
1492 --    ld  [g1+4],%f(n+1)
1493 --    sub g1,g2,g1           -- to restore g1
1494 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1495   = vcat [
1496        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1497        hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1498        hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1499        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1500     ]
1501
1502 -- Translate to
1503 --    ld  [addr],%fn
1504 --    ld  [addr+4],%f(n+1)
1505 pprInstr (LD DF addr reg) | isJust off_addr
1506   = vcat [
1507        hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1508        hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1509     ]
1510   where
1511     off_addr = addrOffset addr 4
1512     addr2 = case off_addr of Just x -> x
1513
1514
1515 pprInstr (LD size addr reg)
1516   = hcat [
1517        ptext SLIT("\tld"),
1518        pprSize size,
1519        char '\t',
1520        lbrack,
1521        pprAddr addr,
1522        pp_rbracket_comma,
1523        pprReg reg
1524     ]
1525
1526 -- The same clumsy hack as above
1527
1528 -- Translate to the following:
1529 --    add g1,g2,g1
1530 --    st  %fn,[g1]
1531 --    st  %f(n+1),[g1+4]
1532 --    sub g1,g2,g1           -- to restore g1
1533 pprInstr (ST DF reg (AddrRegReg g1 g2))
1534  = vcat [
1535        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1536        hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1537              pprReg g1, rbrack],
1538        hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1539              pprReg g1, ptext SLIT("+4]")],
1540        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1541     ]
1542
1543 -- Translate to
1544 --    st  %fn,[addr]
1545 --    st  %f(n+1),[addr+4]
1546 pprInstr (ST DF reg addr) | isJust off_addr
1547  = vcat [
1548       hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1549             pprAddr addr, rbrack],
1550       hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1551             pprAddr addr2, rbrack]
1552     ]
1553   where
1554     off_addr = addrOffset addr 4
1555     addr2 = case off_addr of Just x -> x
1556
1557 -- no distinction is made between signed and unsigned bytes on stores for the
1558 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1559 -- so we call a special-purpose pprSize for ST..
1560
1561 pprInstr (ST size reg addr)
1562   = hcat [
1563        ptext SLIT("\tst"),
1564        pprStSize size,
1565        char '\t',
1566        pprReg reg,
1567        pp_comma_lbracket,
1568        pprAddr addr,
1569        rbrack
1570     ]
1571
1572 pprInstr (ADD x cc reg1 ri reg2)
1573   | not x && not cc && riZero ri
1574   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1575   | otherwise
1576   = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1577
1578 pprInstr (SUB x cc reg1 ri reg2)
1579   | not x && cc && reg2 == g0
1580   = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1581   | not x && not cc && riZero ri
1582   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1583   | otherwise
1584   = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1585
1586 pprInstr (AND  b reg1 ri reg2) = pprRegRIReg SLIT("and")  b reg1 ri reg2
1587 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1588
1589 pprInstr (OR b reg1 ri reg2)
1590   | not b && reg1 == g0
1591   = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1592     in  case ri of
1593            RIReg rrr | rrr == reg2 -> empty
1594            other                   -> doit
1595   | otherwise
1596   = pprRegRIReg SLIT("or") b reg1 ri reg2
1597
1598 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1599
1600 pprInstr (XOR  b reg1 ri reg2) = pprRegRIReg SLIT("xor")  b reg1 ri reg2
1601 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1602
1603 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1604 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1605 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1606
1607 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1608 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul")  b reg1 ri reg2
1609 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul")  b reg1 ri reg2
1610
1611 pprInstr (SETHI imm reg)
1612   = hcat [
1613         ptext SLIT("\tsethi\t"),
1614         pprImm imm,
1615         comma,
1616         pprReg reg
1617     ]
1618
1619 pprInstr NOP = ptext SLIT("\tnop")
1620
1621 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1622 pprInstr (FABS DF reg1 reg2)
1623   = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1624     (if (reg1 == reg2) then empty
1625      else (<>) (char '\n')
1626           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1627
1628 pprInstr (FADD size reg1 reg2 reg3)
1629   = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1630 pprInstr (FCMP e size reg1 reg2)
1631   = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1632 pprInstr (FDIV size reg1 reg2 reg3)
1633   = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1634
1635 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1636 pprInstr (FMOV DF reg1 reg2)
1637   = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1638     (if (reg1 == reg2) then empty
1639      else (<>) (char '\n')
1640           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1641
1642 pprInstr (FMUL size reg1 reg2 reg3)
1643   = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1644
1645 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1646 pprInstr (FNEG DF reg1 reg2)
1647   = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1648     (if (reg1 == reg2) then empty
1649      else (<>) (char '\n')
1650           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1651
1652 pprInstr (FSQRT size reg1 reg2)     = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1653 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1654 pprInstr (FxTOy size1 size2 reg1 reg2)
1655   = hcat [
1656         ptext SLIT("\tf"),
1657         ptext
1658         (case size1 of
1659             W  -> SLIT("ito")
1660             F  -> SLIT("sto")
1661             DF -> SLIT("dto")),
1662         ptext
1663         (case size2 of
1664             W  -> SLIT("i\t")
1665             F  -> SLIT("s\t")
1666             DF -> SLIT("d\t")),
1667         pprReg reg1, comma, pprReg reg2
1668     ]
1669
1670
1671 pprInstr (BI cond b lab)
1672   = hcat [
1673         ptext SLIT("\tb"), pprCond cond,
1674         if b then pp_comma_a else empty,
1675         char '\t',
1676         pprImm lab
1677     ]
1678
1679 pprInstr (BF cond b lab)
1680   = hcat [
1681         ptext SLIT("\tfb"), pprCond cond,
1682         if b then pp_comma_a else empty,
1683         char '\t',
1684         pprImm lab
1685     ]
1686
1687 pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1688
1689 pprInstr (CALL imm n _)
1690   = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1691 \end{code}
1692
1693 Continue with SPARC-only printing bits and bobs:
1694 \begin{code}
1695 pprRI :: RI -> Doc
1696 pprRI (RIReg r) = pprReg r
1697 pprRI (RIImm r) = pprImm r
1698
1699 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Doc
1700 pprSizeRegReg name size reg1 reg2
1701   = hcat [
1702         char '\t',
1703         ptext name,
1704         (case size of
1705             F  -> ptext SLIT("s\t")
1706             DF -> ptext SLIT("d\t")),
1707         pprReg reg1,
1708         comma,
1709         pprReg reg2
1710     ]
1711
1712 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
1713 pprSizeRegRegReg name size reg1 reg2 reg3
1714   = hcat [
1715         char '\t',
1716         ptext name,
1717         (case size of
1718             F  -> ptext SLIT("s\t")
1719             DF -> ptext SLIT("d\t")),
1720         pprReg reg1,
1721         comma,
1722         pprReg reg2,
1723         comma,
1724         pprReg reg3
1725     ]
1726
1727 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> Doc
1728 pprRegRIReg name b reg1 ri reg2
1729   = hcat [
1730         char '\t',
1731         ptext name,
1732         if b then ptext SLIT("cc\t") else char '\t',
1733         pprReg reg1,
1734         comma,
1735         pprRI ri,
1736         comma,
1737         pprReg reg2
1738     ]
1739
1740 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Doc
1741 pprRIReg name b ri reg1
1742   = hcat [
1743         char '\t',
1744         ptext name,
1745         if b then ptext SLIT("cc\t") else char '\t',
1746         pprRI ri,
1747         comma,
1748         pprReg reg1
1749     ]
1750
1751 pp_ld_lbracket    = ptext SLIT("\tld\t[")
1752 pp_rbracket_comma = text "],"
1753 pp_comma_lbracket = text ",["
1754 pp_comma_a        = text ",a"
1755
1756 #endif {-sparc_TARGET_ARCH-}
1757 \end{code}