ghc/compiler/nativeGen/PprMach.lhs

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