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