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