ghc/compiler/nativeGen/PprMach.lhs

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