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