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