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 ) where
  14
  15 #include "HsVersions.h"
  16
  17 import MachRegs         -- may differ per-platform
  18 import MachMisc
  19
  20 import CLabel           ( pprCLabel_asm, externallyVisibleCLabel )
  21 import CStrings         ( charToC )
  22 import Maybes           ( maybeToBool )
  23 import Stix             ( CodeSegment(..) )
  24 import Char             ( isPrint, isDigit )
  25 import Outputable
  26 \end{code}
  27
  28 %************************************************************************
  29 %*                                                                      *
  30 \subsection{@pprReg@: print a @Reg@}
  31 %*                                                                      *
  32 %************************************************************************
  33
  34 For x86, the way we print a register name depends
  35 on which bit of it we care about.  Yurgh.
  36 \begin{code}
  37 pprReg :: IF_ARCH_i386(Size ->,) Reg -> SDoc
  38
  39 pprReg IF_ARCH_i386(s,) r
  40   = case r of
  41       FixedReg  i -> ppr_reg_no IF_ARCH_i386(s,) i
  42       MappedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
  43       other       -> text (show other)   -- should only happen when debugging
  44   where
  45 #if alpha_TARGET_ARCH
  46     ppr_reg_no :: FAST_REG_NO -> SDoc
  47     ppr_reg_no i = ptext
  48       (case i of {
  49         ILIT( 0) -> SLIT("$0");   ILIT( 1) -> SLIT("$1");
  50         ILIT( 2) -> SLIT("$2");   ILIT( 3) -> SLIT("$3");
  51         ILIT( 4) -> SLIT("$4");   ILIT( 5) -> SLIT("$5");
  52         ILIT( 6) -> SLIT("$6");   ILIT( 7) -> SLIT("$7");
  53         ILIT( 8) -> SLIT("$8");   ILIT( 9) -> SLIT("$9");
  54         ILIT(10) -> SLIT("$10");  ILIT(11) -> SLIT("$11");
  55         ILIT(12) -> SLIT("$12");  ILIT(13) -> SLIT("$13");
  56         ILIT(14) -> SLIT("$14");  ILIT(15) -> SLIT("$15");
  57         ILIT(16) -> SLIT("$16");  ILIT(17) -> SLIT("$17");
  58         ILIT(18) -> SLIT("$18");  ILIT(19) -> SLIT("$19");
  59         ILIT(20) -> SLIT("$20");  ILIT(21) -> SLIT("$21");
  60         ILIT(22) -> SLIT("$22");  ILIT(23) -> SLIT("$23");
  61         ILIT(24) -> SLIT("$24");  ILIT(25) -> SLIT("$25");
  62         ILIT(26) -> SLIT("$26");  ILIT(27) -> SLIT("$27");
  63         ILIT(28) -> SLIT("$28");  ILIT(29) -> SLIT("$29");
  64         ILIT(30) -> SLIT("$30");  ILIT(31) -> SLIT("$31");
  65         ILIT(32) -> SLIT("$f0");  ILIT(33) -> SLIT("$f1");
  66         ILIT(34) -> SLIT("$f2");  ILIT(35) -> SLIT("$f3");
  67         ILIT(36) -> SLIT("$f4");  ILIT(37) -> SLIT("$f5");
  68         ILIT(38) -> SLIT("$f6");  ILIT(39) -> SLIT("$f7");
  69         ILIT(40) -> SLIT("$f8");  ILIT(41) -> SLIT("$f9");
  70         ILIT(42) -> SLIT("$f10"); ILIT(43) -> SLIT("$f11");
  71         ILIT(44) -> SLIT("$f12"); ILIT(45) -> SLIT("$f13");
  72         ILIT(46) -> SLIT("$f14"); ILIT(47) -> SLIT("$f15");
  73         ILIT(48) -> SLIT("$f16"); ILIT(49) -> SLIT("$f17");
  74         ILIT(50) -> SLIT("$f18"); ILIT(51) -> SLIT("$f19");
  75         ILIT(52) -> SLIT("$f20"); ILIT(53) -> SLIT("$f21");
  76         ILIT(54) -> SLIT("$f22"); ILIT(55) -> SLIT("$f23");
  77         ILIT(56) -> SLIT("$f24"); ILIT(57) -> SLIT("$f25");
  78         ILIT(58) -> SLIT("$f26"); ILIT(59) -> SLIT("$f27");
  79         ILIT(60) -> SLIT("$f28"); ILIT(61) -> SLIT("$f29");
  80         ILIT(62) -> SLIT("$f30"); ILIT(63) -> SLIT("$f31");
  81         _ -> SLIT("very naughty alpha register")
  82       })
  83 #endif
  84 #if i386_TARGET_ARCH
  85     ppr_reg_no :: Size -> FAST_REG_NO -> SDoc
  86     ppr_reg_no B i = ptext
  87       (case i of {
  88         ILIT( 0) -> SLIT("%al");  ILIT( 1) -> SLIT("%bl");
  89         ILIT( 2) -> SLIT("%cl");  ILIT( 3) -> SLIT("%dl");
  90         _ -> SLIT("very naughty I386 byte register")
  91       })
  92
  93     {- UNUSED:
  94     ppr_reg_no HB i = ptext
  95       (case i of {
  96         ILIT( 0) -> SLIT("%ah");  ILIT( 1) -> SLIT("%bh");
  97         ILIT( 2) -> SLIT("%ch");  ILIT( 3) -> SLIT("%dh");
  98         _ -> SLIT("very naughty I386 high byte register")
  99       })
 100     -}
 101
 102 {- UNUSED:
 103     ppr_reg_no S i = ptext
 104       (case i of {
 105         ILIT( 0) -> SLIT("%ax");  ILIT( 1) -> SLIT("%bx");
 106         ILIT( 2) -> SLIT("%cx");  ILIT( 3) -> SLIT("%dx");
 107         ILIT( 4) -> SLIT("%si");  ILIT( 5) -> SLIT("%di");
 108         ILIT( 6) -> SLIT("%bp");  ILIT( 7) -> SLIT("%sp");
 109         _ -> SLIT("very naughty I386 word register")
 110       })
 111 -}
 112
 113     ppr_reg_no L i = ptext
 114       (case i of {
 115         ILIT( 0) -> SLIT("%eax");  ILIT( 1) -> SLIT("%ebx");
 116         ILIT( 2) -> SLIT("%ecx");  ILIT( 3) -> SLIT("%edx");
 117         ILIT( 4) -> SLIT("%esi");  ILIT( 5) -> SLIT("%edi");
 118         ILIT( 6) -> SLIT("%ebp");  ILIT( 7) -> SLIT("%esp");
 119         _ -> SLIT("very naughty I386 double word register")
 120       })
 121
 122     ppr_reg_no F i = ptext
 123       (case i of {
 124         --ToDo: rm these (???)
 125         ILIT( 8) -> SLIT("%st(0)");  ILIT( 9) -> SLIT("%st(1)");
 126         ILIT(10) -> SLIT("%st(2)");  ILIT(11) -> SLIT("%st(3)");
 127         ILIT(12) -> SLIT("%st(4)");  ILIT(13) -> SLIT("%st(5)");
 128         ILIT(14) -> SLIT("%st(6)");  ILIT(15) -> SLIT("%st(7)");
 129         _ -> SLIT("very naughty I386 float register")
 130       })
 131
 132     ppr_reg_no DF i = ptext
 133       (case i of {
 134         --ToDo: rm these (???)
 135         ILIT( 8) -> SLIT("%st(0)");  ILIT( 9) -> SLIT("%st(1)");
 136         ILIT(10) -> SLIT("%st(2)");  ILIT(11) -> SLIT("%st(3)");
 137         ILIT(12) -> SLIT("%st(4)");  ILIT(13) -> SLIT("%st(5)");
 138         ILIT(14) -> SLIT("%st(6)");  ILIT(15) -> SLIT("%st(7)");
 139         _ -> SLIT("very naughty I386 float register")
 140       })
 141 #endif
 142 #if sparc_TARGET_ARCH
 143     ppr_reg_no :: FAST_REG_NO -> SDoc
 144     ppr_reg_no i = ptext
 145       (case i of {
 146         ILIT( 0) -> SLIT("%g0");  ILIT( 1) -> SLIT("%g1");
 147         ILIT( 2) -> SLIT("%g2");  ILIT( 3) -> SLIT("%g3");
 148         ILIT( 4) -> SLIT("%g4");  ILIT( 5) -> SLIT("%g5");
 149         ILIT( 6) -> SLIT("%g6");  ILIT( 7) -> SLIT("%g7");
 150         ILIT( 8) -> SLIT("%o0");  ILIT( 9) -> SLIT("%o1");
 151         ILIT(10) -> SLIT("%o2");  ILIT(11) -> SLIT("%o3");
 152         ILIT(12) -> SLIT("%o4");  ILIT(13) -> SLIT("%o5");
 153         ILIT(14) -> SLIT("%o6");  ILIT(15) -> SLIT("%o7");
 154         ILIT(16) -> SLIT("%l0");  ILIT(17) -> SLIT("%l1");
 155         ILIT(18) -> SLIT("%l2");  ILIT(19) -> SLIT("%l3");
 156         ILIT(20) -> SLIT("%l4");  ILIT(21) -> SLIT("%l5");
 157         ILIT(22) -> SLIT("%l6");  ILIT(23) -> SLIT("%l7");
 158         ILIT(24) -> SLIT("%i0");  ILIT(25) -> SLIT("%i1");
 159         ILIT(26) -> SLIT("%i2");  ILIT(27) -> SLIT("%i3");
 160         ILIT(28) -> SLIT("%i4");  ILIT(29) -> SLIT("%i5");
 161         ILIT(30) -> SLIT("%i6");  ILIT(31) -> SLIT("%i7");
 162         ILIT(32) -> SLIT("%f0");  ILIT(33) -> SLIT("%f1");
 163         ILIT(34) -> SLIT("%f2");  ILIT(35) -> SLIT("%f3");
 164         ILIT(36) -> SLIT("%f4");  ILIT(37) -> SLIT("%f5");
 165         ILIT(38) -> SLIT("%f6");  ILIT(39) -> SLIT("%f7");
 166         ILIT(40) -> SLIT("%f8");  ILIT(41) -> SLIT("%f9");
 167         ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11");
 168         ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13");
 169         ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15");
 170         ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17");
 171         ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19");
 172         ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21");
 173         ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23");
 174         ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25");
 175         ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27");
 176         ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29");
 177         ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31");
 178         _ -> SLIT("very naughty sparc register")
 179       })
 180 #endif
 181 \end{code}
 182
 183 %************************************************************************
 184 %*                                                                      *
 185 \subsection{@pprSize@: print a @Size@}
 186 %*                                                                      *
 187 %************************************************************************
 188
 189 \begin{code}
 190 pprSize :: Size -> SDoc
 191
 192 pprSize x = ptext (case x of
 193 #if alpha_TARGET_ARCH
 194          B  -> SLIT("b")
 195          BU -> SLIT("bu")
 196 --       W  -> SLIT("w") UNUSED
 197 --       WU -> SLIT("wu") UNUSED
 198 --       L  -> SLIT("l") UNUSED
 199          Q  -> SLIT("q")
 200 --       FF -> SLIT("f") UNUSED
 201 --       DF -> SLIT("d") UNUSED
 202 --       GF -> SLIT("g") UNUSED
 203 --       SF -> SLIT("s") UNUSED
 204          TF -> SLIT("t")
 205 #endif
 206 #if i386_TARGET_ARCH
 207         B  -> SLIT("b")
 208 --      HB -> SLIT("b") UNUSED
 209 --      S  -> SLIT("w") UNUSED
 210         L  -> SLIT("l")
 211         F  -> SLIT("s")
 212         DF -> SLIT("l")
 213 #endif
 214 #if sparc_TARGET_ARCH
 215         B   -> SLIT("sb")
 216         BU  -> SLIT("ub")
 217 --      HW  -> SLIT("hw") UNUSED
 218 --      HWU -> SLIT("uhw") UNUSED
 219         W   -> SLIT("")
 220         F   -> SLIT("")
 221 --      D   -> SLIT("d") UNUSED
 222         DF  -> SLIT("d")
 223     )
 224 pprStSize :: Size -> SDoc
 225 pprStSize x = ptext (case x of
 226         B   -> SLIT("b")
 227         BU  -> SLIT("b")
 228 --      HW  -> SLIT("hw") UNUSED
 229 --      HWU -> SLIT("uhw") UNUSED
 230         W   -> SLIT("")
 231         F   -> SLIT("")
 232 --      D   -> SLIT("d") UNUSED
 233         DF  -> SLIT("d")
 234 #endif
 235     )
 236 \end{code}
 237
 238 %************************************************************************
 239 %*                                                                      *
 240 \subsection{@pprCond@: print a @Cond@}
 241 %*                                                                      *
 242 %************************************************************************
 243
 244 \begin{code}
 245 pprCond :: Cond -> SDoc
 246
 247 pprCond c = ptext (case c of {
 248 #if alpha_TARGET_ARCH
 249         EQQ  -> SLIT("eq");
 250         LTT  -> SLIT("lt");
 251         LE  -> SLIT("le");
 252         ULT -> SLIT("ult");
 253         ULE -> SLIT("ule");
 254         NE  -> SLIT("ne");
 255         GTT  -> SLIT("gt");
 256         GE  -> SLIT("ge")
 257 #endif
 258 #if i386_TARGET_ARCH
 259         GEU     -> SLIT("ae");  LU    -> SLIT("b");
 260         EQQ     -> SLIT("e");   GTT    -> SLIT("g");
 261         GE      -> SLIT("ge");  GU    -> SLIT("a");
 262         LTT     -> SLIT("l");   LE    -> SLIT("le");
 263         LEU     -> SLIT("be");  NE    -> SLIT("ne");
 264         NEG     -> SLIT("s");   POS   -> SLIT("ns");
 265         ALWAYS  -> SLIT("mp")   -- hack
 266 #endif
 267 #if sparc_TARGET_ARCH
 268         ALWAYS  -> SLIT("");    NEVER -> SLIT("n");
 269         GEU     -> SLIT("geu"); LU    -> SLIT("lu");
 270         EQQ     -> SLIT("e");   GTT   -> SLIT("g");
 271         GE      -> SLIT("ge");  GU    -> SLIT("gu");
 272         LTT     -> SLIT("l");   LE    -> SLIT("le");
 273         LEU     -> SLIT("leu"); NE    -> SLIT("ne");
 274         NEG     -> SLIT("neg"); POS   -> SLIT("pos");
 275         VC      -> SLIT("vc");  VS    -> SLIT("vs")
 276 #endif
 277     })
 278 \end{code}
 279
 280 %************************************************************************
 281 %*                                                                      *
 282 \subsection{@pprImm@: print an @Imm@}
 283 %*                                                                      *
 284 %************************************************************************
 285
 286 \begin{code}
 287 pprImm :: Imm -> SDoc
 288
 289 pprImm (ImmInt i)     = int i
 290 pprImm (ImmInteger i) = integer i
 291 pprImm (ImmCLbl l)    = pprCLabel_asm l
 292 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
 293 pprImm (ImmLit s)     = s
 294
 295 pprImm (ImmLab s) | underscorePrefix = (<>) (char '_') s
 296                   | otherwise        = s
 297
 298 #if sparc_TARGET_ARCH
 299 pprImm (LO i)
 300   = hcat [ pp_lo, pprImm i, rparen ]
 301   where
 302     pp_lo = text "%lo("
 303
 304 pprImm (HI i)
 305   = hcat [ pp_hi, pprImm i, rparen ]
 306   where
 307     pp_hi = text "%hi("
 308 #endif
 309 \end{code}
 310
 311 %************************************************************************
 312 %*                                                                      *
 313 \subsection{@pprAddr@: print an @Addr@}
 314 %*                                                                      *
 315 %************************************************************************
 316
 317 \begin{code}
 318 pprAddr :: MachRegsAddr -> SDoc
 319
 320 #if alpha_TARGET_ARCH
 321 pprAddr (AddrReg r) = parens (pprReg r)
 322 pprAddr (AddrImm i) = pprImm i
 323 pprAddr (AddrRegImm r1 i)
 324   = (<>) (pprImm i) (parens (pprReg r1))
 325 #endif
 326
 327 -------------------
 328
 329 #if i386_TARGET_ARCH
 330 pprAddr (ImmAddr imm off)
 331   = let
 332         pp_imm = pprImm imm
 333     in
 334     if (off == 0) then
 335         pp_imm
 336     else if (off < 0) then
 337         (<>) pp_imm (int off)
 338     else
 339         hcat [pp_imm, char '+', int off]
 340
 341 pprAddr (AddrBaseIndex base index displacement)
 342   = let
 343         pp_disp  = ppr_disp displacement
 344         pp_off p = (<>) pp_disp (parens p)
 345         pp_reg r = pprReg L r
 346     in
 347     case (base,index) of
 348       (Nothing, Nothing)    -> pp_disp
 349       (Just b,  Nothing)    -> pp_off (pp_reg b)
 350       (Nothing, Just (r,i)) -> pp_off (hcat [pp_reg r, comma, int i])
 351       (Just b,  Just (r,i)) -> pp_off (hcat [pp_reg b, comma, pp_reg r, comma, int i])
 352   where
 353     ppr_disp (ImmInt 0) = empty
 354     ppr_disp imm        = pprImm imm
 355 #endif
 356
 357 -------------------
 358
 359 #if sparc_TARGET_ARCH
 360 pprAddr (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1
 361
 362 pprAddr (AddrRegReg r1 r2)
 363   = hcat [ pprReg r1, char '+', pprReg r2 ]
 364
 365 pprAddr (AddrRegImm r1 (ImmInt i))
 366   | i == 0 = pprReg r1
 367   | not (fits13Bits i) = largeOffsetError i
 368   | otherwise = hcat [ pprReg r1, pp_sign, int i ]
 369   where
 370     pp_sign = if i > 0 then char '+' else empty
 371
 372 pprAddr (AddrRegImm r1 (ImmInteger i))
 373   | i == 0 = pprReg r1
 374   | not (fits13Bits i) = largeOffsetError i
 375   | otherwise  = hcat [ pprReg r1, pp_sign, integer i ]
 376   where
 377     pp_sign = if i > 0 then char '+' else empty
 378
 379 pprAddr (AddrRegImm r1 imm)
 380   = hcat [ pprReg r1, char '+', pprImm imm ]
 381 #endif
 382 \end{code}
 383
 384 %************************************************************************
 385 %*                                                                      *
 386 \subsection{@pprInstr@: print an @Instr@}
 387 %*                                                                      *
 388 %************************************************************************
 389
 390 \begin{code}
 391 pprInstr :: Instr -> SDoc
 392
 393 --pprInstr (COMMENT s) = (<>) (ptext SLIT("# "))   (ptext s)
 394 pprInstr (COMMENT s) = empty -- nuke 'em
 395 --alpha:  = (<>) (ptext SLIT("\t# ")) (ptext s)
 396 --i386 :  = (<>) (ptext SLIT("# "))   (ptext s)
 397 --sparc:  = (<>) (ptext SLIT("! "))   (ptext s)
 398
 399 pprInstr (SEGMENT TextSegment)
 400     = ptext
 401          IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
 402         ,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
 403         ,IF_ARCH_i386((_PK_ ".text\n\t.align 4") {-needs per-OS variation!-}
 404         ,)))
 405
 406 #if 0
 407         ,IF_ARCH_i386((_PK_ ".text\n\t.align 2\x2c\&0x90") {-needs per-OS variation!-}
 408 #endif
 409
 410 pprInstr (SEGMENT DataSegment)
 411     = ptext
 412          IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
 413         ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -}
 414         ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
 415         ,)))
 416
 417 #if 0
 418         ,IF_ARCH_i386(SLIT(".data\n\t.align 2")
 419 #endif
 420
 421 pprInstr (LABEL clab)
 422   = let
 423         pp_lab = pprCLabel_asm clab
 424     in
 425     hcat [
 426         if not (externallyVisibleCLabel clab) then
 427             empty
 428         else
 429             hcat [ptext
 430                          IF_ARCH_alpha(SLIT("\t.globl\t")
 431                         ,IF_ARCH_i386(SLIT(".globl ")
 432                         ,IF_ARCH_sparc(SLIT("\t.global\t")
 433                         ,)))
 434                         , pp_lab, char '\n'],
 435         pp_lab,
 436         char ':'
 437     ]
 438
 439 pprInstr (ASCII False{-no backslash conversion-} str)
 440   = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
 441
 442 pprInstr (ASCII True str)
 443   = (<>) (text "\t.ascii \"") (asciify str 60)
 444   where
 445     asciify :: String -> Int -> SDoc
 446
 447     asciify [] _ = text "\\0\""
 448     asciify s     n | n <= 0 = (<>) (text "\"\n\t.ascii \"") (asciify s 60)
 449     asciify ('\\':cs)      n = (<>) (text "\\\\") (asciify cs (n-1))
 450     asciify ('\"':cs)      n = (<>) (text "\\\"") (asciify cs (n-1))
 451     asciify (c:cs) n | isPrint c = (<>) (char c) (asciify cs (n-1))
 452     asciify [c]            _ = (<>) (text (charToC c)) (text ("\\0\"")){-"-}
 453     asciify (c:(cs@(d:_))) n
 454       | isDigit d = (<>) (text (charToC c)) (asciify cs 0)
 455       | otherwise = (<>) (text (charToC c)) (asciify cs (n-1))
 456
 457 pprInstr (DATA s xs)
 458   = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs]
 459   where
 460     pp_size = case s of
 461 #if alpha_TARGET_ARCH
 462             B  -> SLIT("\t.byte\t")
 463             BU -> SLIT("\t.byte\t")
 464 --UNUSED:   W  -> SLIT("\t.word\t")
 465 --UNUSED:   WU -> SLIT("\t.word\t")
 466 --UNUSED:   L  -> SLIT("\t.long\t")
 467             Q  -> SLIT("\t.quad\t")
 468 --UNUSED:   FF -> SLIT("\t.f_floating\t")
 469 --UNUSED:   DF -> SLIT("\t.d_floating\t")
 470 --UNUSED:   GF -> SLIT("\t.g_floating\t")
 471 --UNUSED:   SF -> SLIT("\t.s_floating\t")
 472             TF -> SLIT("\t.t_floating\t")
 473 #endif
 474 #if i386_TARGET_ARCH
 475             B  -> SLIT("\t.byte\t")
 476 --UNUSED:   HB -> SLIT("\t.byte\t")
 477 --UNUSED:   S  -> SLIT("\t.word\t")
 478             L  -> SLIT("\t.long\t")
 479             F  -> SLIT("\t.float\t")
 480             DF -> SLIT("\t.double\t")
 481 #endif
 482 #if sparc_TARGET_ARCH
 483             B  -> SLIT("\t.byte\t")
 484             BU -> SLIT("\t.byte\t")
 485             W  -> SLIT("\t.word\t")
 486             DF -> SLIT("\t.double\t")
 487 #endif
 488
 489 -- fall through to rest of (machine-specific) pprInstr...
 490 \end{code}
 491
 492 %************************************************************************
 493 %*                                                                      *
 494 \subsubsection{@pprInstr@ for an Alpha}
 495 %*                                                                      *
 496 %************************************************************************
 497
 498 \begin{code}
 499 #if alpha_TARGET_ARCH
 500
 501 pprInstr (LD size reg addr)
 502   = hcat [
 503         ptext SLIT("\tld"),
 504         pprSize size,
 505         char '\t',
 506         pprReg reg,
 507         comma,
 508         pprAddr addr
 509     ]
 510
 511 pprInstr (LDA reg addr)
 512   = hcat [
 513         ptext SLIT("\tlda\t"),
 514         pprReg reg,
 515         comma,
 516         pprAddr addr
 517     ]
 518
 519 pprInstr (LDAH reg addr)
 520   = hcat [
 521         ptext SLIT("\tldah\t"),
 522         pprReg reg,
 523         comma,
 524         pprAddr addr
 525     ]
 526
 527 pprInstr (LDGP reg addr)
 528   = hcat [
 529         ptext SLIT("\tldgp\t"),
 530         pprReg reg,
 531         comma,
 532         pprAddr addr
 533     ]
 534
 535 pprInstr (LDI size reg imm)
 536   = hcat [
 537         ptext SLIT("\tldi"),
 538         pprSize size,
 539         char '\t',
 540         pprReg reg,
 541         comma,
 542         pprImm imm
 543     ]
 544
 545 pprInstr (ST size reg addr)
 546   = hcat [
 547         ptext SLIT("\tst"),
 548         pprSize size,
 549         char '\t',
 550         pprReg reg,
 551         comma,
 552         pprAddr addr
 553     ]
 554
 555 pprInstr (CLR reg)
 556   = hcat [
 557         ptext SLIT("\tclr\t"),
 558         pprReg reg
 559     ]
 560
 561 pprInstr (ABS size ri reg)
 562   = hcat [
 563         ptext SLIT("\tabs"),
 564         pprSize size,
 565         char '\t',
 566         pprRI ri,
 567         comma,
 568         pprReg reg
 569     ]
 570
 571 pprInstr (NEG size ov ri reg)
 572   = hcat [
 573         ptext SLIT("\tneg"),
 574         pprSize size,
 575         if ov then ptext SLIT("v\t") else char '\t',
 576         pprRI ri,
 577         comma,
 578         pprReg reg
 579     ]
 580
 581 pprInstr (ADD size ov reg1 ri reg2)
 582   = hcat [
 583         ptext SLIT("\tadd"),
 584         pprSize size,
 585         if ov then ptext SLIT("v\t") else char '\t',
 586         pprReg reg1,
 587         comma,
 588         pprRI ri,
 589         comma,
 590         pprReg reg2
 591     ]
 592
 593 pprInstr (SADD size scale reg1 ri reg2)
 594   = hcat [
 595         ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
 596         ptext SLIT("add"),
 597         pprSize size,
 598         char '\t',
 599         pprReg reg1,
 600         comma,
 601         pprRI ri,
 602         comma,
 603         pprReg reg2
 604     ]
 605
 606 pprInstr (SUB size ov reg1 ri reg2)
 607   = hcat [
 608         ptext SLIT("\tsub"),
 609         pprSize size,
 610         if ov then ptext SLIT("v\t") else char '\t',
 611         pprReg reg1,
 612         comma,
 613         pprRI ri,
 614         comma,
 615         pprReg reg2
 616     ]
 617
 618 pprInstr (SSUB size scale reg1 ri reg2)
 619   = hcat [
 620         ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
 621         ptext SLIT("sub"),
 622         pprSize size,
 623         char '\t',
 624         pprReg reg1,
 625         comma,
 626         pprRI ri,
 627         comma,
 628         pprReg reg2
 629     ]
 630
 631 pprInstr (MUL size ov reg1 ri reg2)
 632   = hcat [
 633         ptext SLIT("\tmul"),
 634         pprSize size,
 635         if ov then ptext SLIT("v\t") else char '\t',
 636         pprReg reg1,
 637         comma,
 638         pprRI ri,
 639         comma,
 640         pprReg reg2
 641     ]
 642
 643 pprInstr (DIV size uns reg1 ri reg2)
 644   = hcat [
 645         ptext SLIT("\tdiv"),
 646         pprSize size,
 647         if uns then ptext SLIT("u\t") else char '\t',
 648         pprReg reg1,
 649         comma,
 650         pprRI ri,
 651         comma,
 652         pprReg reg2
 653     ]
 654
 655 pprInstr (REM size uns reg1 ri reg2)
 656   = hcat [
 657         ptext SLIT("\trem"),
 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 (NOT ri reg)
 668   = hcat [
 669         ptext SLIT("\tnot"),
 670         char '\t',
 671         pprRI ri,
 672         comma,
 673         pprReg reg
 674     ]
 675
 676 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
 677 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
 678 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
 679 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
 680 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
 681 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
 682
 683 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
 684 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
 685 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
 686
 687 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
 688 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
 689
 690 pprInstr (NOP) = ptext SLIT("\tnop")
 691
 692 pprInstr (CMP cond reg1 ri reg2)
 693   = hcat [
 694         ptext SLIT("\tcmp"),
 695         pprCond cond,
 696         char '\t',
 697         pprReg reg1,
 698         comma,
 699         pprRI ri,
 700         comma,
 701         pprReg reg2
 702     ]
 703
 704 pprInstr (FCLR reg)
 705   = hcat [
 706         ptext SLIT("\tfclr\t"),
 707         pprReg reg
 708     ]
 709
 710 pprInstr (FABS reg1 reg2)
 711   = hcat [
 712         ptext SLIT("\tfabs\t"),
 713         pprReg reg1,
 714         comma,
 715         pprReg reg2
 716     ]
 717
 718 pprInstr (FNEG size reg1 reg2)
 719   = hcat [
 720         ptext SLIT("\tneg"),
 721         pprSize size,
 722         char '\t',
 723         pprReg reg1,
 724         comma,
 725         pprReg reg2
 726     ]
 727
 728 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
 729 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
 730 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
 731 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
 732
 733 pprInstr (CVTxy size1 size2 reg1 reg2)
 734   = hcat [
 735         ptext SLIT("\tcvt"),
 736         pprSize size1,
 737         case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
 738         char '\t',
 739         pprReg reg1,
 740         comma,
 741         pprReg reg2
 742     ]
 743
 744 pprInstr (FCMP size cond reg1 reg2 reg3)
 745   = hcat [
 746         ptext SLIT("\tcmp"),
 747         pprSize size,
 748         pprCond cond,
 749         char '\t',
 750         pprReg reg1,
 751         comma,
 752         pprReg reg2,
 753         comma,
 754         pprReg reg3
 755     ]
 756
 757 pprInstr (FMOV reg1 reg2)
 758   = hcat [
 759         ptext SLIT("\tfmov\t"),
 760         pprReg reg1,
 761         comma,
 762         pprReg reg2
 763     ]
 764
 765 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
 766
 767 pprInstr (BI NEVER reg lab) = empty
 768
 769 pprInstr (BI cond reg lab)
 770   = hcat [
 771         ptext SLIT("\tb"),
 772         pprCond cond,
 773         char '\t',
 774         pprReg reg,
 775         comma,
 776         pprImm lab
 777     ]
 778
 779 pprInstr (BF cond reg lab)
 780   = hcat [
 781         ptext SLIT("\tfb"),
 782         pprCond cond,
 783         char '\t',
 784         pprReg reg,
 785         comma,
 786         pprImm lab
 787     ]
 788
 789 pprInstr (BR lab)
 790   = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
 791
 792 pprInstr (JMP reg addr hint)
 793   = hcat [
 794         ptext SLIT("\tjmp\t"),
 795         pprReg reg,
 796         comma,
 797         pprAddr addr,
 798         comma,
 799         int hint
 800     ]
 801
 802 pprInstr (BSR imm n)
 803   = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
 804
 805 pprInstr (JSR reg addr n)
 806   = hcat [
 807         ptext SLIT("\tjsr\t"),
 808         pprReg reg,
 809         comma,
 810         pprAddr addr
 811     ]
 812
 813 pprInstr (FUNBEGIN clab)
 814   = hcat [
 815         if (externallyVisibleCLabel clab) then
 816             hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
 817         else
 818             empty,
 819         ptext SLIT("\t.ent "),
 820         pp_lab,
 821         char '\n',
 822         pp_lab,
 823         pp_ldgp,
 824         pp_lab,
 825         pp_frame
 826     ]
 827     where
 828         pp_lab = pprCLabel_asm clab
 829
 830         -- NEVER use commas within those string literals, cpp will ruin your day
 831         pp_ldgp  = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
 832         pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
 833                           ptext SLIT("4240"), char ',',
 834                           ptext SLIT("$26"), char ',',
 835                           ptext SLIT("0\n\t.prologue 1") ]
 836
 837 pprInstr (FUNEND clab)
 838   = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
 839 \end{code}
 840
 841 Continue with Alpha-only printing bits and bobs:
 842 \begin{code}
 843 pprRI :: RI -> SDoc
 844
 845 pprRI (RIReg r) = pprReg r
 846 pprRI (RIImm r) = pprImm r
 847
 848 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc
 849
 850 pprRegRIReg name reg1 ri reg2
 851   = hcat [
 852         char '\t',
 853         ptext name,
 854         char '\t',
 855         pprReg reg1,
 856         comma,
 857         pprRI ri,
 858         comma,
 859         pprReg reg2
 860     ]
 861
 862 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
 863
 864 pprSizeRegRegReg name size reg1 reg2 reg3
 865   = hcat [
 866         char '\t',
 867         ptext name,
 868         pprSize size,
 869         char '\t',
 870         pprReg reg1,
 871         comma,
 872         pprReg reg2,
 873         comma,
 874         pprReg reg3
 875     ]
 876
 877 #endif {-alpha_TARGET_ARCH-}
 878 \end{code}
 879
 880 %************************************************************************
 881 %*                                                                      *
 882 \subsubsection{@pprInstr@ for an I386}
 883 %*                                                                      *
 884 %************************************************************************
 885
 886 \begin{code}
 887 #if i386_TARGET_ARCH
 888
 889 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
 890   | src == dst
 891   =
 892 #ifdef DEBUG
 893     (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
 894 #else
 895     (ptext SLIT(""))
 896 #endif
 897 pprInstr (MOV size src dst)
 898   = pprSizeOpOp SLIT("mov") size src dst
 899 pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
 900 pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
 901
 902 -- here we do some patching, since the physical registers are only set late
 903 -- in the code generation.
 904 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
 905   | reg1 == reg3
 906   = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
 907 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
 908   | reg2 == reg3
 909   = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
 910 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
 911   | reg1 == reg3
 912   = pprInstr (ADD size (OpImm displ) dst)
 913 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
 914
 915 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
 916   = pprSizeOp SLIT("dec") size dst
 917 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
 918   = pprSizeOp SLIT("inc") size dst
 919 pprInstr (ADD size src dst)
 920   = pprSizeOpOp SLIT("add") size src dst
 921 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
 922 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
 923 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
 924
 925 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
 926 pprInstr (OR  size src dst) = pprSizeOpOp SLIT("or")  size src dst
 927 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor")  size src dst
 928 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
 929 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
 930
 931 pprInstr (SHL size imm dst) = pprSizeByteOpOp SLIT("shl")  size imm dst
 932 pprInstr (SAR size imm dst) = pprSizeByteOpOp SLIT("sar")  size imm dst
 933 pprInstr (SHR size imm dst) = pprSizeByteOpOp SLIT("shr")  size imm dst
 934
 935 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp")  size src dst
 936 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test")  size src dst
 937 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
 938 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
 939
 940 pprInstr (NOP) = ptext SLIT("\tnop")
 941 pprInstr (CLTD) = ptext SLIT("\tcltd")
 942
 943 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
 944
 945 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
 946
 947 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
 948 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
 949
 950 pprInstr (CALL imm)
 951   = hcat [ ptext SLIT("\tcall "), pprImm imm ]
 952
 953 pprInstr SAHF = ptext SLIT("\tsahf")
 954 pprInstr FABS = ptext SLIT("\tfabs")
 955
 956 pprInstr (FADD sz src@(OpAddr _))
 957   = hcat [ptext SLIT("\tfadd"), pprSize sz, space, pprOperand sz src]
 958 pprInstr (FADD sz src)
 959   = ptext SLIT("\tfadd")
 960 pprInstr FADDP
 961   = ptext SLIT("\tfaddp")
 962 pprInstr (FMUL sz src)
 963   = hcat [ptext SLIT("\tfmul"), pprSize sz, space, pprOperand sz src]
 964 pprInstr FMULP
 965   = ptext SLIT("\tfmulp")
 966 pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op
 967 pprInstr FCHS = ptext SLIT("\tfchs")
 968 pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op
 969 pprInstr FCOS = ptext SLIT("\tfcos")
 970 pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op
 971 pprInstr (FDIV sz src)
 972   = hcat [ptext SLIT("\tfdiv"), pprSize sz, space, pprOperand sz src]
 973 pprInstr FDIVP
 974   = ptext SLIT("\tfdivp")
 975 pprInstr (FDIVR sz src)
 976   = hcat [ptext SLIT("\tfdivr"), pprSize sz, space, pprOperand sz src]
 977 pprInstr FDIVRP
 978   = ptext SLIT("\tfdivpr")
 979 pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op
 980 pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op
 981 pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg
 982 pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op
 983 pprInstr (FLD sz (OpImm (ImmCLbl src)))
 984   = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprCLabel_asm src]
 985 pprInstr (FLD sz src)
 986   = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprOperand sz src]
 987 pprInstr FLD1 = ptext SLIT("\tfld1")
 988 pprInstr FLDZ = ptext SLIT("\tfldz")
 989 pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op
 990 pprInstr FRNDINT = ptext SLIT("\tfrndint")
 991 pprInstr FSIN = ptext SLIT("\tfsin")
 992 pprInstr FSQRT = ptext SLIT("\tfsqrt")
 993 pprInstr (FST sz dst)
 994   = hcat [ptext SLIT("\tfst"), pprSize sz, space, pprOperand sz dst]
 995 pprInstr (FSTP sz dst)
 996   = hcat [ptext SLIT("\tfstp"), pprSize sz, space, pprOperand sz dst]
 997 pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op
 998 pprInstr (FSUB sz src)
 999   = hcat [ptext SLIT("\tfsub"), pprSize sz, space, pprOperand sz src]
1000 pprInstr FSUBP
1001   = ptext SLIT("\tfsubp")
1002 pprInstr (FSUBR size src)
1003   = pprSizeOp SLIT("fsubr") size src
1004 pprInstr FSUBRP
1005   = ptext SLIT("\tfsubpr")
1006 pprInstr (FISUBR size op)
1007   = pprSizeAddr SLIT("fisubr") size op
1008 pprInstr FTST = ptext SLIT("\tftst")
1009 pprInstr (FCOMP sz op)
1010   = hcat [ptext SLIT("\tfcomp"), pprSize sz, space, pprOperand sz op]
1011 pprInstr FUCOMPP = ptext SLIT("\tfucompp")
1012 pprInstr FXCH = ptext SLIT("\tfxch")
1013 pprInstr FNSTSW = ptext SLIT("\tfnstsw %ax")
1014 pprInstr FNOP = ptext SLIT("")
1015 \end{code}
1016
1017 Continue with I386-only printing bits and bobs:
1018 \begin{code}
1019 pprDollImm :: Imm -> SDoc
1020
1021 pprDollImm i     = hcat [ ptext SLIT("$"), pprImm i]
1022
1023 pprOperand :: Size -> Operand -> SDoc
1024 pprOperand s (OpReg r) = pprReg s r
1025 pprOperand s (OpImm i) = pprDollImm i
1026 pprOperand s (OpAddr ea) = pprAddr ea
1027
1028 pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc
1029 pprSizeOp name size op1
1030   = hcat [
1031         char '\t',
1032         ptext name,
1033         pprSize size,
1034         space,
1035         pprOperand size op1
1036     ]
1037
1038 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1039 pprSizeOpOp name size op1 op2
1040   = hcat [
1041         char '\t',
1042         ptext name,
1043         pprSize size,
1044         space,
1045         pprOperand size op1,
1046         comma,
1047         pprOperand size op2
1048     ]
1049
1050 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1051 pprSizeByteOpOp name size op1 op2
1052   = hcat [
1053         char '\t',
1054         ptext name,
1055         pprSize size,
1056         space,
1057         pprOperand B op1,
1058         comma,
1059         pprOperand size op2
1060     ]
1061
1062 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc
1063 pprSizeOpReg name size op1 reg
1064   = hcat [
1065         char '\t',
1066         ptext name,
1067         pprSize size,
1068         space,
1069         pprOperand size op1,
1070         comma,
1071         pprReg size reg
1072     ]
1073
1074 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
1075 pprSizeAddr name size op
1076   = hcat [
1077         char '\t',
1078         ptext name,
1079         pprSize size,
1080         space,
1081         pprAddr op
1082     ]
1083
1084 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc
1085 pprSizeAddrReg name size op dst
1086   = hcat [
1087         char '\t',
1088         ptext name,
1089         pprSize size,
1090         space,
1091         pprAddr op,
1092         comma,
1093         pprReg size dst
1094     ]
1095
1096 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1097 pprOpOp name size op1 op2
1098   = hcat [
1099         char '\t',
1100         ptext name, space,
1101         pprOperand size op1,
1102         comma,
1103         pprOperand size op2
1104     ]
1105
1106 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
1107 pprSizeOpOpCoerce name size1 size2 op1 op2
1108   = hcat [ char '\t', ptext name, space,
1109         pprOperand size1 op1,
1110         comma,
1111         pprOperand size2 op2
1112     ]
1113
1114 pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc
1115 pprCondInstr name cond arg
1116   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1117
1118 #endif {-i386_TARGET_ARCH-}
1119 \end{code}
1120
1121 %************************************************************************
1122 %*                                                                      *
1123 \subsubsection{@pprInstr@ for a SPARC}
1124 %*                                                                      *
1125 %************************************************************************
1126
1127 \begin{code}
1128 #if sparc_TARGET_ARCH
1129
1130 -- a clumsy hack for now, to handle possible double alignment problems
1131
1132 -- even clumsier, to allow for RegReg regs that show when doing indexed
1133 -- reads (bytearrays).
1134 --
1135 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1136   = hcat [
1137         ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1138         pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n',
1139         pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)
1140     ]
1141
1142 pprInstr (LD DF addr reg) | maybeToBool off_addr
1143   = hcat [
1144         pp_ld_lbracket,
1145         pprAddr addr,
1146         pp_rbracket_comma,
1147         pprReg reg,
1148
1149         char '\n',
1150         pp_ld_lbracket,
1151         pprAddr addr2,
1152         pp_rbracket_comma,
1153         pprReg (fPair reg)
1154     ]
1155   where
1156     off_addr = addrOffset addr 4
1157     addr2 = case off_addr of Just x -> x
1158
1159 pprInstr (LD size addr reg)
1160   = hcat [
1161         ptext SLIT("\tld"),
1162         pprSize size,
1163         char '\t',
1164         lbrack,
1165         pprAddr addr,
1166         pp_rbracket_comma,
1167         pprReg reg
1168     ]
1169
1170 -- The same clumsy hack as above
1171
1172 pprInstr (ST DF reg (AddrRegReg g1 g2))
1173  = hcat [
1174         ptext SLIT("\tadd\t"),
1175                       pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1176         ptext SLIT("\tst\t"),
1177               pprReg reg, pp_comma_lbracket, pprReg g1,
1178         ptext SLIT("]\n\tst\t"),
1179               pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]")
1180     ]
1181
1182 pprInstr (ST DF reg addr) | maybeToBool off_addr
1183  = hcat [
1184         ptext SLIT("\tst\t"),
1185         pprReg reg, pp_comma_lbracket,  pprAddr addr,
1186
1187         ptext SLIT("]\n\tst\t"),
1188         pprReg (fPair reg), pp_comma_lbracket,
1189         pprAddr addr2, rbrack
1190     ]
1191   where
1192     off_addr = addrOffset addr 4
1193     addr2 = case off_addr of Just x -> x
1194
1195 -- no distinction is made between signed and unsigned bytes on stores for the
1196 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1197 -- so we call a special-purpose pprSize for ST..
1198
1199 pprInstr (ST size reg addr)
1200   = hcat [
1201         ptext SLIT("\tst"),
1202         pprStSize size,
1203         char '\t',
1204         pprReg reg,
1205         pp_comma_lbracket,
1206         pprAddr addr,
1207         rbrack
1208     ]
1209
1210 pprInstr (ADD x cc reg1 ri reg2)
1211   | not x && not cc && riZero ri
1212   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1213   | otherwise
1214   = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1215
1216 pprInstr (SUB x cc reg1 ri reg2)
1217   | not x && cc && reg2 == g0
1218   = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1219   | not x && not cc && riZero ri
1220   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1221   | otherwise
1222   = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1223
1224 pprInstr (AND  b reg1 ri reg2) = pprRegRIReg SLIT("and")  b reg1 ri reg2
1225 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1226
1227 pprInstr (OR b reg1 ri reg2)
1228   | not b && reg1 == g0
1229   = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1230   | otherwise
1231   = pprRegRIReg SLIT("or") b reg1 ri reg2
1232
1233 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1234
1235 pprInstr (XOR  b reg1 ri reg2) = pprRegRIReg SLIT("xor")  b reg1 ri reg2
1236 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1237
1238 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1239 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1240 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1241
1242 pprInstr (SETHI imm reg)
1243   = hcat [
1244         ptext SLIT("\tsethi\t"),
1245         pprImm imm,
1246         comma,
1247         pprReg reg
1248     ]
1249
1250 pprInstr NOP = ptext SLIT("\tnop")
1251
1252 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1253 pprInstr (FABS DF reg1 reg2)
1254   = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1255     (if (reg1 == reg2) then empty
1256      else (<>) (char '\n')
1257           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1258
1259 pprInstr (FADD size reg1 reg2 reg3)
1260   = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1261 pprInstr (FCMP e size reg1 reg2)
1262   = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1263 pprInstr (FDIV size reg1 reg2 reg3)
1264   = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1265
1266 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1267 pprInstr (FMOV DF reg1 reg2)
1268   = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1269     (if (reg1 == reg2) then empty
1270      else (<>) (char '\n')
1271           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1272
1273 pprInstr (FMUL size reg1 reg2 reg3)
1274   = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1275
1276 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1277 pprInstr (FNEG DF reg1 reg2)
1278   = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1279     (if (reg1 == reg2) then empty
1280      else (<>) (char '\n')
1281           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1282
1283 pprInstr (FSQRT size reg1 reg2)     = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1284 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1285 pprInstr (FxTOy size1 size2 reg1 reg2)
1286   = hcat [
1287         ptext SLIT("\tf"),
1288         ptext
1289         (case size1 of
1290             W  -> SLIT("ito")
1291             F  -> SLIT("sto")
1292             DF -> SLIT("dto")),
1293         ptext
1294         (case size2 of
1295             W  -> SLIT("i\t")
1296             F  -> SLIT("s\t")
1297             DF -> SLIT("d\t")),
1298         pprReg reg1, comma, pprReg reg2
1299     ]
1300
1301
1302 pprInstr (BI cond b lab)
1303   = hcat [
1304         ptext SLIT("\tb"), pprCond cond,
1305         if b then pp_comma_a else empty,
1306         char '\t',
1307         pprImm lab
1308     ]
1309
1310 pprInstr (BF cond b lab)
1311   = hcat [
1312         ptext SLIT("\tfb"), pprCond cond,
1313         if b then pp_comma_a else empty,
1314         char '\t',
1315         pprImm lab
1316     ]
1317
1318 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1319
1320 pprInstr (CALL imm n _)
1321   = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1322 \end{code}
1323
1324 Continue with SPARC-only printing bits and bobs:
1325 \begin{code}
1326 pprRI :: RI -> SDoc
1327 pprRI (RIReg r) = pprReg r
1328 pprRI (RIImm r) = pprImm r
1329
1330 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1331 pprSizeRegReg name size reg1 reg2
1332   = hcat [
1333         char '\t',
1334         ptext name,
1335         (case size of
1336             F  -> ptext SLIT("s\t")
1337             DF -> ptext SLIT("d\t")),
1338         pprReg reg1,
1339         comma,
1340         pprReg reg2
1341     ]
1342
1343 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1344 pprSizeRegRegReg name size reg1 reg2 reg3
1345   = hcat [
1346         char '\t',
1347         ptext name,
1348         (case size of
1349             F  -> ptext SLIT("s\t")
1350             DF -> ptext SLIT("d\t")),
1351         pprReg reg1,
1352         comma,
1353         pprReg reg2,
1354         comma,
1355         pprReg reg3
1356     ]
1357
1358 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc
1359 pprRegRIReg name b reg1 ri reg2
1360   = hcat [
1361         char '\t',
1362         ptext name,
1363         if b then ptext SLIT("cc\t") else char '\t',
1364         pprReg reg1,
1365         comma,
1366         pprRI ri,
1367         comma,
1368         pprReg reg2
1369     ]
1370
1371 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc
1372 pprRIReg name b ri reg1
1373   = hcat [
1374         char '\t',
1375         ptext name,
1376         if b then ptext SLIT("cc\t") else char '\t',
1377         pprRI ri,
1378         comma,
1379         pprReg reg1
1380     ]
1381
1382 pp_ld_lbracket    = ptext SLIT("\tld\t[")
1383 pp_rbracket_comma = text "],"
1384 pp_comma_lbracket = text ",["
1385 pp_comma_a        = text ",a"
1386
1387 #endif {-sparc_TARGET_ARCH-}
1388 \end{code}