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