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