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