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 (pprUnique u)
  55       VirtualRegF u  -> text "%vF_" <> asmSDoc (pprUnique 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         W   -> SLIT("")
 211         F   -> SLIT("")
 212         DF  -> SLIT("d")
 213     )
 214 pprStSize :: Size -> Doc
 215 pprStSize x = ptext (case x of
 216         B   -> SLIT("b")
 217         Bu  -> SLIT("b")
 218         W   -> SLIT("")
 219         F   -> SLIT("")
 220         DF  -> SLIT("d")
 221 #endif
 222     )
 223 \end{code}
 224
 225 %************************************************************************
 226 %*                                                                      *
 227 \subsection{@pprCond@: print a @Cond@}
 228 %*                                                                      *
 229 %************************************************************************
 230
 231 \begin{code}
 232 pprCond :: Cond -> Doc
 233
 234 pprCond c = ptext (case c of {
 235 #if alpha_TARGET_ARCH
 236         EQQ  -> SLIT("eq");
 237         LTT  -> SLIT("lt");
 238         LE  -> SLIT("le");
 239         ULT -> SLIT("ult");
 240         ULE -> SLIT("ule");
 241         NE  -> SLIT("ne");
 242         GTT  -> SLIT("gt");
 243         GE  -> SLIT("ge")
 244 #endif
 245 #if i386_TARGET_ARCH
 246         GEU     -> SLIT("ae");  LU    -> SLIT("b");
 247         EQQ     -> SLIT("e");   GTT    -> SLIT("g");
 248         GE      -> SLIT("ge");  GU    -> SLIT("a");
 249         LTT     -> SLIT("l");   LE    -> SLIT("le");
 250         LEU     -> SLIT("be");  NE    -> SLIT("ne");
 251         NEG     -> SLIT("s");   POS   -> SLIT("ns");
 252         ALWAYS  -> SLIT("mp")   -- hack
 253 #endif
 254 #if sparc_TARGET_ARCH
 255         ALWAYS  -> SLIT("");    NEVER -> SLIT("n");
 256         GEU     -> SLIT("geu"); LU    -> SLIT("lu");
 257         EQQ     -> SLIT("e");   GTT   -> SLIT("g");
 258         GE      -> SLIT("ge");  GU    -> SLIT("gu");
 259         LTT     -> SLIT("l");   LE    -> SLIT("le");
 260         LEU     -> SLIT("leu"); NE    -> SLIT("ne");
 261         NEG     -> SLIT("neg"); POS   -> SLIT("pos");
 262         VC      -> SLIT("vc");  VS    -> SLIT("vs")
 263 #endif
 264     })
 265 \end{code}
 266
 267 %************************************************************************
 268 %*                                                                      *
 269 \subsection{@pprImm@: print an @Imm@}
 270 %*                                                                      *
 271 %************************************************************************
 272
 273 \begin{code}
 274 pprImm :: Imm -> Doc
 275
 276 pprImm (ImmInt i)     = int i
 277 pprImm (ImmInteger i) = integer i
 278 pprImm (ImmCLbl l)    = (if labelDynamic l then text "__imp_" else empty)
 279                         <> pprCLabel_asm l
 280 pprImm (ImmIndex l i) = (if labelDynamic l then text "__imp_" else empty)
 281                         <> pprCLabel_asm l <> char '+' <> int i
 282 pprImm (ImmLit s)     = s
 283
 284 pprImm (ImmLab dll s) = (if underscorePrefix then char '_' else empty)
 285                         <> (if dll then text "_imp__" else empty)
 286                         <> s
 287
 288 #if sparc_TARGET_ARCH
 289 pprImm (LO i)
 290   = hcat [ pp_lo, pprImm i, rparen ]
 291   where
 292     pp_lo = text "%lo("
 293
 294 pprImm (HI i)
 295   = hcat [ pp_hi, pprImm i, rparen ]
 296   where
 297     pp_hi = text "%hi("
 298 #endif
 299 \end{code}
 300
 301 %************************************************************************
 302 %*                                                                      *
 303 \subsection{@pprAddr@: print an @Addr@}
 304 %*                                                                      *
 305 %************************************************************************
 306
 307 \begin{code}
 308 pprAddr :: MachRegsAddr -> Doc
 309
 310 #if alpha_TARGET_ARCH
 311 pprAddr (AddrReg r) = parens (pprReg r)
 312 pprAddr (AddrImm i) = pprImm i
 313 pprAddr (AddrRegImm r1 i)
 314   = (<>) (pprImm i) (parens (pprReg r1))
 315 #endif
 316
 317 -------------------
 318
 319 #if i386_TARGET_ARCH
 320 pprAddr (ImmAddr imm off)
 321   = let pp_imm = pprImm imm
 322     in
 323     if (off == 0) then
 324         pp_imm
 325     else if (off < 0) then
 326         pp_imm <> int off
 327     else
 328         pp_imm <> char '+' <> int off
 329
 330 pprAddr (AddrBaseIndex base index displacement)
 331   = let
 332         pp_disp  = ppr_disp displacement
 333         pp_off p = pp_disp <> char '(' <> p <> char ')'
 334         pp_reg r = pprReg L r
 335     in
 336     case (base,index) of
 337       (Nothing, Nothing)    -> pp_disp
 338       (Just b,  Nothing)    -> pp_off (pp_reg b)
 339       (Nothing, Just (r,i)) -> pp_off (pp_reg r <> comma <> int i)
 340       (Just b,  Just (r,i)) -> pp_off (pp_reg b <> comma <> pp_reg r
 341                                        <> comma <> int i)
 342   where
 343     ppr_disp (ImmInt 0) = empty
 344     ppr_disp imm        = pprImm imm
 345 #endif
 346
 347 -------------------
 348
 349 #if sparc_TARGET_ARCH
 350 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
 351
 352 pprAddr (AddrRegReg r1 r2)
 353   = hcat [ pprReg r1, char '+', pprReg r2 ]
 354
 355 pprAddr (AddrRegImm r1 (ImmInt i))
 356   | i == 0 = pprReg r1
 357   | not (fits13Bits i) = largeOffsetError i
 358   | otherwise = hcat [ pprReg r1, pp_sign, int i ]
 359   where
 360     pp_sign = if i > 0 then char '+' else empty
 361
 362 pprAddr (AddrRegImm r1 (ImmInteger i))
 363   | i == 0 = pprReg r1
 364   | not (fits13Bits i) = largeOffsetError i
 365   | otherwise  = hcat [ pprReg r1, pp_sign, integer i ]
 366   where
 367     pp_sign = if i > 0 then char '+' else empty
 368
 369 pprAddr (AddrRegImm r1 imm)
 370   = hcat [ pprReg r1, char '+', pprImm imm ]
 371 #endif
 372 \end{code}
 373
 374 %************************************************************************
 375 %*                                                                      *
 376 \subsection{@pprInstr@: print an @Instr@}
 377 %*                                                                      *
 378 %************************************************************************
 379
 380 \begin{code}
 381 pprInstr :: Instr -> Doc
 382
 383 --pprInstr (COMMENT s) = empty -- nuke 'em
 384 pprInstr (COMMENT s)
 385    =  IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ptext s))
 386      ,IF_ARCH_sparc( ((<>) (ptext SLIT("! "))   (ptext s))
 387      ,IF_ARCH_i386( ((<>) (ptext SLIT("# "))   (ptext s))
 388      ,)))
 389
 390 pprInstr (DELTA d)
 391    = pprInstr (COMMENT (_PK_ ("\tdelta = " ++ show d)))
 392
 393 pprInstr (SEGMENT TextSegment)
 394     =  IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-}
 395       ,IF_ARCH_sparc(ptext SLIT(".text\n\t.align 4") {-word boundary-}
 396       ,IF_ARCH_i386((text ".text\n\t.align 4,0x90") {-needs per-OS variation!-}
 397       ,)))
 398
 399 pprInstr (SEGMENT DataSegment)
 400     = ptext
 401          IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
 402         ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
 403         ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
 404         ,)))
 405
 406 pprInstr (SEGMENT RoDataSegment)
 407     = ptext
 408          IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
 409         ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
 410         ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
 411         ,)))
 412
 413 pprInstr (LABEL clab)
 414   = let
 415         pp_lab = pprCLabel_asm clab
 416     in
 417     hcat [
 418         if not (externallyVisibleCLabel clab) then
 419             empty
 420         else
 421             hcat [ptext
 422                          IF_ARCH_alpha(SLIT("\t.globl\t")
 423                         ,IF_ARCH_i386(SLIT(".globl ")
 424                         ,IF_ARCH_sparc(SLIT(".global\t")
 425                         ,)))
 426                         , pp_lab, char '\n'],
 427         pp_lab,
 428         char ':'
 429     ]
 430
 431 pprInstr (ASCII False{-no backslash conversion-} str)
 432   = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
 433
 434 pprInstr (ASCII True str)
 435   = vcat (map do1 (str ++ [chr 0]))
 436     where
 437        do1 :: Char -> Doc
 438        do1 c = ptext SLIT("\t.byte\t0x") <> hshow (ord c)
 439
 440        hshow :: Int -> Doc
 441        hshow n | n >= 0 && n <= 255
 442                = char (tab !! (n `div` 16)) <> char (tab !! (n `mod` 16))
 443        tab = "0123456789ABCDEF"
 444
 445
 446 pprInstr (DATA s xs)
 447   = vcat (concatMap (ppr_item s) xs)
 448     where
 449
 450 #if alpha_TARGET_ARCH
 451             ppr_item = error "ppr_item on Alpha"
 452 #endif
 453 #if sparc_TARGET_ARCH
 454         -- copy n paste of x86 version
 455         ppr_item B  x = [ptext SLIT("\t.byte\t") <> pprImm x]
 456         ppr_item W  x = [ptext SLIT("\t.long\t") <> pprImm x]
 457         ppr_item F  (ImmFloat r)
 458            = let bs = floatToBytes (fromRational r)
 459              in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
 460         ppr_item DF (ImmDouble r)
 461            = let bs = doubleToBytes (fromRational r)
 462              in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
 463 #endif
 464 #if i386_TARGET_ARCH
 465         ppr_item B  x = [ptext SLIT("\t.byte\t") <> pprImm x]
 466         ppr_item L  x = [ptext SLIT("\t.long\t") <> pprImm x]
 467         ppr_item F  (ImmFloat r)
 468            = let bs = floatToBytes (fromRational r)
 469              in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
 470         ppr_item DF (ImmDouble r)
 471            = let bs = doubleToBytes (fromRational r)
 472              in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
 473 #endif
 474
 475         -- floatToBytes and doubleToBytes convert to the host's byte
 476         -- order.  Providing that we're not cross-compiling for a
 477         -- target with the opposite endianness, this should work ok
 478         -- on all targets.
 479         floatToBytes :: Float -> [Int]
 480         floatToBytes f
 481            = runST (do
 482                 arr <- newFloatArray ((0::Int),3)
 483                 writeFloatArray arr 0 f
 484                 i0 <- readCharArray arr 0
 485                 i1 <- readCharArray arr 1
 486                 i2 <- readCharArray arr 2
 487                 i3 <- readCharArray arr 3
 488                 return (map ord [i0,i1,i2,i3])
 489              )
 490
 491         doubleToBytes :: Double -> [Int]
 492         doubleToBytes d
 493            = runST (do
 494                 arr <- newDoubleArray ((0::Int),7)
 495                 writeDoubleArray arr 0 d
 496                 i0 <- readCharArray arr 0
 497                 i1 <- readCharArray arr 1
 498                 i2 <- readCharArray arr 2
 499                 i3 <- readCharArray arr 3
 500                 i4 <- readCharArray arr 4
 501                 i5 <- readCharArray arr 5
 502                 i6 <- readCharArray arr 6
 503                 i7 <- readCharArray arr 7
 504                 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
 505              )
 506
 507 -- fall through to rest of (machine-specific) pprInstr...
 508 \end{code}
 509
 510 %************************************************************************
 511 %*                                                                      *
 512 \subsubsection{@pprInstr@ for an Alpha}
 513 %*                                                                      *
 514 %************************************************************************
 515
 516 \begin{code}
 517 #if alpha_TARGET_ARCH
 518
 519 pprInstr (LD size reg addr)
 520   = hcat [
 521         ptext SLIT("\tld"),
 522         pprSize size,
 523         char '\t',
 524         pprReg reg,
 525         comma,
 526         pprAddr addr
 527     ]
 528
 529 pprInstr (LDA reg addr)
 530   = hcat [
 531         ptext SLIT("\tlda\t"),
 532         pprReg reg,
 533         comma,
 534         pprAddr addr
 535     ]
 536
 537 pprInstr (LDAH reg addr)
 538   = hcat [
 539         ptext SLIT("\tldah\t"),
 540         pprReg reg,
 541         comma,
 542         pprAddr addr
 543     ]
 544
 545 pprInstr (LDGP reg addr)
 546   = hcat [
 547         ptext SLIT("\tldgp\t"),
 548         pprReg reg,
 549         comma,
 550         pprAddr addr
 551     ]
 552
 553 pprInstr (LDI size reg imm)
 554   = hcat [
 555         ptext SLIT("\tldi"),
 556         pprSize size,
 557         char '\t',
 558         pprReg reg,
 559         comma,
 560         pprImm imm
 561     ]
 562
 563 pprInstr (ST size reg addr)
 564   = hcat [
 565         ptext SLIT("\tst"),
 566         pprSize size,
 567         char '\t',
 568         pprReg reg,
 569         comma,
 570         pprAddr addr
 571     ]
 572
 573 pprInstr (CLR reg)
 574   = hcat [
 575         ptext SLIT("\tclr\t"),
 576         pprReg reg
 577     ]
 578
 579 pprInstr (ABS size ri reg)
 580   = hcat [
 581         ptext SLIT("\tabs"),
 582         pprSize size,
 583         char '\t',
 584         pprRI ri,
 585         comma,
 586         pprReg reg
 587     ]
 588
 589 pprInstr (NEG size ov ri reg)
 590   = hcat [
 591         ptext SLIT("\tneg"),
 592         pprSize size,
 593         if ov then ptext SLIT("v\t") else char '\t',
 594         pprRI ri,
 595         comma,
 596         pprReg reg
 597     ]
 598
 599 pprInstr (ADD size ov reg1 ri reg2)
 600   = hcat [
 601         ptext SLIT("\tadd"),
 602         pprSize size,
 603         if ov then ptext SLIT("v\t") else char '\t',
 604         pprReg reg1,
 605         comma,
 606         pprRI ri,
 607         comma,
 608         pprReg reg2
 609     ]
 610
 611 pprInstr (SADD size scale reg1 ri reg2)
 612   = hcat [
 613         ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
 614         ptext SLIT("add"),
 615         pprSize size,
 616         char '\t',
 617         pprReg reg1,
 618         comma,
 619         pprRI ri,
 620         comma,
 621         pprReg reg2
 622     ]
 623
 624 pprInstr (SUB size ov reg1 ri reg2)
 625   = hcat [
 626         ptext SLIT("\tsub"),
 627         pprSize size,
 628         if ov then ptext SLIT("v\t") else char '\t',
 629         pprReg reg1,
 630         comma,
 631         pprRI ri,
 632         comma,
 633         pprReg reg2
 634     ]
 635
 636 pprInstr (SSUB size scale reg1 ri reg2)
 637   = hcat [
 638         ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
 639         ptext SLIT("sub"),
 640         pprSize size,
 641         char '\t',
 642         pprReg reg1,
 643         comma,
 644         pprRI ri,
 645         comma,
 646         pprReg reg2
 647     ]
 648
 649 pprInstr (MUL size ov reg1 ri reg2)
 650   = hcat [
 651         ptext SLIT("\tmul"),
 652         pprSize size,
 653         if ov then ptext SLIT("v\t") else char '\t',
 654         pprReg reg1,
 655         comma,
 656         pprRI ri,
 657         comma,
 658         pprReg reg2
 659     ]
 660
 661 pprInstr (DIV size uns reg1 ri reg2)
 662   = hcat [
 663         ptext SLIT("\tdiv"),
 664         pprSize size,
 665         if uns then ptext SLIT("u\t") else char '\t',
 666         pprReg reg1,
 667         comma,
 668         pprRI ri,
 669         comma,
 670         pprReg reg2
 671     ]
 672
 673 pprInstr (REM size uns reg1 ri reg2)
 674   = hcat [
 675         ptext SLIT("\trem"),
 676         pprSize size,
 677         if uns then ptext SLIT("u\t") else char '\t',
 678         pprReg reg1,
 679         comma,
 680         pprRI ri,
 681         comma,
 682         pprReg reg2
 683     ]
 684
 685 pprInstr (NOT ri reg)
 686   = hcat [
 687         ptext SLIT("\tnot"),
 688         char '\t',
 689         pprRI ri,
 690         comma,
 691         pprReg reg
 692     ]
 693
 694 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
 695 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
 696 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
 697 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
 698 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
 699 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
 700
 701 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
 702 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
 703 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
 704
 705 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
 706 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
 707
 708 pprInstr (NOP) = ptext SLIT("\tnop")
 709
 710 pprInstr (CMP cond reg1 ri reg2)
 711   = hcat [
 712         ptext SLIT("\tcmp"),
 713         pprCond cond,
 714         char '\t',
 715         pprReg reg1,
 716         comma,
 717         pprRI ri,
 718         comma,
 719         pprReg reg2
 720     ]
 721
 722 pprInstr (FCLR reg)
 723   = hcat [
 724         ptext SLIT("\tfclr\t"),
 725         pprReg reg
 726     ]
 727
 728 pprInstr (FABS reg1 reg2)
 729   = hcat [
 730         ptext SLIT("\tfabs\t"),
 731         pprReg reg1,
 732         comma,
 733         pprReg reg2
 734     ]
 735
 736 pprInstr (FNEG size reg1 reg2)
 737   = hcat [
 738         ptext SLIT("\tneg"),
 739         pprSize size,
 740         char '\t',
 741         pprReg reg1,
 742         comma,
 743         pprReg reg2
 744     ]
 745
 746 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
 747 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
 748 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
 749 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
 750
 751 pprInstr (CVTxy size1 size2 reg1 reg2)
 752   = hcat [
 753         ptext SLIT("\tcvt"),
 754         pprSize size1,
 755         case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
 756         char '\t',
 757         pprReg reg1,
 758         comma,
 759         pprReg reg2
 760     ]
 761
 762 pprInstr (FCMP size cond reg1 reg2 reg3)
 763   = hcat [
 764         ptext SLIT("\tcmp"),
 765         pprSize size,
 766         pprCond cond,
 767         char '\t',
 768         pprReg reg1,
 769         comma,
 770         pprReg reg2,
 771         comma,
 772         pprReg reg3
 773     ]
 774
 775 pprInstr (FMOV reg1 reg2)
 776   = hcat [
 777         ptext SLIT("\tfmov\t"),
 778         pprReg reg1,
 779         comma,
 780         pprReg reg2
 781     ]
 782
 783 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
 784
 785 pprInstr (BI NEVER reg lab) = empty
 786
 787 pprInstr (BI cond reg lab)
 788   = hcat [
 789         ptext SLIT("\tb"),
 790         pprCond cond,
 791         char '\t',
 792         pprReg reg,
 793         comma,
 794         pprImm lab
 795     ]
 796
 797 pprInstr (BF cond reg lab)
 798   = hcat [
 799         ptext SLIT("\tfb"),
 800         pprCond cond,
 801         char '\t',
 802         pprReg reg,
 803         comma,
 804         pprImm lab
 805     ]
 806
 807 pprInstr (BR lab)
 808   = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
 809
 810 pprInstr (JMP reg addr hint)
 811   = hcat [
 812         ptext SLIT("\tjmp\t"),
 813         pprReg reg,
 814         comma,
 815         pprAddr addr,
 816         comma,
 817         int hint
 818     ]
 819
 820 pprInstr (BSR imm n)
 821   = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
 822
 823 pprInstr (JSR reg addr n)
 824   = hcat [
 825         ptext SLIT("\tjsr\t"),
 826         pprReg reg,
 827         comma,
 828         pprAddr addr
 829     ]
 830
 831 pprInstr (FUNBEGIN clab)
 832   = hcat [
 833         if (externallyVisibleCLabel clab) then
 834             hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
 835         else
 836             empty,
 837         ptext SLIT("\t.ent "),
 838         pp_lab,
 839         char '\n',
 840         pp_lab,
 841         pp_ldgp,
 842         pp_lab,
 843         pp_frame
 844     ]
 845     where
 846         pp_lab = pprCLabel_asm clab
 847
 848         -- NEVER use commas within those string literals, cpp will ruin your day
 849         pp_ldgp  = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
 850         pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
 851                           ptext SLIT("4240"), char ',',
 852                           ptext SLIT("$26"), char ',',
 853                           ptext SLIT("0\n\t.prologue 1") ]
 854
 855 pprInstr (FUNEND clab)
 856   = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
 857 \end{code}
 858
 859 Continue with Alpha-only printing bits and bobs:
 860 \begin{code}
 861 pprRI :: RI -> Doc
 862
 863 pprRI (RIReg r) = pprReg r
 864 pprRI (RIImm r) = pprImm r
 865
 866 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> Doc
 867
 868 pprRegRIReg name reg1 ri reg2
 869   = hcat [
 870         char '\t',
 871         ptext name,
 872         char '\t',
 873         pprReg reg1,
 874         comma,
 875         pprRI ri,
 876         comma,
 877         pprReg reg2
 878     ]
 879
 880 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
 881
 882 pprSizeRegRegReg name size reg1 reg2 reg3
 883   = hcat [
 884         char '\t',
 885         ptext name,
 886         pprSize size,
 887         char '\t',
 888         pprReg reg1,
 889         comma,
 890         pprReg reg2,
 891         comma,
 892         pprReg reg3
 893     ]
 894
 895 #endif {-alpha_TARGET_ARCH-}
 896 \end{code}
 897
 898 %************************************************************************
 899 %*                                                                      *
 900 \subsubsection{@pprInstr@ for an I386}
 901 %*                                                                      *
 902 %************************************************************************
 903
 904 \begin{code}
 905 #if i386_TARGET_ARCH
 906
 907 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
 908   | src == dst
 909   =
 910 #if 0 /* #ifdef DEBUG */
 911     (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
 912 #else
 913     empty
 914 #endif
 915 pprInstr (MOV size src dst)
 916   = pprSizeOpOp SLIT("mov") size src dst
 917 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes L src dst
 918 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes L src dst
 919
 920 -- here we do some patching, since the physical registers are only set late
 921 -- in the code generation.
 922 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
 923   | reg1 == reg3
 924   = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
 925 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
 926   | reg2 == reg3
 927   = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
 928 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
 929   | reg1 == reg3
 930   = pprInstr (ADD size (OpImm displ) dst)
 931 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
 932
 933 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
 934   = pprSizeOp SLIT("dec") size dst
 935 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
 936   = pprSizeOp SLIT("inc") size dst
 937 pprInstr (ADD size src dst)
 938   = pprSizeOpOp SLIT("add") size src dst
 939 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
 940 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
 941
 942 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
 943 pprInstr (OR  size src dst) = pprSizeOpOp SLIT("or")  size src dst
 944 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor")  size src dst
 945 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
 946 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
 947
 948 pprInstr (SHL size imm dst) = pprSizeImmOp SLIT("shl") size imm dst
 949 pprInstr (SAR size imm dst) = pprSizeImmOp SLIT("sar") size imm dst
 950 pprInstr (SHR size imm dst) = pprSizeImmOp SLIT("shr") size imm dst
 951 pprInstr (BT  size imm src) = pprSizeImmOp SLIT("bt")  size imm src
 952
 953 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp")  size src dst
 954 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test")  size src dst
 955 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
 956 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
 957 pprInstr PUSHA = ptext SLIT("\tpushal")
 958 pprInstr POPA = ptext SLIT("\tpopal")
 959
 960 pprInstr (NOP) = ptext SLIT("\tnop")
 961 pprInstr (CLTD) = ptext SLIT("\tcltd")
 962
 963 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
 964
 965 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
 966
 967 pprInstr (JMP dsts (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
 968 pprInstr (JMP dsts op)          = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
 969 pprInstr (CALL imm)             = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
 970
 971 pprInstr (IQUOT sz src dst) = pprInstr_quotRem True sz src dst
 972 pprInstr (IREM  sz src dst) = pprInstr_quotRem False sz src dst
 973
 974 -- Simulating a flat register set on the x86 FP stack is tricky.
 975 -- you have to free %st(7) before pushing anything on the FP reg stack
 976 -- so as to preclude the possibility of a FP stack overflow exception.
 977 pprInstr g@(GMOV src dst)
 978    | src == dst
 979    = empty
 980    | otherwise
 981    = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
 982
 983 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
 984 pprInstr g@(GLD sz addr dst)
 985  = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
 986                  pprAddr addr, gsemi, gpop dst 1])
 987
 988 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
 989 pprInstr g@(GST sz src addr)
 990  = pprG g (hcat [gtab, gpush src 0, gsemi,
 991                  text "fstp", pprSize sz, gsp, pprAddr addr])
 992
 993 pprInstr g@(GLDZ dst)
 994  = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
 995 pprInstr g@(GLD1 dst)
 996  = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
 997
 998 pprInstr g@(GFTOD src dst)
 999    = pprG g bogus
1000 pprInstr g@(GFTOI src dst)
1001    = pprG g bogus
1002
1003 pprInstr g@(GDTOF src dst)
1004    = pprG g bogus
1005 pprInstr g@(GDTOI src dst)
1006    = pprG g bogus
1007
1008 pprInstr g@(GITOF src dst)
1009    = pprInstr (GITOD src dst)
1010 pprInstr g@(GITOD src dst)
1011    = pprG g (hcat [gtab, text "pushl ", pprReg L src,
1012                    text " ; ffree %st(7); fildl (%esp) ; ",
1013                    gpop dst 1, text " ; addl $4,%esp"])
1014
1015 pprInstr g@(GCMP sz src1 src2)
1016    = pprG g (hcat [gtab, text "pushl %eax ; ",gpush src1 0]
1017              $$
1018              hcat [gtab, text "fcomp ", greg src2 1,
1019                    text "; fstsw %ax ; sahf ; popl %eax"])
1020
1021 pprInstr g@(GABS sz src dst)
1022    = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1023 pprInstr g@(GNEG sz src dst)
1024    = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1025
1026 pprInstr g@(GSQRT sz src dst)
1027    = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1028              hcat [gtab, gcoerceto sz, gpop dst 1])
1029 pprInstr g@(GSIN sz src dst)
1030    = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1031              hcat [gtab, gcoerceto sz, gpop dst 1])
1032 pprInstr g@(GCOS sz src dst)
1033    = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1034              hcat [gtab, gcoerceto sz, gpop dst 1])
1035 pprInstr g@(GTAN sz src dst)
1036    = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1037                    gpush src 0, text " ; fptan ; ",
1038                    text " fstp %st(0)"] $$
1039              hcat [gtab, gcoerceto sz, gpop dst 1])
1040
1041 -- In the translations for GADD, GMUL, GSUB and GDIV,
1042 -- the first two cases are mere optimisations.  The otherwise clause
1043 -- generates correct code under all circumstances.
1044
1045 pprInstr g@(GADD sz src1 src2 dst)
1046    | src1 == dst
1047    = pprG g (text "\t#GADD-xxxcase1" $$
1048              hcat [gtab, gpush src2 0,
1049                    text " ; faddp %st(0),", greg src1 1])
1050    | src2 == dst
1051    = pprG g (text "\t#GADD-xxxcase2" $$
1052              hcat [gtab, gpush src1 0,
1053                    text " ; faddp %st(0),", greg src2 1])
1054    | otherwise
1055    = pprG g (hcat [gtab, gpush src1 0,
1056                    text " ; fadd ", greg src2 1, text ",%st(0)",
1057                    gsemi, gpop dst 1])
1058
1059
1060 pprInstr g@(GMUL sz src1 src2 dst)
1061    | src1 == dst
1062    = pprG g (text "\t#GMUL-xxxcase1" $$
1063              hcat [gtab, gpush src2 0,
1064                    text " ; fmulp %st(0),", greg src1 1])
1065    | src2 == dst
1066    = pprG g (text "\t#GMUL-xxxcase2" $$
1067              hcat [gtab, gpush src1 0,
1068                    text " ; fmulp %st(0),", greg src2 1])
1069    | otherwise
1070    = pprG g (hcat [gtab, gpush src1 0,
1071                    text " ; fmul ", greg src2 1, text ",%st(0)",
1072                    gsemi, gpop dst 1])
1073
1074
1075 pprInstr g@(GSUB sz src1 src2 dst)
1076    | src1 == dst
1077    = pprG g (text "\t#GSUB-xxxcase1" $$
1078              hcat [gtab, gpush src2 0,
1079                    text " ; fsubrp %st(0),", greg src1 1])
1080    | src2 == dst
1081    = pprG g (text "\t#GSUB-xxxcase2" $$
1082              hcat [gtab, gpush src1 0,
1083                    text " ; fsubp %st(0),", greg src2 1])
1084    | otherwise
1085    = pprG g (hcat [gtab, gpush src1 0,
1086                    text " ; fsub ", greg src2 1, text ",%st(0)",
1087                    gsemi, gpop dst 1])
1088
1089
1090 pprInstr g@(GDIV sz src1 src2 dst)
1091    | src1 == dst
1092    = pprG g (text "\t#GDIV-xxxcase1" $$
1093              hcat [gtab, gpush src2 0,
1094                    text " ; fdivrp %st(0),", greg src1 1])
1095    | src2 == dst
1096    = pprG g (text "\t#GDIV-xxxcase2" $$
1097              hcat [gtab, gpush src1 0,
1098                    text " ; fdivp %st(0),", greg src2 1])
1099    | otherwise
1100    = pprG g (hcat [gtab, gpush src1 0,
1101                    text " ; fdiv ", greg src2 1, text ",%st(0)",
1102                    gsemi, gpop dst 1])
1103
1104
1105 pprInstr GFREE
1106    = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1107             ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1108           ]
1109
1110
1111 pprInstr_quotRem isQuot sz src dst
1112    | case sz of L -> False; _ -> True
1113    = panic "pprInstr_quotRem: dunno how to do non-32bit operands"
1114    | otherwise
1115    = vcat [
1116      (text "\t# BEGIN " <> fakeInsn),
1117      (text "\tpushl $0;  pushl %eax;  pushl %edx;  pushl " <> pprOperand sz src),
1118      (text "\tmovl " <> pprOperand sz dst <> text ",%eax;  xorl %edx,%edx;  cltd"),
1119      (text "\tdivl 0(%esp);  movl " <> text resReg <> text ",12(%esp)"),
1120      (text "\tpopl %edx;  popl %edx;  popl %eax;  popl " <> pprOperand sz dst),
1121      (text "\t# END   " <> fakeInsn)
1122      ]
1123      where
1124         resReg = if isQuot then "%eax" else "%edx"
1125         opStr  = if isQuot then "IQUOT" else "IREM"
1126         fakeInsn = text opStr <+> pprOperand sz src <> char ',' <+> pprOperand sz dst
1127
1128 --------------------------
1129
1130 -- coerce %st(0) to the specified size
1131 gcoerceto DF = empty
1132 gcoerceto  F = text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1133
1134 gpush reg offset
1135    = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1136 gpop reg offset
1137    = hcat [text "fstp ", greg reg offset]
1138
1139 bogus = text "\tbogus"
1140 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1141 gsemi = text " ; "
1142 gtab  = char '\t'
1143 gsp   = char ' '
1144
1145 gregno (RealReg i) = i
1146 gregno other       = --pprPanic "gregno" (ppr other)
1147                      999   -- bogus; only needed for debug printing
1148
1149 pprG :: Instr -> Doc -> Doc
1150 pprG fake actual
1151    = (char '#' <> pprGInstr fake) $$ actual
1152
1153 pprGInstr (GMOV src dst)   = pprSizeRegReg SLIT("gmov") DF src dst
1154 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1155 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1156
1157 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") DF dst
1158 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") DF dst
1159
1160 pprGInstr (GFTOD src dst) = pprSizeSizeRegReg SLIT("gftod") F DF src dst
1161 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L  src dst
1162
1163 pprGInstr (GDTOF src dst) = pprSizeSizeRegReg SLIT("gdtof") DF F src dst
1164 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
1165
1166 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F  src dst
1167 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
1168
1169 pprGInstr (GCMP sz src dst) = pprSizeRegReg SLIT("gcmp") sz src dst
1170 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1171 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1172 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1173 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1174 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1175 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1176
1177 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1178 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1179 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1180 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1181 \end{code}
1182
1183 Continue with I386-only printing bits and bobs:
1184 \begin{code}
1185 pprDollImm :: Imm -> Doc
1186
1187 pprDollImm i =  ptext SLIT("$") <> pprImm i
1188
1189 pprOperand :: Size -> Operand -> Doc
1190 pprOperand s (OpReg r)   = pprReg s r
1191 pprOperand s (OpImm i)   = pprDollImm i
1192 pprOperand s (OpAddr ea) = pprAddr ea
1193
1194 pprSizeImmOp :: FAST_STRING -> Size -> Imm -> Operand -> Doc
1195 pprSizeImmOp name size imm op1
1196   = hcat [
1197         char '\t',
1198         ptext name,
1199         pprSize size,
1200         space,
1201         char '$',
1202         pprImm imm,
1203         comma,
1204         pprOperand size op1
1205     ]
1206
1207 pprSizeOp :: FAST_STRING -> Size -> Operand -> Doc
1208 pprSizeOp name size op1
1209   = hcat [
1210         char '\t',
1211         ptext name,
1212         pprSize size,
1213         space,
1214         pprOperand size op1
1215     ]
1216
1217 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
1218 pprSizeOpOp name size op1 op2
1219   = hcat [
1220         char '\t',
1221         ptext name,
1222         pprSize size,
1223         space,
1224         pprOperand size op1,
1225         comma,
1226         pprOperand size op2
1227     ]
1228
1229 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
1230 pprSizeByteOpOp name size op1 op2
1231   = hcat [
1232         char '\t',
1233         ptext name,
1234         pprSize size,
1235         space,
1236         pprOperand B op1,
1237         comma,
1238         pprOperand size op2
1239     ]
1240
1241 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> Doc
1242 pprSizeOpReg name size op1 reg
1243   = hcat [
1244         char '\t',
1245         ptext name,
1246         pprSize size,
1247         space,
1248         pprOperand size op1,
1249         comma,
1250         pprReg size reg
1251     ]
1252
1253 pprSizeReg :: FAST_STRING -> Size -> Reg -> Doc
1254 pprSizeReg name size reg1
1255   = hcat [
1256         char '\t',
1257         ptext name,
1258         pprSize size,
1259         space,
1260         pprReg size reg1
1261     ]
1262
1263 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Doc
1264 pprSizeRegReg name size reg1 reg2
1265   = hcat [
1266         char '\t',
1267         ptext name,
1268         pprSize size,
1269         space,
1270         pprReg size reg1,
1271         comma,
1272         pprReg size reg2
1273     ]
1274
1275 pprSizeSizeRegReg :: FAST_STRING -> Size -> Size -> Reg -> Reg -> Doc
1276 pprSizeSizeRegReg name size1 size2 reg1 reg2
1277   = hcat [
1278         char '\t',
1279         ptext name,
1280         pprSize size1,
1281         pprSize size2,
1282         space,
1283         pprReg size1 reg1,
1284         comma,
1285         pprReg size2 reg2
1286     ]
1287
1288 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
1289 pprSizeRegRegReg name size reg1 reg2 reg3
1290   = hcat [
1291         char '\t',
1292         ptext name,
1293         pprSize size,
1294         space,
1295         pprReg size reg1,
1296         comma,
1297         pprReg size reg2,
1298         comma,
1299         pprReg size reg3
1300     ]
1301
1302 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> Doc
1303 pprSizeAddr name size op
1304   = hcat [
1305         char '\t',
1306         ptext name,
1307         pprSize size,
1308         space,
1309         pprAddr op
1310     ]
1311
1312 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> Doc
1313 pprSizeAddrReg name size op dst
1314   = hcat [
1315         char '\t',
1316         ptext name,
1317         pprSize size,
1318         space,
1319         pprAddr op,
1320         comma,
1321         pprReg size dst
1322     ]
1323
1324 pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> Doc
1325 pprSizeRegAddr name size src op
1326   = hcat [
1327         char '\t',
1328         ptext name,
1329         pprSize size,
1330         space,
1331         pprReg size src,
1332         comma,
1333         pprAddr op
1334     ]
1335
1336 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
1337 pprOpOp name size op1 op2
1338   = hcat [
1339         char '\t',
1340         ptext name, space,
1341         pprOperand size op1,
1342         comma,
1343         pprOperand size op2
1344     ]
1345
1346 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> Doc
1347 pprSizeOpOpCoerce name size1 size2 op1 op2
1348   = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1349         pprOperand size1 op1,
1350         comma,
1351         pprOperand size2 op2
1352     ]
1353
1354 pprCondInstr :: FAST_STRING -> Cond -> Doc -> Doc
1355 pprCondInstr name cond arg
1356   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1357
1358 #endif {-i386_TARGET_ARCH-}
1359 \end{code}
1360
1361 %************************************************************************
1362 %*                                                                      *
1363 \subsubsection{@pprInstr@ for a SPARC}
1364 %*                                                                      *
1365 %************************************************************************
1366
1367 \begin{code}
1368 #if sparc_TARGET_ARCH
1369
1370 -- a clumsy hack for now, to handle possible double alignment problems
1371
1372 -- even clumsier, to allow for RegReg regs that show when doing indexed
1373 -- reads (bytearrays).
1374 --
1375
1376 -- Translate to the following:
1377 --    add g1,g2,g1
1378 --    ld  [g1],%fn
1379 --    ld  [g1+4],%f(n+1)
1380 --    sub g1,g2,g1           -- to restore g1
1381 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1382   = vcat [
1383        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1384        hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1385        hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1386        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1387     ]
1388
1389 -- Translate to
1390 --    ld  [addr],%fn
1391 --    ld  [addr+4],%f(n+1)
1392 pprInstr (LD DF addr reg) | isJust off_addr
1393   = vcat [
1394        hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1395        hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1396     ]
1397   where
1398     off_addr = addrOffset addr 4
1399     addr2 = case off_addr of Just x -> x
1400
1401
1402 pprInstr (LD size addr reg)
1403   = hcat [
1404        ptext SLIT("\tld"),
1405        pprSize size,
1406        char '\t',
1407        lbrack,
1408        pprAddr addr,
1409        pp_rbracket_comma,
1410        pprReg reg
1411     ]
1412
1413 -- The same clumsy hack as above
1414
1415 -- Translate to the following:
1416 --    add g1,g2,g1
1417 --    st  %fn,[g1]
1418 --    st  %f(n+1),[g1+4]
1419 --    sub g1,g2,g1           -- to restore g1
1420 pprInstr (ST DF reg (AddrRegReg g1 g2))
1421  = vcat [
1422        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1423        hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1424              pprReg g1, rbrack],
1425        hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1426              pprReg g1, ptext SLIT("+4]")],
1427        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1428     ]
1429
1430 -- Translate to
1431 --    st  %fn,[addr]
1432 --    st  %f(n+1),[addr+4]
1433 pprInstr (ST DF reg addr) | isJust off_addr
1434  = vcat [
1435       hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1436             pprAddr addr, rbrack],
1437       hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1438             pprAddr addr2, rbrack]
1439     ]
1440   where
1441     off_addr = addrOffset addr 4
1442     addr2 = case off_addr of Just x -> x
1443
1444 -- no distinction is made between signed and unsigned bytes on stores for the
1445 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1446 -- so we call a special-purpose pprSize for ST..
1447
1448 pprInstr (ST size reg addr)
1449   = hcat [
1450        ptext SLIT("\tst"),
1451        pprStSize size,
1452        char '\t',
1453        pprReg reg,
1454        pp_comma_lbracket,
1455        pprAddr addr,
1456        rbrack
1457     ]
1458
1459 pprInstr (ADD x cc reg1 ri reg2)
1460   | not x && not cc && riZero ri
1461   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1462   | otherwise
1463   = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1464
1465 pprInstr (SUB x cc reg1 ri reg2)
1466   | not x && cc && reg2 == g0
1467   = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1468   | not x && not cc && riZero ri
1469   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1470   | otherwise
1471   = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1472
1473 pprInstr (AND  b reg1 ri reg2) = pprRegRIReg SLIT("and")  b reg1 ri reg2
1474 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1475
1476 pprInstr (OR b reg1 ri reg2)
1477   | not b && reg1 == g0
1478   = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1479   | otherwise
1480   = pprRegRIReg SLIT("or") b reg1 ri reg2
1481
1482 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1483
1484 pprInstr (XOR  b reg1 ri reg2) = pprRegRIReg SLIT("xor")  b reg1 ri reg2
1485 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1486
1487 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1488 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1489 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1490
1491 pprInstr (SETHI imm reg)
1492   = hcat [
1493         ptext SLIT("\tsethi\t"),
1494         pprImm imm,
1495         comma,
1496         pprReg reg
1497     ]
1498
1499 pprInstr NOP = ptext SLIT("\tnop")
1500
1501 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1502 pprInstr (FABS DF reg1 reg2)
1503   = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1504     (if (reg1 == reg2) then empty
1505      else (<>) (char '\n')
1506           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1507
1508 pprInstr (FADD size reg1 reg2 reg3)
1509   = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1510 pprInstr (FCMP e size reg1 reg2)
1511   = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1512 pprInstr (FDIV size reg1 reg2 reg3)
1513   = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1514
1515 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1516 pprInstr (FMOV DF reg1 reg2)
1517   = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1518     (if (reg1 == reg2) then empty
1519      else (<>) (char '\n')
1520           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1521
1522 pprInstr (FMUL size reg1 reg2 reg3)
1523   = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1524
1525 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1526 pprInstr (FNEG DF reg1 reg2)
1527   = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1528     (if (reg1 == reg2) then empty
1529      else (<>) (char '\n')
1530           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1531
1532 pprInstr (FSQRT size reg1 reg2)     = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1533 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1534 pprInstr (FxTOy size1 size2 reg1 reg2)
1535   = hcat [
1536         ptext SLIT("\tf"),
1537         ptext
1538         (case size1 of
1539             W  -> SLIT("ito")
1540             F  -> SLIT("sto")
1541             DF -> SLIT("dto")),
1542         ptext
1543         (case size2 of
1544             W  -> SLIT("i\t")
1545             F  -> SLIT("s\t")
1546             DF -> SLIT("d\t")),
1547         pprReg reg1, comma, pprReg reg2
1548     ]
1549
1550
1551 pprInstr (BI cond b lab)
1552   = hcat [
1553         ptext SLIT("\tb"), pprCond cond,
1554         if b then pp_comma_a else empty,
1555         char '\t',
1556         pprImm lab
1557     ]
1558
1559 pprInstr (BF cond b lab)
1560   = hcat [
1561         ptext SLIT("\tfb"), pprCond cond,
1562         if b then pp_comma_a else empty,
1563         char '\t',
1564         pprImm lab
1565     ]
1566
1567 pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1568
1569 pprInstr (CALL imm n _)
1570   = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1571 \end{code}
1572
1573 Continue with SPARC-only printing bits and bobs:
1574 \begin{code}
1575 pprRI :: RI -> Doc
1576 pprRI (RIReg r) = pprReg r
1577 pprRI (RIImm r) = pprImm r
1578
1579 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Doc
1580 pprSizeRegReg name size reg1 reg2
1581   = hcat [
1582         char '\t',
1583         ptext name,
1584         (case size of
1585             F  -> ptext SLIT("s\t")
1586             DF -> ptext SLIT("d\t")),
1587         pprReg reg1,
1588         comma,
1589         pprReg reg2
1590     ]
1591
1592 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
1593 pprSizeRegRegReg name size reg1 reg2 reg3
1594   = hcat [
1595         char '\t',
1596         ptext name,
1597         (case size of
1598             F  -> ptext SLIT("s\t")
1599             DF -> ptext SLIT("d\t")),
1600         pprReg reg1,
1601         comma,
1602         pprReg reg2,
1603         comma,
1604         pprReg reg3
1605     ]
1606
1607 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> Doc
1608 pprRegRIReg name b reg1 ri reg2
1609   = hcat [
1610         char '\t',
1611         ptext name,
1612         if b then ptext SLIT("cc\t") else char '\t',
1613         pprReg reg1,
1614         comma,
1615         pprRI ri,
1616         comma,
1617         pprReg reg2
1618     ]
1619
1620 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Doc
1621 pprRIReg name b ri reg1
1622   = hcat [
1623         char '\t',
1624         ptext name,
1625         if b then ptext SLIT("cc\t") else char '\t',
1626         pprRI ri,
1627         comma,
1628         pprReg reg1
1629     ]
1630
1631 pp_ld_lbracket    = ptext SLIT("\tld\t[")
1632 pp_rbracket_comma = text "],"
1633 pp_comma_lbracket = text ",["
1634 pp_comma_a        = text ",a"
1635
1636 #endif {-sparc_TARGET_ARCH-}
1637 \end{code}