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