ghc/compiler/nativeGen/PprMach.lhs

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