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