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