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