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, pprSize ) 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         ILIT( 8) -> SLIT("%fake0");  ILIT( 9) -> SLIT("%fake1");
 129         ILIT(10) -> SLIT("%fake2");  ILIT(11) -> SLIT("%fake3");
 130         ILIT(12) -> SLIT("%fake4");  ILIT(13) -> SLIT("%fake5");
 131         _ -> SLIT("very naughty I386 float register")
 132       })
 133
 134     ppr_reg_no DF i = ptext
 135       (case i of {
 136         ILIT( 8) -> SLIT("%fake0");  ILIT( 9) -> SLIT("%fake1");
 137         ILIT(10) -> SLIT("%fake2");  ILIT(11) -> SLIT("%fake3");
 138         ILIT(12) -> SLIT("%fake4");  ILIT(13) -> SLIT("%fake5");
 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) = empty -- nuke 'em
 394 pprInstr (COMMENT s)
 395    =  IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ptext s))
 396      ,IF_ARCH_sparc( ((<>) (ptext SLIT("! "))   (ptext s))
 397      ,IF_ARCH_i386( ((<>) (ptext SLIT("# "))   (ptext s))
 398      ,)))
 399
 400 pprInstr (SEGMENT TextSegment)
 401     =  IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-}
 402       ,IF_ARCH_sparc(ptext SLIT("\t.text\n\t.align 4") {-word boundary-}
 403       ,IF_ARCH_i386((text ".text\n\t.align 4,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 4")
 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 #if 0
 450 pprInstr (DATA s xs)
 451   = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs]
 452   where
 453     pp_size = case s of
 454 #if alpha_TARGET_ARCH
 455             B  -> SLIT("\t.byte\t")
 456             BU -> SLIT("\t.byte\t")
 457             Q  -> SLIT("\t.quad\t")
 458             TF -> SLIT("\t.t_floating\t")
 459 #endif
 460 #if i386_TARGET_ARCH
 461             B  -> SLIT("\t.byte\t")
 462             L  -> SLIT("\t.long\t")
 463             F  -> SLIT("\t.float\t")
 464             DF -> SLIT("\t.double\t")
 465 #endif
 466 #if sparc_TARGET_ARCH
 467             B  -> SLIT("\t.byte\t")
 468             BU -> SLIT("\t.byte\t")
 469             W  -> SLIT("\t.word\t")
 470             DF -> SLIT("\t.double\t")
 471 #endif
 472 #endif
 473
 474
 475 pprInstr (DATA s xs)
 476   = vcat (concatMap (ppr_item s) xs)
 477     where
 478 #if alpha_TARGET_ARCH
 479             ppr_item = error "ppr_item on Alpha"
 480 #if 0
 481             This needs to be fixed.
 482             B  -> SLIT("\t.byte\t")
 483             BU -> SLIT("\t.byte\t")
 484             Q  -> SLIT("\t.quad\t")
 485             TF -> SLIT("\t.t_floating\t")
 486 #endif
 487 #endif
 488 #if sparc_TARGET_ARCH
 489             ppr_item = error "ppr_item on Sparc"
 490 #if 0
 491             This needs to be fixed.
 492             B  -> SLIT("\t.byte\t")
 493             BU -> SLIT("\t.byte\t")
 494             W  -> SLIT("\t.word\t")
 495             DF -> SLIT("\t.double\t")
 496 #endif
 497 #endif
 498 #if i386_TARGET_ARCH
 499         ppr_item B  x = [text "\t.byte\t" <> pprImm x]
 500         ppr_item L  x = [text "\t.long\t" <> pprImm x]
 501         ppr_item F  (ImmDouble r)
 502            = let bs = floatToBytes (fromRational r)
 503              in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
 504         ppr_item DF (ImmDouble r)
 505            = let bs = doubleToBytes (fromRational r)
 506              in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
 507
 508         floatToBytes :: Float -> [Int]
 509         floatToBytes f
 510            = runST (do
 511                 arr <- newFloatArray ((0::Int),3)
 512                 writeFloatArray arr 0 f
 513                 i0 <- readCharArray arr 0
 514                 i1 <- readCharArray arr 1
 515                 i2 <- readCharArray arr 2
 516                 i3 <- readCharArray arr 3
 517                 return (map ord [i0,i1,i2,i3])
 518              )
 519
 520         doubleToBytes :: Double -> [Int]
 521         doubleToBytes d
 522            = runST (do
 523                 arr <- newDoubleArray ((0::Int),7)
 524                 writeDoubleArray arr 0 d
 525                 i0 <- readCharArray arr 0
 526                 i1 <- readCharArray arr 1
 527                 i2 <- readCharArray arr 2
 528                 i3 <- readCharArray arr 3
 529                 i4 <- readCharArray arr 4
 530                 i5 <- readCharArray arr 5
 531                 i6 <- readCharArray arr 6
 532                 i7 <- readCharArray arr 7
 533                 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
 534              )
 535
 536 #endif
 537
 538 -- fall through to rest of (machine-specific) pprInstr...
 539 \end{code}
 540
 541 %************************************************************************
 542 %*                                                                      *
 543 \subsubsection{@pprInstr@ for an Alpha}
 544 %*                                                                      *
 545 %************************************************************************
 546
 547 \begin{code}
 548 #if alpha_TARGET_ARCH
 549
 550 pprInstr (LD size reg addr)
 551   = hcat [
 552         ptext SLIT("\tld"),
 553         pprSize size,
 554         char '\t',
 555         pprReg reg,
 556         comma,
 557         pprAddr addr
 558     ]
 559
 560 pprInstr (LDA reg addr)
 561   = hcat [
 562         ptext SLIT("\tlda\t"),
 563         pprReg reg,
 564         comma,
 565         pprAddr addr
 566     ]
 567
 568 pprInstr (LDAH reg addr)
 569   = hcat [
 570         ptext SLIT("\tldah\t"),
 571         pprReg reg,
 572         comma,
 573         pprAddr addr
 574     ]
 575
 576 pprInstr (LDGP reg addr)
 577   = hcat [
 578         ptext SLIT("\tldgp\t"),
 579         pprReg reg,
 580         comma,
 581         pprAddr addr
 582     ]
 583
 584 pprInstr (LDI size reg imm)
 585   = hcat [
 586         ptext SLIT("\tldi"),
 587         pprSize size,
 588         char '\t',
 589         pprReg reg,
 590         comma,
 591         pprImm imm
 592     ]
 593
 594 pprInstr (ST size reg addr)
 595   = hcat [
 596         ptext SLIT("\tst"),
 597         pprSize size,
 598         char '\t',
 599         pprReg reg,
 600         comma,
 601         pprAddr addr
 602     ]
 603
 604 pprInstr (CLR reg)
 605   = hcat [
 606         ptext SLIT("\tclr\t"),
 607         pprReg reg
 608     ]
 609
 610 pprInstr (ABS size ri reg)
 611   = hcat [
 612         ptext SLIT("\tabs"),
 613         pprSize size,
 614         char '\t',
 615         pprRI ri,
 616         comma,
 617         pprReg reg
 618     ]
 619
 620 pprInstr (NEG size ov ri reg)
 621   = hcat [
 622         ptext SLIT("\tneg"),
 623         pprSize size,
 624         if ov then ptext SLIT("v\t") else char '\t',
 625         pprRI ri,
 626         comma,
 627         pprReg reg
 628     ]
 629
 630 pprInstr (ADD size ov reg1 ri reg2)
 631   = hcat [
 632         ptext SLIT("\tadd"),
 633         pprSize size,
 634         if ov then ptext SLIT("v\t") else char '\t',
 635         pprReg reg1,
 636         comma,
 637         pprRI ri,
 638         comma,
 639         pprReg reg2
 640     ]
 641
 642 pprInstr (SADD size scale reg1 ri reg2)
 643   = hcat [
 644         ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
 645         ptext SLIT("add"),
 646         pprSize size,
 647         char '\t',
 648         pprReg reg1,
 649         comma,
 650         pprRI ri,
 651         comma,
 652         pprReg reg2
 653     ]
 654
 655 pprInstr (SUB size ov reg1 ri reg2)
 656   = hcat [
 657         ptext SLIT("\tsub"),
 658         pprSize size,
 659         if ov then ptext SLIT("v\t") else char '\t',
 660         pprReg reg1,
 661         comma,
 662         pprRI ri,
 663         comma,
 664         pprReg reg2
 665     ]
 666
 667 pprInstr (SSUB size scale reg1 ri reg2)
 668   = hcat [
 669         ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
 670         ptext SLIT("sub"),
 671         pprSize size,
 672         char '\t',
 673         pprReg reg1,
 674         comma,
 675         pprRI ri,
 676         comma,
 677         pprReg reg2
 678     ]
 679
 680 pprInstr (MUL size ov reg1 ri reg2)
 681   = hcat [
 682         ptext SLIT("\tmul"),
 683         pprSize size,
 684         if ov then ptext SLIT("v\t") else char '\t',
 685         pprReg reg1,
 686         comma,
 687         pprRI ri,
 688         comma,
 689         pprReg reg2
 690     ]
 691
 692 pprInstr (DIV size uns reg1 ri reg2)
 693   = hcat [
 694         ptext SLIT("\tdiv"),
 695         pprSize size,
 696         if uns then ptext SLIT("u\t") else char '\t',
 697         pprReg reg1,
 698         comma,
 699         pprRI ri,
 700         comma,
 701         pprReg reg2
 702     ]
 703
 704 pprInstr (REM size uns reg1 ri reg2)
 705   = hcat [
 706         ptext SLIT("\trem"),
 707         pprSize size,
 708         if uns then ptext SLIT("u\t") else char '\t',
 709         pprReg reg1,
 710         comma,
 711         pprRI ri,
 712         comma,
 713         pprReg reg2
 714     ]
 715
 716 pprInstr (NOT ri reg)
 717   = hcat [
 718         ptext SLIT("\tnot"),
 719         char '\t',
 720         pprRI ri,
 721         comma,
 722         pprReg reg
 723     ]
 724
 725 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
 726 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
 727 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
 728 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
 729 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
 730 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
 731
 732 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
 733 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
 734 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
 735
 736 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
 737 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
 738
 739 pprInstr (NOP) = ptext SLIT("\tnop")
 740
 741 pprInstr (CMP cond reg1 ri reg2)
 742   = hcat [
 743         ptext SLIT("\tcmp"),
 744         pprCond cond,
 745         char '\t',
 746         pprReg reg1,
 747         comma,
 748         pprRI ri,
 749         comma,
 750         pprReg reg2
 751     ]
 752
 753 pprInstr (FCLR reg)
 754   = hcat [
 755         ptext SLIT("\tfclr\t"),
 756         pprReg reg
 757     ]
 758
 759 pprInstr (FABS reg1 reg2)
 760   = hcat [
 761         ptext SLIT("\tfabs\t"),
 762         pprReg reg1,
 763         comma,
 764         pprReg reg2
 765     ]
 766
 767 pprInstr (FNEG size reg1 reg2)
 768   = hcat [
 769         ptext SLIT("\tneg"),
 770         pprSize size,
 771         char '\t',
 772         pprReg reg1,
 773         comma,
 774         pprReg reg2
 775     ]
 776
 777 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
 778 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
 779 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
 780 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
 781
 782 pprInstr (CVTxy size1 size2 reg1 reg2)
 783   = hcat [
 784         ptext SLIT("\tcvt"),
 785         pprSize size1,
 786         case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
 787         char '\t',
 788         pprReg reg1,
 789         comma,
 790         pprReg reg2
 791     ]
 792
 793 pprInstr (FCMP size cond reg1 reg2 reg3)
 794   = hcat [
 795         ptext SLIT("\tcmp"),
 796         pprSize size,
 797         pprCond cond,
 798         char '\t',
 799         pprReg reg1,
 800         comma,
 801         pprReg reg2,
 802         comma,
 803         pprReg reg3
 804     ]
 805
 806 pprInstr (FMOV reg1 reg2)
 807   = hcat [
 808         ptext SLIT("\tfmov\t"),
 809         pprReg reg1,
 810         comma,
 811         pprReg reg2
 812     ]
 813
 814 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
 815
 816 pprInstr (BI NEVER reg lab) = empty
 817
 818 pprInstr (BI cond reg lab)
 819   = hcat [
 820         ptext SLIT("\tb"),
 821         pprCond cond,
 822         char '\t',
 823         pprReg reg,
 824         comma,
 825         pprImm lab
 826     ]
 827
 828 pprInstr (BF cond reg lab)
 829   = hcat [
 830         ptext SLIT("\tfb"),
 831         pprCond cond,
 832         char '\t',
 833         pprReg reg,
 834         comma,
 835         pprImm lab
 836     ]
 837
 838 pprInstr (BR lab)
 839   = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
 840
 841 pprInstr (JMP reg addr hint)
 842   = hcat [
 843         ptext SLIT("\tjmp\t"),
 844         pprReg reg,
 845         comma,
 846         pprAddr addr,
 847         comma,
 848         int hint
 849     ]
 850
 851 pprInstr (BSR imm n)
 852   = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
 853
 854 pprInstr (JSR reg addr n)
 855   = hcat [
 856         ptext SLIT("\tjsr\t"),
 857         pprReg reg,
 858         comma,
 859         pprAddr addr
 860     ]
 861
 862 pprInstr (FUNBEGIN clab)
 863   = hcat [
 864         if (externallyVisibleCLabel clab) then
 865             hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
 866         else
 867             empty,
 868         ptext SLIT("\t.ent "),
 869         pp_lab,
 870         char '\n',
 871         pp_lab,
 872         pp_ldgp,
 873         pp_lab,
 874         pp_frame
 875     ]
 876     where
 877         pp_lab = pprCLabel_asm clab
 878
 879         -- NEVER use commas within those string literals, cpp will ruin your day
 880         pp_ldgp  = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
 881         pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
 882                           ptext SLIT("4240"), char ',',
 883                           ptext SLIT("$26"), char ',',
 884                           ptext SLIT("0\n\t.prologue 1") ]
 885
 886 pprInstr (FUNEND clab)
 887   = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
 888 \end{code}
 889
 890 Continue with Alpha-only printing bits and bobs:
 891 \begin{code}
 892 pprRI :: RI -> SDoc
 893
 894 pprRI (RIReg r) = pprReg r
 895 pprRI (RIImm r) = pprImm r
 896
 897 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc
 898
 899 pprRegRIReg name reg1 ri reg2
 900   = hcat [
 901         char '\t',
 902         ptext name,
 903         char '\t',
 904         pprReg reg1,
 905         comma,
 906         pprRI ri,
 907         comma,
 908         pprReg reg2
 909     ]
 910
 911 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
 912
 913 pprSizeRegRegReg name size reg1 reg2 reg3
 914   = hcat [
 915         char '\t',
 916         ptext name,
 917         pprSize size,
 918         char '\t',
 919         pprReg reg1,
 920         comma,
 921         pprReg reg2,
 922         comma,
 923         pprReg reg3
 924     ]
 925
 926 #endif {-alpha_TARGET_ARCH-}
 927 \end{code}
 928
 929 %************************************************************************
 930 %*                                                                      *
 931 \subsubsection{@pprInstr@ for an I386}
 932 %*                                                                      *
 933 %************************************************************************
 934
 935 \begin{code}
 936 #if i386_TARGET_ARCH
 937
 938 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
 939   | src == dst
 940   =
 941 #ifdef DEBUG
 942     (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
 943 #else
 944     empty
 945 #endif
 946 pprInstr (MOV size src dst)
 947   = pprSizeOpOp SLIT("mov") size src dst
 948 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes L src dst
 949 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes L src dst
 950
 951 -- here we do some patching, since the physical registers are only set late
 952 -- in the code generation.
 953 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
 954   | reg1 == reg3
 955   = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
 956 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
 957   | reg2 == reg3
 958   = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
 959 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
 960   | reg1 == reg3
 961   = pprInstr (ADD size (OpImm displ) dst)
 962 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
 963
 964 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
 965   = pprSizeOp SLIT("dec") size dst
 966 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
 967   = pprSizeOp SLIT("inc") size dst
 968 pprInstr (ADD size src dst)
 969   = pprSizeOpOp SLIT("add") size src dst
 970 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
 971 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
 972 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
 973
 974 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
 975 pprInstr (OR  size src dst) = pprSizeOpOp SLIT("or")  size src dst
 976 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor")  size src dst
 977 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
 978 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
 979
 980 pprInstr (SHL size imm dst) = {-pprSizeByteOpOp-} pprSizeOpOp SLIT("shl")  size imm dst
 981 pprInstr (SAR size imm dst) = {-pprSizeByteOpOp-} pprSizeOpOp SLIT("sar")  size imm dst
 982 pprInstr (SHR size imm dst) = {-pprSizeByteOpOp-} pprSizeOpOp SLIT("shr")  size imm dst
 983
 984 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp")  size src dst
 985 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test")  size src dst
 986 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
 987 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
 988 pprInstr PUSHA = ptext SLIT("\tpushal")
 989 pprInstr POPA = ptext SLIT("\tpopal")
 990
 991 pprInstr (NOP) = ptext SLIT("\tnop")
 992 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
 993 pprInstr (CLTD) = ptext SLIT("\tcltd")
 994
 995 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
 996
 997 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
 998
 999 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1000 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
1001 pprInstr (CALL imm)
1002    = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1003
1004
1005 -- Simulating a flat register set on the x86 FP stack is tricky.
1006 -- you have to free %st(7) before pushing anything on the FP reg stack
1007 -- so as to preclude the possibility of a FP stack overflow exception.
1008 pprInstr g@(GMOV src dst)
1009    | src == dst
1010    = empty
1011    | otherwise
1012    = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1013
1014 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1015 pprInstr g@(GLD sz addr dst)
1016  = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1017                  pprAddr addr, gsemi, gpop dst 1])
1018
1019 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1020 pprInstr g@(GST sz src addr)
1021  = pprG g (hcat [gtab, gpush src 0, gsemi,
1022                  text "fstp", pprSize sz, gsp, pprAddr addr])
1023
1024 pprInstr g@(GFTOD src dst)
1025    = pprG g bogus
1026 pprInstr g@(GFTOI src dst)
1027    = pprG g bogus
1028
1029 pprInstr g@(GDTOF src dst)
1030    = pprG g bogus
1031 pprInstr g@(GDTOI src dst)
1032    = pprG g bogus
1033
1034 pprInstr g@(GITOF src dst)
1035    = pprG g bogus
1036 pprInstr g@(GITOD src dst)
1037    = pprG g bogus
1038
1039 pprInstr g@(GCMP sz src1 src2)
1040    = pprG g (hcat [gtab, text "pushl %eax ; ",
1041                    gpush src2 0, gsemi, gpush src1 1]
1042              $$
1043              hcat [gtab, text "fcompp ; fstsw %ax ; sahf ; popl %eax"])
1044
1045 pprInstr g@(GABS sz src dst)
1046    = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1047 pprInstr g@(GNEG sz src dst)
1048    = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1049 pprInstr g@(GSQRT sz src dst)
1050    = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt ; ", gpop dst 1])
1051 pprInstr g@(GSIN sz src dst)
1052    = pprG g (hcat [gtab, gpush src 0, text " ; fsin ; ", gpop dst 1])
1053 pprInstr g@(GCOS sz src dst)
1054    = pprG g (hcat [gtab, gpush src 0, text " ; fcos ; ", gpop dst 1])
1055
1056 pprInstr g@(GTAN sz src dst)
1057    = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1058                    gpush src 0, text " ; fptan ; ",
1059                    text " fstp %st(0) ; ", gpop dst 1])
1060
1061 pprInstr g@(GADD sz src1 src2 dst)
1062    = pprG g (hcat [gtab, gpush src1 0,
1063                    text " ; fadd ", greg src2 1, text ",%st(0)",
1064                    gsemi, gpop dst 1])
1065 pprInstr g@(GSUB sz src1 src2 dst)
1066    = pprG g (hcat [gtab, gpush src1 0,
1067                    text " ; fsub ", greg src2 1, text ",%st(0)",
1068                    gsemi, gpop dst 1])
1069 pprInstr g@(GMUL sz src1 src2 dst)
1070    = pprG g (hcat [gtab, gpush src1 0,
1071                    text " ; fmul ", greg src2 1, text ",%st(0)",
1072                    gsemi, gpop dst 1])
1073 pprInstr g@(GDIV sz src1 src2 dst)
1074    = pprG g (hcat [gtab, gpush src1 0,
1075                    text " ; fdiv ", greg src2 1, text ",%st(0)",
1076                    gsemi, gpop dst 1])
1077
1078 pprInstr GFREE
1079    = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1080             ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1081           ]
1082
1083 --------------------------
1084 gpush reg offset
1085    = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1086 gpop reg offset
1087    = hcat [text "fstp ", greg reg offset]
1088
1089 bogus = text "\tbogus"
1090 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1091 gsemi = text " ; "
1092 gtab  = char '\t'
1093 gsp   = char ' '
1094 gregno (FixedReg i) = I# i
1095 gregno (MappedReg i) = I# i
1096 gregno other = pprPanic "gregno" (text (show other))
1097
1098 pprG :: Instr -> SDoc -> SDoc
1099 pprG fake actual
1100    = (char '#' <> pprGInstr fake) $$ actual
1101
1102 pprGInstr (GMOV src dst)   = pprSizeRegReg SLIT("gmov") DF src dst
1103 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1104 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1105
1106 pprGInstr (GFTOD src dst) = pprSizeSizeRegReg SLIT("gftod") F DF src dst
1107 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L  src dst
1108
1109 pprGInstr (GDTOF src dst) = pprSizeSizeRegReg SLIT("gdtof") DF F src dst
1110 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
1111
1112 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F  src dst
1113 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
1114
1115 pprGInstr (GCMP sz src dst) = pprSizeRegReg SLIT("gcmp") sz src dst
1116 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1117 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1118 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1119 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1120 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1121 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1122
1123 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1124 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1125 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1126 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1127 \end{code}
1128
1129 Continue with I386-only printing bits and bobs:
1130 \begin{code}
1131 pprDollImm :: Imm -> SDoc
1132
1133 pprDollImm i     = hcat [ ptext SLIT("$"), pprImm i]
1134
1135 pprOperand :: Size -> Operand -> SDoc
1136 pprOperand s (OpReg r) = pprReg s r
1137 pprOperand s (OpImm i) = pprDollImm i
1138 pprOperand s (OpAddr ea) = pprAddr ea
1139
1140 pprSizeImmOp :: FAST_STRING -> Size -> Imm -> Operand -> SDoc
1141 pprSizeImmOp name size imm op1
1142   = hcat [
1143         char '\t',
1144         ptext name,
1145         pprSize size,
1146         space,
1147         char '$',
1148         pprImm imm,
1149         comma,
1150         pprOperand size op1
1151     ]
1152
1153 pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc
1154 pprSizeOp name size op1
1155   = hcat [
1156         char '\t',
1157         ptext name,
1158         pprSize size,
1159         space,
1160         pprOperand size op1
1161     ]
1162
1163 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1164 pprSizeOpOp name size op1 op2
1165   = hcat [
1166         char '\t',
1167         ptext name,
1168         pprSize size,
1169         space,
1170         pprOperand size op1,
1171         comma,
1172         pprOperand size op2
1173     ]
1174
1175 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1176 pprSizeByteOpOp name size op1 op2
1177   = hcat [
1178         char '\t',
1179         ptext name,
1180         pprSize size,
1181         space,
1182         pprOperand B op1,
1183         comma,
1184         pprOperand size op2
1185     ]
1186
1187 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc
1188 pprSizeOpReg name size op1 reg
1189   = hcat [
1190         char '\t',
1191         ptext name,
1192         pprSize size,
1193         space,
1194         pprOperand size op1,
1195         comma,
1196         pprReg size reg
1197     ]
1198
1199 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1200 pprSizeRegReg name size reg1 reg2
1201   = hcat [
1202         char '\t',
1203         ptext name,
1204         pprSize size,
1205         space,
1206         pprReg size reg1,
1207         comma,
1208         pprReg size reg2
1209     ]
1210
1211 pprSizeSizeRegReg :: FAST_STRING -> Size -> Size -> Reg -> Reg -> SDoc
1212 pprSizeSizeRegReg name size1 size2 reg1 reg2
1213   = hcat [
1214         char '\t',
1215         ptext name,
1216         pprSize size1,
1217         pprSize size2,
1218         space,
1219         pprReg size1 reg1,
1220         comma,
1221         pprReg size2 reg2
1222     ]
1223
1224 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1225 pprSizeRegRegReg name size reg1 reg2 reg3
1226   = hcat [
1227         char '\t',
1228         ptext name,
1229         pprSize size,
1230         space,
1231         pprReg size reg1,
1232         comma,
1233         pprReg size reg2,
1234         comma,
1235         pprReg size reg3
1236     ]
1237
1238 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
1239 pprSizeAddr name size op
1240   = hcat [
1241         char '\t',
1242         ptext name,
1243         pprSize size,
1244         space,
1245         pprAddr op
1246     ]
1247
1248 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc
1249 pprSizeAddrReg name size op dst
1250   = hcat [
1251         char '\t',
1252         ptext name,
1253         pprSize size,
1254         space,
1255         pprAddr op,
1256         comma,
1257         pprReg size dst
1258     ]
1259
1260 pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> SDoc
1261 pprSizeRegAddr name size src op
1262   = hcat [
1263         char '\t',
1264         ptext name,
1265         pprSize size,
1266         space,
1267         pprReg size src,
1268         comma,
1269         pprAddr op
1270     ]
1271
1272 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1273 pprOpOp name size op1 op2
1274   = hcat [
1275         char '\t',
1276         ptext name, space,
1277         pprOperand size op1,
1278         comma,
1279         pprOperand size op2
1280     ]
1281
1282 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
1283 pprSizeOpOpCoerce name size1 size2 op1 op2
1284   = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1285         pprOperand size1 op1,
1286         comma,
1287         pprOperand size2 op2
1288     ]
1289
1290 pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc
1291 pprCondInstr name cond arg
1292   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1293
1294 #endif {-i386_TARGET_ARCH-}
1295 \end{code}
1296
1297 %************************************************************************
1298 %*                                                                      *
1299 \subsubsection{@pprInstr@ for a SPARC}
1300 %*                                                                      *
1301 %************************************************************************
1302
1303 \begin{code}
1304 #if sparc_TARGET_ARCH
1305
1306 -- a clumsy hack for now, to handle possible double alignment problems
1307
1308 -- even clumsier, to allow for RegReg regs that show when doing indexed
1309 -- reads (bytearrays).
1310 --
1311 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1312   = hcat [
1313         ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1314         pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n',
1315         pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)
1316     ]
1317
1318 pprInstr (LD DF addr reg) | maybeToBool off_addr
1319   = hcat [
1320         pp_ld_lbracket,
1321         pprAddr addr,
1322         pp_rbracket_comma,
1323         pprReg reg,
1324
1325         char '\n',
1326         pp_ld_lbracket,
1327         pprAddr addr2,
1328         pp_rbracket_comma,
1329         pprReg (fPair reg)
1330     ]
1331   where
1332     off_addr = addrOffset addr 4
1333     addr2 = case off_addr of Just x -> x
1334
1335 pprInstr (LD size addr reg)
1336   = hcat [
1337         ptext SLIT("\tld"),
1338         pprSize size,
1339         char '\t',
1340         lbrack,
1341         pprAddr addr,
1342         pp_rbracket_comma,
1343         pprReg reg
1344     ]
1345
1346 -- The same clumsy hack as above
1347
1348 pprInstr (ST DF reg (AddrRegReg g1 g2))
1349  = hcat [
1350         ptext SLIT("\tadd\t"),
1351                       pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1352         ptext SLIT("\tst\t"),
1353               pprReg reg, pp_comma_lbracket, pprReg g1,
1354         ptext SLIT("]\n\tst\t"),
1355               pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]")
1356     ]
1357
1358 pprInstr (ST DF reg addr) | maybeToBool off_addr
1359  = hcat [
1360         ptext SLIT("\tst\t"),
1361         pprReg reg, pp_comma_lbracket,  pprAddr addr,
1362
1363         ptext SLIT("]\n\tst\t"),
1364         pprReg (fPair reg), pp_comma_lbracket,
1365         pprAddr addr2, rbrack
1366     ]
1367   where
1368     off_addr = addrOffset addr 4
1369     addr2 = case off_addr of Just x -> x
1370
1371 -- no distinction is made between signed and unsigned bytes on stores for the
1372 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1373 -- so we call a special-purpose pprSize for ST..
1374
1375 pprInstr (ST size reg addr)
1376   = hcat [
1377         ptext SLIT("\tst"),
1378         pprStSize size,
1379         char '\t',
1380         pprReg reg,
1381         pp_comma_lbracket,
1382         pprAddr addr,
1383         rbrack
1384     ]
1385
1386 pprInstr (ADD x cc reg1 ri reg2)
1387   | not x && not cc && riZero ri
1388   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1389   | otherwise
1390   = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1391
1392 pprInstr (SUB x cc reg1 ri reg2)
1393   | not x && cc && reg2 == g0
1394   = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1395   | not x && not cc && riZero ri
1396   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1397   | otherwise
1398   = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1399
1400 pprInstr (AND  b reg1 ri reg2) = pprRegRIReg SLIT("and")  b reg1 ri reg2
1401 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1402
1403 pprInstr (OR b reg1 ri reg2)
1404   | not b && reg1 == g0
1405   = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1406   | otherwise
1407   = pprRegRIReg SLIT("or") b reg1 ri reg2
1408
1409 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1410
1411 pprInstr (XOR  b reg1 ri reg2) = pprRegRIReg SLIT("xor")  b reg1 ri reg2
1412 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1413
1414 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1415 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1416 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1417
1418 pprInstr (SETHI imm reg)
1419   = hcat [
1420         ptext SLIT("\tsethi\t"),
1421         pprImm imm,
1422         comma,
1423         pprReg reg
1424     ]
1425
1426 pprInstr NOP = ptext SLIT("\tnop")
1427
1428 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1429 pprInstr (FABS DF reg1 reg2)
1430   = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1431     (if (reg1 == reg2) then empty
1432      else (<>) (char '\n')
1433           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1434
1435 pprInstr (FADD size reg1 reg2 reg3)
1436   = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1437 pprInstr (FCMP e size reg1 reg2)
1438   = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1439 pprInstr (FDIV size reg1 reg2 reg3)
1440   = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1441
1442 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1443 pprInstr (FMOV DF reg1 reg2)
1444   = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1445     (if (reg1 == reg2) then empty
1446      else (<>) (char '\n')
1447           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1448
1449 pprInstr (FMUL size reg1 reg2 reg3)
1450   = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1451
1452 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1453 pprInstr (FNEG DF reg1 reg2)
1454   = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1455     (if (reg1 == reg2) then empty
1456      else (<>) (char '\n')
1457           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1458
1459 pprInstr (FSQRT size reg1 reg2)     = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1460 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1461 pprInstr (FxTOy size1 size2 reg1 reg2)
1462   = hcat [
1463         ptext SLIT("\tf"),
1464         ptext
1465         (case size1 of
1466             W  -> SLIT("ito")
1467             F  -> SLIT("sto")
1468             DF -> SLIT("dto")),
1469         ptext
1470         (case size2 of
1471             W  -> SLIT("i\t")
1472             F  -> SLIT("s\t")
1473             DF -> SLIT("d\t")),
1474         pprReg reg1, comma, pprReg reg2
1475     ]
1476
1477
1478 pprInstr (BI cond b lab)
1479   = hcat [
1480         ptext SLIT("\tb"), pprCond cond,
1481         if b then pp_comma_a else empty,
1482         char '\t',
1483         pprImm lab
1484     ]
1485
1486 pprInstr (BF cond b lab)
1487   = hcat [
1488         ptext SLIT("\tfb"), pprCond cond,
1489         if b then pp_comma_a else empty,
1490         char '\t',
1491         pprImm lab
1492     ]
1493
1494 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1495
1496 pprInstr (CALL imm n _)
1497   = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1498 \end{code}
1499
1500 Continue with SPARC-only printing bits and bobs:
1501 \begin{code}
1502 pprRI :: RI -> SDoc
1503 pprRI (RIReg r) = pprReg r
1504 pprRI (RIImm r) = pprImm r
1505
1506 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1507 pprSizeRegReg name size reg1 reg2
1508   = hcat [
1509         char '\t',
1510         ptext name,
1511         (case size of
1512             F  -> ptext SLIT("s\t")
1513             DF -> ptext SLIT("d\t")),
1514         pprReg reg1,
1515         comma,
1516         pprReg reg2
1517     ]
1518
1519 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1520 pprSizeRegRegReg name size reg1 reg2 reg3
1521   = hcat [
1522         char '\t',
1523         ptext name,
1524         (case size of
1525             F  -> ptext SLIT("s\t")
1526             DF -> ptext SLIT("d\t")),
1527         pprReg reg1,
1528         comma,
1529         pprReg reg2,
1530         comma,
1531         pprReg reg3
1532     ]
1533
1534 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc
1535 pprRegRIReg name b reg1 ri reg2
1536   = hcat [
1537         char '\t',
1538         ptext name,
1539         if b then ptext SLIT("cc\t") else char '\t',
1540         pprReg reg1,
1541         comma,
1542         pprRI ri,
1543         comma,
1544         pprReg reg2
1545     ]
1546
1547 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc
1548 pprRIReg name b ri reg1
1549   = hcat [
1550         char '\t',
1551         ptext name,
1552         if b then ptext SLIT("cc\t") else char '\t',
1553         pprRI ri,
1554         comma,
1555         pprReg reg1
1556     ]
1557
1558 pp_ld_lbracket    = ptext SLIT("\tld\t[")
1559 pp_rbracket_comma = text "],"
1560 pp_comma_lbracket = text ",["
1561 pp_comma_a        = text ",a"
1562
1563 #endif {-sparc_TARGET_ARCH-}
1564 \end{code}