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