ghc/compiler/nativeGen/PprMach.lhs

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