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 pprInstr g@(GCMP sz src1 src2)
1034    = pprG g (hcat [gtab, text "pushl %eax ; ",gpush src1 0]
1035              $$
1036              hcat [gtab, text "fcomp ", greg src2 1,
1037                    text "; fstsw %ax ; sahf ; popl %eax"])
1038
1039 pprInstr g@(GABS sz src dst)
1040    = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1041 pprInstr g@(GNEG sz src dst)
1042    = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1043
1044 pprInstr g@(GSQRT sz src dst)
1045    = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1046              hcat [gtab, gcoerceto sz, gpop dst 1])
1047 pprInstr g@(GSIN sz src dst)
1048    = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1049              hcat [gtab, gcoerceto sz, gpop dst 1])
1050 pprInstr g@(GCOS sz src dst)
1051    = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1052              hcat [gtab, gcoerceto sz, gpop dst 1])
1053 pprInstr g@(GTAN sz src dst)
1054    = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1055                    gpush src 0, text " ; fptan ; ",
1056                    text " fstp %st(0)"] $$
1057              hcat [gtab, gcoerceto sz, gpop dst 1])
1058
1059 -- In the translations for GADD, GMUL, GSUB and GDIV,
1060 -- the first two cases are mere optimisations.  The otherwise clause
1061 -- generates correct code under all circumstances.
1062
1063 pprInstr g@(GADD sz src1 src2 dst)
1064    | src1 == dst
1065    = pprG g (text "\t#GADD-xxxcase1" $$
1066              hcat [gtab, gpush src2 0,
1067                    text " ; faddp %st(0),", greg src1 1])
1068    | src2 == dst
1069    = pprG g (text "\t#GADD-xxxcase2" $$
1070              hcat [gtab, gpush src1 0,
1071                    text " ; faddp %st(0),", greg src2 1])
1072    | otherwise
1073    = pprG g (hcat [gtab, gpush src1 0,
1074                    text " ; fadd ", greg src2 1, text ",%st(0)",
1075                    gsemi, gpop dst 1])
1076
1077
1078 pprInstr g@(GMUL sz src1 src2 dst)
1079    | src1 == dst
1080    = pprG g (text "\t#GMUL-xxxcase1" $$
1081              hcat [gtab, gpush src2 0,
1082                    text " ; fmulp %st(0),", greg src1 1])
1083    | src2 == dst
1084    = pprG g (text "\t#GMUL-xxxcase2" $$
1085              hcat [gtab, gpush src1 0,
1086                    text " ; fmulp %st(0),", greg src2 1])
1087    | otherwise
1088    = pprG g (hcat [gtab, gpush src1 0,
1089                    text " ; fmul ", greg src2 1, text ",%st(0)",
1090                    gsemi, gpop dst 1])
1091
1092
1093 pprInstr g@(GSUB sz src1 src2 dst)
1094    | src1 == dst
1095    = pprG g (text "\t#GSUB-xxxcase1" $$
1096              hcat [gtab, gpush src2 0,
1097                    text " ; fsubrp %st(0),", greg src1 1])
1098    | src2 == dst
1099    = pprG g (text "\t#GSUB-xxxcase2" $$
1100              hcat [gtab, gpush src1 0,
1101                    text " ; fsubp %st(0),", greg src2 1])
1102    | otherwise
1103    = pprG g (hcat [gtab, gpush src1 0,
1104                    text " ; fsub ", greg src2 1, text ",%st(0)",
1105                    gsemi, gpop dst 1])
1106
1107
1108 pprInstr g@(GDIV sz src1 src2 dst)
1109    | src1 == dst
1110    = pprG g (text "\t#GDIV-xxxcase1" $$
1111              hcat [gtab, gpush src2 0,
1112                    text " ; fdivrp %st(0),", greg src1 1])
1113    | src2 == dst
1114    = pprG g (text "\t#GDIV-xxxcase2" $$
1115              hcat [gtab, gpush src1 0,
1116                    text " ; fdivp %st(0),", greg src2 1])
1117    | otherwise
1118    = pprG g (hcat [gtab, gpush src1 0,
1119                    text " ; fdiv ", greg src2 1, text ",%st(0)",
1120                    gsemi, gpop dst 1])
1121
1122
1123 pprInstr GFREE
1124    = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1125             ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1126           ]
1127
1128
1129 pprInstr_quotRem signed isQuot sz src dst
1130    | case sz of L -> False; _ -> True
1131    = panic "pprInstr_quotRem: dunno how to do non-32bit operands"
1132    | otherwise
1133    = vcat [
1134      (text "\t# BEGIN " <> fakeInsn),
1135      (text "\tpushl $0;  pushl %eax;  pushl %edx;  pushl " <> pprOperand sz src),
1136      (text "\tmovl " <> pprOperand sz dst <> text ",%eax;  " <> widen_to_64),
1137      (x86op <> text " 0(%esp);  movl " <> text resReg <> text ",12(%esp)"),
1138      (text "\tpopl %edx;  popl %edx;  popl %eax;  popl " <> pprOperand sz dst),
1139      (text "\t# END   " <> fakeInsn)
1140      ]
1141      where
1142         widen_to_64 | signed     = text "cltd"
1143                     | not signed = text "xorl %edx,%edx"
1144         x86op = if signed then text "\tidivl" else text "\tdivl"
1145         resReg = if isQuot then "%eax" else "%edx"
1146         opStr  | signed     = if isQuot then "IQUOT" else "IREM"
1147                | not signed = if isQuot then "QUOT"  else "REM"
1148         fakeInsn = text opStr <+> pprOperand sz src
1149                               <> char ',' <+> pprOperand sz dst
1150
1151 -- Emit code to make hi_reg:lo_reg be the 64-bit product of hi_reg and lo_reg
1152 pprInstr_imul64 hi_reg lo_reg
1153    = let fakeInsn = text "imul64" <+> pp_hi_reg <> comma <+> pp_lo_reg
1154          pp_hi_reg = pprReg L hi_reg
1155          pp_lo_reg = pprReg L lo_reg
1156      in
1157          vcat [
1158             text "\t# BEGIN " <> fakeInsn,
1159             text "\tpushl" <+> pp_hi_reg <> text" ;  pushl" <+> pp_lo_reg,
1160             text "\tpushl %eax ; pushl %edx",
1161             text "\tmovl 12(%esp), %eax ; imull 8(%esp)",
1162             text "\tmovl %edx, 12(%esp) ; movl %eax, 8(%esp)",
1163             text "\tpopl %edx ; popl %eax",
1164             text "\tpopl" <+> pp_lo_reg <> text " ;  popl" <+> pp_hi_reg,
1165             text "\t# END   " <> fakeInsn
1166          ]
1167
1168
1169 --------------------------
1170
1171 -- coerce %st(0) to the specified size
1172 gcoerceto DF = empty
1173 gcoerceto  F = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1174
1175 gpush reg offset
1176    = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1177 gpop reg offset
1178    = hcat [text "fstp ", greg reg offset]
1179
1180 bogus = text "\tbogus"
1181 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1182 gsemi = text " ; "
1183 gtab  = char '\t'
1184 gsp   = char ' '
1185
1186 gregno (RealReg i) = i
1187 gregno other       = --pprPanic "gregno" (ppr other)
1188                      999   -- bogus; only needed for debug printing
1189
1190 pprG :: Instr -> Doc -> Doc
1191 pprG fake actual
1192    = (char '#' <> pprGInstr fake) $$ actual
1193
1194 pprGInstr (GMOV src dst)   = pprSizeRegReg SLIT("gmov") DF src dst
1195 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1196 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1197
1198 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") DF dst
1199 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") DF dst
1200
1201 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L  src dst
1202 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
1203
1204 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F  src dst
1205 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
1206
1207 pprGInstr (GCMP sz src dst) = pprSizeRegReg SLIT("gcmp") sz src dst
1208 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1209 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1210 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1211 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1212 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1213 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1214
1215 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1216 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1217 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1218 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1219 \end{code}
1220
1221 Continue with I386-only printing bits and bobs:
1222 \begin{code}
1223 pprDollImm :: Imm -> Doc
1224
1225 pprDollImm i =  ptext SLIT("$") <> pprImm i
1226
1227 pprOperand :: Size -> Operand -> Doc
1228 pprOperand s (OpReg r)   = pprReg s r
1229 pprOperand s (OpImm i)   = pprDollImm i
1230 pprOperand s (OpAddr ea) = pprAddr ea
1231
1232 pprSizeImmOp :: FAST_STRING -> Size -> Imm -> Operand -> Doc
1233 pprSizeImmOp name size imm op1
1234   = hcat [
1235         char '\t',
1236         ptext name,
1237         pprSize size,
1238         space,
1239         char '$',
1240         pprImm imm,
1241         comma,
1242         pprOperand size op1
1243     ]
1244
1245 pprSizeOp :: FAST_STRING -> Size -> Operand -> Doc
1246 pprSizeOp name size op1
1247   = hcat [
1248         char '\t',
1249         ptext name,
1250         pprSize size,
1251         space,
1252         pprOperand size op1
1253     ]
1254
1255 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
1256 pprSizeOpOp name size op1 op2
1257   = hcat [
1258         char '\t',
1259         ptext name,
1260         pprSize size,
1261         space,
1262         pprOperand size op1,
1263         comma,
1264         pprOperand size op2
1265     ]
1266
1267 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
1268 pprSizeByteOpOp name size op1 op2
1269   = hcat [
1270         char '\t',
1271         ptext name,
1272         pprSize size,
1273         space,
1274         pprOperand B op1,
1275         comma,
1276         pprOperand size op2
1277     ]
1278
1279 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> Doc
1280 pprSizeOpReg name size op1 reg
1281   = hcat [
1282         char '\t',
1283         ptext name,
1284         pprSize size,
1285         space,
1286         pprOperand size op1,
1287         comma,
1288         pprReg size reg
1289     ]
1290
1291 pprSizeReg :: FAST_STRING -> Size -> Reg -> Doc
1292 pprSizeReg name size reg1
1293   = hcat [
1294         char '\t',
1295         ptext name,
1296         pprSize size,
1297         space,
1298         pprReg size reg1
1299     ]
1300
1301 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Doc
1302 pprSizeRegReg name size reg1 reg2
1303   = hcat [
1304         char '\t',
1305         ptext name,
1306         pprSize size,
1307         space,
1308         pprReg size reg1,
1309         comma,
1310         pprReg size reg2
1311     ]
1312
1313 pprSizeSizeRegReg :: FAST_STRING -> Size -> Size -> Reg -> Reg -> Doc
1314 pprSizeSizeRegReg name size1 size2 reg1 reg2
1315   = hcat [
1316         char '\t',
1317         ptext name,
1318         pprSize size1,
1319         pprSize size2,
1320         space,
1321         pprReg size1 reg1,
1322         comma,
1323         pprReg size2 reg2
1324     ]
1325
1326 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
1327 pprSizeRegRegReg name size reg1 reg2 reg3
1328   = hcat [
1329         char '\t',
1330         ptext name,
1331         pprSize size,
1332         space,
1333         pprReg size reg1,
1334         comma,
1335         pprReg size reg2,
1336         comma,
1337         pprReg size reg3
1338     ]
1339
1340 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> Doc
1341 pprSizeAddr name size op
1342   = hcat [
1343         char '\t',
1344         ptext name,
1345         pprSize size,
1346         space,
1347         pprAddr op
1348     ]
1349
1350 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> Doc
1351 pprSizeAddrReg name size op dst
1352   = hcat [
1353         char '\t',
1354         ptext name,
1355         pprSize size,
1356         space,
1357         pprAddr op,
1358         comma,
1359         pprReg size dst
1360     ]
1361
1362 pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> Doc
1363 pprSizeRegAddr name size src op
1364   = hcat [
1365         char '\t',
1366         ptext name,
1367         pprSize size,
1368         space,
1369         pprReg size src,
1370         comma,
1371         pprAddr op
1372     ]
1373
1374 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
1375 pprOpOp name size op1 op2
1376   = hcat [
1377         char '\t',
1378         ptext name, space,
1379         pprOperand size op1,
1380         comma,
1381         pprOperand size op2
1382     ]
1383
1384 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> Doc
1385 pprSizeOpOpCoerce name size1 size2 op1 op2
1386   = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1387         pprOperand size1 op1,
1388         comma,
1389         pprOperand size2 op2
1390     ]
1391
1392 pprCondInstr :: FAST_STRING -> Cond -> Doc -> Doc
1393 pprCondInstr name cond arg
1394   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1395
1396 #endif {-i386_TARGET_ARCH-}
1397 \end{code}
1398
1399 %************************************************************************
1400 %*                                                                      *
1401 \subsubsection{@pprInstr@ for a SPARC}
1402 %*                                                                      *
1403 %************************************************************************
1404
1405 \begin{code}
1406 #if sparc_TARGET_ARCH
1407
1408 -- a clumsy hack for now, to handle possible double alignment problems
1409
1410 -- even clumsier, to allow for RegReg regs that show when doing indexed
1411 -- reads (bytearrays).
1412 --
1413
1414 -- Translate to the following:
1415 --    add g1,g2,g1
1416 --    ld  [g1],%fn
1417 --    ld  [g1+4],%f(n+1)
1418 --    sub g1,g2,g1           -- to restore g1
1419 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1420   = vcat [
1421        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1422        hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1423        hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1424        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1425     ]
1426
1427 -- Translate to
1428 --    ld  [addr],%fn
1429 --    ld  [addr+4],%f(n+1)
1430 pprInstr (LD DF addr reg) | isJust off_addr
1431   = vcat [
1432        hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1433        hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1434     ]
1435   where
1436     off_addr = addrOffset addr 4
1437     addr2 = case off_addr of Just x -> x
1438
1439
1440 pprInstr (LD size addr reg)
1441   = hcat [
1442        ptext SLIT("\tld"),
1443        pprSize size,
1444        char '\t',
1445        lbrack,
1446        pprAddr addr,
1447        pp_rbracket_comma,
1448        pprReg reg
1449     ]
1450
1451 -- The same clumsy hack as above
1452
1453 -- Translate to the following:
1454 --    add g1,g2,g1
1455 --    st  %fn,[g1]
1456 --    st  %f(n+1),[g1+4]
1457 --    sub g1,g2,g1           -- to restore g1
1458 pprInstr (ST DF reg (AddrRegReg g1 g2))
1459  = vcat [
1460        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1461        hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1462              pprReg g1, rbrack],
1463        hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1464              pprReg g1, ptext SLIT("+4]")],
1465        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1466     ]
1467
1468 -- Translate to
1469 --    st  %fn,[addr]
1470 --    st  %f(n+1),[addr+4]
1471 pprInstr (ST DF reg addr) | isJust off_addr
1472  = vcat [
1473       hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1474             pprAddr addr, rbrack],
1475       hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1476             pprAddr addr2, rbrack]
1477     ]
1478   where
1479     off_addr = addrOffset addr 4
1480     addr2 = case off_addr of Just x -> x
1481
1482 -- no distinction is made between signed and unsigned bytes on stores for the
1483 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1484 -- so we call a special-purpose pprSize for ST..
1485
1486 pprInstr (ST size reg addr)
1487   = hcat [
1488        ptext SLIT("\tst"),
1489        pprStSize size,
1490        char '\t',
1491        pprReg reg,
1492        pp_comma_lbracket,
1493        pprAddr addr,
1494        rbrack
1495     ]
1496
1497 pprInstr (ADD x cc reg1 ri reg2)
1498   | not x && not cc && riZero ri
1499   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1500   | otherwise
1501   = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1502
1503 pprInstr (SUB x cc reg1 ri reg2)
1504   | not x && cc && reg2 == g0
1505   = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1506   | not x && not cc && riZero ri
1507   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1508   | otherwise
1509   = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1510
1511 pprInstr (AND  b reg1 ri reg2) = pprRegRIReg SLIT("and")  b reg1 ri reg2
1512 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1513
1514 pprInstr (OR b reg1 ri reg2)
1515   | not b && reg1 == g0
1516   = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1517     in  case ri of
1518            RIReg rrr | rrr == reg2 -> empty
1519            other                   -> doit
1520   | otherwise
1521   = pprRegRIReg SLIT("or") b reg1 ri reg2
1522
1523 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1524
1525 pprInstr (XOR  b reg1 ri reg2) = pprRegRIReg SLIT("xor")  b reg1 ri reg2
1526 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1527
1528 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1529 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1530 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1531
1532 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1533 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul")  b reg1 ri reg2
1534 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul")  b reg1 ri reg2
1535
1536 pprInstr (SETHI imm reg)
1537   = hcat [
1538         ptext SLIT("\tsethi\t"),
1539         pprImm imm,
1540         comma,
1541         pprReg reg
1542     ]
1543
1544 pprInstr NOP = ptext SLIT("\tnop")
1545
1546 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1547 pprInstr (FABS DF reg1 reg2)
1548   = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1549     (if (reg1 == reg2) then empty
1550      else (<>) (char '\n')
1551           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1552
1553 pprInstr (FADD size reg1 reg2 reg3)
1554   = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1555 pprInstr (FCMP e size reg1 reg2)
1556   = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1557 pprInstr (FDIV size reg1 reg2 reg3)
1558   = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1559
1560 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1561 pprInstr (FMOV DF reg1 reg2)
1562   = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1563     (if (reg1 == reg2) then empty
1564      else (<>) (char '\n')
1565           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1566
1567 pprInstr (FMUL size reg1 reg2 reg3)
1568   = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1569
1570 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1571 pprInstr (FNEG DF reg1 reg2)
1572   = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1573     (if (reg1 == reg2) then empty
1574      else (<>) (char '\n')
1575           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1576
1577 pprInstr (FSQRT size reg1 reg2)     = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1578 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1579 pprInstr (FxTOy size1 size2 reg1 reg2)
1580   = hcat [
1581         ptext SLIT("\tf"),
1582         ptext
1583         (case size1 of
1584             W  -> SLIT("ito")
1585             F  -> SLIT("sto")
1586             DF -> SLIT("dto")),
1587         ptext
1588         (case size2 of
1589             W  -> SLIT("i\t")
1590             F  -> SLIT("s\t")
1591             DF -> SLIT("d\t")),
1592         pprReg reg1, comma, pprReg reg2
1593     ]
1594
1595
1596 pprInstr (BI cond b lab)
1597   = hcat [
1598         ptext SLIT("\tb"), pprCond cond,
1599         if b then pp_comma_a else empty,
1600         char '\t',
1601         pprImm lab
1602     ]
1603
1604 pprInstr (BF cond b lab)
1605   = hcat [
1606         ptext SLIT("\tfb"), pprCond cond,
1607         if b then pp_comma_a else empty,
1608         char '\t',
1609         pprImm lab
1610     ]
1611
1612 pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1613
1614 pprInstr (CALL imm n _)
1615   = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1616 \end{code}
1617
1618 Continue with SPARC-only printing bits and bobs:
1619 \begin{code}
1620 pprRI :: RI -> Doc
1621 pprRI (RIReg r) = pprReg r
1622 pprRI (RIImm r) = pprImm r
1623
1624 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Doc
1625 pprSizeRegReg name size reg1 reg2
1626   = hcat [
1627         char '\t',
1628         ptext name,
1629         (case size of
1630             F  -> ptext SLIT("s\t")
1631             DF -> ptext SLIT("d\t")),
1632         pprReg reg1,
1633         comma,
1634         pprReg reg2
1635     ]
1636
1637 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
1638 pprSizeRegRegReg name size reg1 reg2 reg3
1639   = hcat [
1640         char '\t',
1641         ptext name,
1642         (case size of
1643             F  -> ptext SLIT("s\t")
1644             DF -> ptext SLIT("d\t")),
1645         pprReg reg1,
1646         comma,
1647         pprReg reg2,
1648         comma,
1649         pprReg reg3
1650     ]
1651
1652 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> Doc
1653 pprRegRIReg name b reg1 ri reg2
1654   = hcat [
1655         char '\t',
1656         ptext name,
1657         if b then ptext SLIT("cc\t") else char '\t',
1658         pprReg reg1,
1659         comma,
1660         pprRI ri,
1661         comma,
1662         pprReg reg2
1663     ]
1664
1665 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Doc
1666 pprRIReg name b ri reg1
1667   = hcat [
1668         char '\t',
1669         ptext name,
1670         if b then ptext SLIT("cc\t") else char '\t',
1671         pprRI ri,
1672         comma,
1673         pprReg reg1
1674     ]
1675
1676 pp_ld_lbracket    = ptext SLIT("\tld\t[")
1677 pp_rbracket_comma = text "],"
1678 pp_comma_lbracket = text ",["
1679 pp_comma_a        = text ",a"
1680
1681 #endif {-sparc_TARGET_ARCH-}
1682 \end{code}