ghc/compiler/nativeGen/PprMach.lhs

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