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             ( chr, 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 (RealReg 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(".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(".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(".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 #if 0
 414   -- The Solaris assembler doesn't understand \x escapes in
 415   -- strings.
 416   = asciify str
 417   where
 418     asciify :: String -> SDoc
 419     asciify "" = text "\t.ascii \"\\0\""
 420     asciify str
 421        = let fst  = take 16 str
 422              rest = drop 16 str
 423              this = text ("\t.ascii \""
 424                           ++ concat (map asciify_char fst)
 425                           ++ "\"")
 426          in  this $$ asciify rest
 427     asciify_char :: Char -> String
 428     asciify_char c = '\\' : 'x' : hshow (ord c)
 429 #endif
 430   = vcat (map do1 (str ++ [chr 0]))
 431     where
 432        do1 :: Char -> SDoc
 433        do1 c = text "\t.byte\t0x" <> text (hshow (ord c))
 434
 435        hshow :: Int -> String
 436        hshow n | n >= 0 && n <= 255
 437                = [ tab !! (n `div` 16), tab !! (n `mod` 16)]
 438        tab = "0123456789ABCDEF"
 439
 440
 441 pprInstr (DATA s xs)
 442   = vcat (concatMap (ppr_item s) xs)
 443     where
 444
 445 #if alpha_TARGET_ARCH
 446             ppr_item = error "ppr_item on Alpha"
 447 #endif
 448 #if sparc_TARGET_ARCH
 449         -- copy n paste of x86 version
 450         ppr_item B  x = [text "\t.byte\t" <> pprImm x]
 451         ppr_item W  x = [text "\t.long\t" <> pprImm x]
 452         ppr_item F  (ImmFloat r)
 453            = let bs = floatToBytes (fromRational r)
 454              in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
 455         ppr_item DF (ImmDouble r)
 456            = let bs = doubleToBytes (fromRational r)
 457              in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
 458 #endif
 459 #if i386_TARGET_ARCH
 460         ppr_item B  x = [text "\t.byte\t" <> pprImm x]
 461         ppr_item L  x = [text "\t.long\t" <> pprImm x]
 462         ppr_item F  (ImmFloat r)
 463            = let bs = floatToBytes (fromRational r)
 464              in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
 465         ppr_item DF (ImmDouble r)
 466            = let bs = doubleToBytes (fromRational r)
 467              in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
 468 #endif
 469
 470         -- floatToBytes and doubleToBytes convert to the host's byte
 471         -- order.  Providing that we're not cross-compiling for a
 472         -- target with the opposite endianness, this should work ok
 473         -- on all targets.
 474         floatToBytes :: Float -> [Int]
 475         floatToBytes f
 476            = runST (do
 477                 arr <- newFloatArray ((0::Int),3)
 478                 writeFloatArray arr 0 f
 479                 i0 <- readCharArray arr 0
 480                 i1 <- readCharArray arr 1
 481                 i2 <- readCharArray arr 2
 482                 i3 <- readCharArray arr 3
 483                 return (map ord [i0,i1,i2,i3])
 484              )
 485
 486         doubleToBytes :: Double -> [Int]
 487         doubleToBytes d
 488            = runST (do
 489                 arr <- newDoubleArray ((0::Int),7)
 490                 writeDoubleArray arr 0 d
 491                 i0 <- readCharArray arr 0
 492                 i1 <- readCharArray arr 1
 493                 i2 <- readCharArray arr 2
 494                 i3 <- readCharArray arr 3
 495                 i4 <- readCharArray arr 4
 496                 i5 <- readCharArray arr 5
 497                 i6 <- readCharArray arr 6
 498                 i7 <- readCharArray arr 7
 499                 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
 500              )
 501
 502 -- fall through to rest of (machine-specific) pprInstr...
 503 \end{code}
 504
 505 %************************************************************************
 506 %*                                                                      *
 507 \subsubsection{@pprInstr@ for an Alpha}
 508 %*                                                                      *
 509 %************************************************************************
 510
 511 \begin{code}
 512 #if alpha_TARGET_ARCH
 513
 514 pprInstr (LD size reg addr)
 515   = hcat [
 516         ptext SLIT("\tld"),
 517         pprSize size,
 518         char '\t',
 519         pprReg reg,
 520         comma,
 521         pprAddr addr
 522     ]
 523
 524 pprInstr (LDA reg addr)
 525   = hcat [
 526         ptext SLIT("\tlda\t"),
 527         pprReg reg,
 528         comma,
 529         pprAddr addr
 530     ]
 531
 532 pprInstr (LDAH reg addr)
 533   = hcat [
 534         ptext SLIT("\tldah\t"),
 535         pprReg reg,
 536         comma,
 537         pprAddr addr
 538     ]
 539
 540 pprInstr (LDGP reg addr)
 541   = hcat [
 542         ptext SLIT("\tldgp\t"),
 543         pprReg reg,
 544         comma,
 545         pprAddr addr
 546     ]
 547
 548 pprInstr (LDI size reg imm)
 549   = hcat [
 550         ptext SLIT("\tldi"),
 551         pprSize size,
 552         char '\t',
 553         pprReg reg,
 554         comma,
 555         pprImm imm
 556     ]
 557
 558 pprInstr (ST size reg addr)
 559   = hcat [
 560         ptext SLIT("\tst"),
 561         pprSize size,
 562         char '\t',
 563         pprReg reg,
 564         comma,
 565         pprAddr addr
 566     ]
 567
 568 pprInstr (CLR reg)
 569   = hcat [
 570         ptext SLIT("\tclr\t"),
 571         pprReg reg
 572     ]
 573
 574 pprInstr (ABS size ri reg)
 575   = hcat [
 576         ptext SLIT("\tabs"),
 577         pprSize size,
 578         char '\t',
 579         pprRI ri,
 580         comma,
 581         pprReg reg
 582     ]
 583
 584 pprInstr (NEG size ov ri reg)
 585   = hcat [
 586         ptext SLIT("\tneg"),
 587         pprSize size,
 588         if ov then ptext SLIT("v\t") else char '\t',
 589         pprRI ri,
 590         comma,
 591         pprReg reg
 592     ]
 593
 594 pprInstr (ADD size ov reg1 ri reg2)
 595   = hcat [
 596         ptext SLIT("\tadd"),
 597         pprSize size,
 598         if ov then ptext SLIT("v\t") else char '\t',
 599         pprReg reg1,
 600         comma,
 601         pprRI ri,
 602         comma,
 603         pprReg reg2
 604     ]
 605
 606 pprInstr (SADD size scale reg1 ri reg2)
 607   = hcat [
 608         ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
 609         ptext SLIT("add"),
 610         pprSize size,
 611         char '\t',
 612         pprReg reg1,
 613         comma,
 614         pprRI ri,
 615         comma,
 616         pprReg reg2
 617     ]
 618
 619 pprInstr (SUB size ov reg1 ri reg2)
 620   = hcat [
 621         ptext SLIT("\tsub"),
 622         pprSize size,
 623         if ov then ptext SLIT("v\t") else char '\t',
 624         pprReg reg1,
 625         comma,
 626         pprRI ri,
 627         comma,
 628         pprReg reg2
 629     ]
 630
 631 pprInstr (SSUB size scale reg1 ri reg2)
 632   = hcat [
 633         ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
 634         ptext SLIT("sub"),
 635         pprSize size,
 636         char '\t',
 637         pprReg reg1,
 638         comma,
 639         pprRI ri,
 640         comma,
 641         pprReg reg2
 642     ]
 643
 644 pprInstr (MUL size ov reg1 ri reg2)
 645   = hcat [
 646         ptext SLIT("\tmul"),
 647         pprSize size,
 648         if ov then ptext SLIT("v\t") else char '\t',
 649         pprReg reg1,
 650         comma,
 651         pprRI ri,
 652         comma,
 653         pprReg reg2
 654     ]
 655
 656 pprInstr (DIV size uns reg1 ri reg2)
 657   = hcat [
 658         ptext SLIT("\tdiv"),
 659         pprSize size,
 660         if uns then ptext SLIT("u\t") else char '\t',
 661         pprReg reg1,
 662         comma,
 663         pprRI ri,
 664         comma,
 665         pprReg reg2
 666     ]
 667
 668 pprInstr (REM size uns reg1 ri reg2)
 669   = hcat [
 670         ptext SLIT("\trem"),
 671         pprSize size,
 672         if uns then ptext SLIT("u\t") else char '\t',
 673         pprReg reg1,
 674         comma,
 675         pprRI ri,
 676         comma,
 677         pprReg reg2
 678     ]
 679
 680 pprInstr (NOT ri reg)
 681   = hcat [
 682         ptext SLIT("\tnot"),
 683         char '\t',
 684         pprRI ri,
 685         comma,
 686         pprReg reg
 687     ]
 688
 689 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
 690 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
 691 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
 692 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
 693 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
 694 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
 695
 696 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
 697 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
 698 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
 699
 700 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
 701 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
 702
 703 pprInstr (NOP) = ptext SLIT("\tnop")
 704
 705 pprInstr (CMP cond reg1 ri reg2)
 706   = hcat [
 707         ptext SLIT("\tcmp"),
 708         pprCond cond,
 709         char '\t',
 710         pprReg reg1,
 711         comma,
 712         pprRI ri,
 713         comma,
 714         pprReg reg2
 715     ]
 716
 717 pprInstr (FCLR reg)
 718   = hcat [
 719         ptext SLIT("\tfclr\t"),
 720         pprReg reg
 721     ]
 722
 723 pprInstr (FABS reg1 reg2)
 724   = hcat [
 725         ptext SLIT("\tfabs\t"),
 726         pprReg reg1,
 727         comma,
 728         pprReg reg2
 729     ]
 730
 731 pprInstr (FNEG size reg1 reg2)
 732   = hcat [
 733         ptext SLIT("\tneg"),
 734         pprSize size,
 735         char '\t',
 736         pprReg reg1,
 737         comma,
 738         pprReg reg2
 739     ]
 740
 741 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
 742 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
 743 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
 744 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
 745
 746 pprInstr (CVTxy size1 size2 reg1 reg2)
 747   = hcat [
 748         ptext SLIT("\tcvt"),
 749         pprSize size1,
 750         case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
 751         char '\t',
 752         pprReg reg1,
 753         comma,
 754         pprReg reg2
 755     ]
 756
 757 pprInstr (FCMP size cond reg1 reg2 reg3)
 758   = hcat [
 759         ptext SLIT("\tcmp"),
 760         pprSize size,
 761         pprCond cond,
 762         char '\t',
 763         pprReg reg1,
 764         comma,
 765         pprReg reg2,
 766         comma,
 767         pprReg reg3
 768     ]
 769
 770 pprInstr (FMOV reg1 reg2)
 771   = hcat [
 772         ptext SLIT("\tfmov\t"),
 773         pprReg reg1,
 774         comma,
 775         pprReg reg2
 776     ]
 777
 778 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
 779
 780 pprInstr (BI NEVER reg lab) = empty
 781
 782 pprInstr (BI cond reg lab)
 783   = hcat [
 784         ptext SLIT("\tb"),
 785         pprCond cond,
 786         char '\t',
 787         pprReg reg,
 788         comma,
 789         pprImm lab
 790     ]
 791
 792 pprInstr (BF cond reg lab)
 793   = hcat [
 794         ptext SLIT("\tfb"),
 795         pprCond cond,
 796         char '\t',
 797         pprReg reg,
 798         comma,
 799         pprImm lab
 800     ]
 801
 802 pprInstr (BR lab)
 803   = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
 804
 805 pprInstr (JMP reg addr hint)
 806   = hcat [
 807         ptext SLIT("\tjmp\t"),
 808         pprReg reg,
 809         comma,
 810         pprAddr addr,
 811         comma,
 812         int hint
 813     ]
 814
 815 pprInstr (BSR imm n)
 816   = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
 817
 818 pprInstr (JSR reg addr n)
 819   = hcat [
 820         ptext SLIT("\tjsr\t"),
 821         pprReg reg,
 822         comma,
 823         pprAddr addr
 824     ]
 825
 826 pprInstr (FUNBEGIN clab)
 827   = hcat [
 828         if (externallyVisibleCLabel clab) then
 829             hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
 830         else
 831             empty,
 832         ptext SLIT("\t.ent "),
 833         pp_lab,
 834         char '\n',
 835         pp_lab,
 836         pp_ldgp,
 837         pp_lab,
 838         pp_frame
 839     ]
 840     where
 841         pp_lab = pprCLabel_asm clab
 842
 843         -- NEVER use commas within those string literals, cpp will ruin your day
 844         pp_ldgp  = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
 845         pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
 846                           ptext SLIT("4240"), char ',',
 847                           ptext SLIT("$26"), char ',',
 848                           ptext SLIT("0\n\t.prologue 1") ]
 849
 850 pprInstr (FUNEND clab)
 851   = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
 852 \end{code}
 853
 854 Continue with Alpha-only printing bits and bobs:
 855 \begin{code}
 856 pprRI :: RI -> SDoc
 857
 858 pprRI (RIReg r) = pprReg r
 859 pprRI (RIImm r) = pprImm r
 860
 861 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc
 862
 863 pprRegRIReg name reg1 ri reg2
 864   = hcat [
 865         char '\t',
 866         ptext name,
 867         char '\t',
 868         pprReg reg1,
 869         comma,
 870         pprRI ri,
 871         comma,
 872         pprReg reg2
 873     ]
 874
 875 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
 876
 877 pprSizeRegRegReg name size reg1 reg2 reg3
 878   = hcat [
 879         char '\t',
 880         ptext name,
 881         pprSize size,
 882         char '\t',
 883         pprReg reg1,
 884         comma,
 885         pprReg reg2,
 886         comma,
 887         pprReg reg3
 888     ]
 889
 890 #endif {-alpha_TARGET_ARCH-}
 891 \end{code}
 892
 893 %************************************************************************
 894 %*                                                                      *
 895 \subsubsection{@pprInstr@ for an I386}
 896 %*                                                                      *
 897 %************************************************************************
 898
 899 \begin{code}
 900 #if i386_TARGET_ARCH
 901
 902 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
 903   | src == dst
 904   =
 905 #if 0 /* #ifdef DEBUG */
 906     (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
 907 #else
 908     empty
 909 #endif
 910 pprInstr (MOV size src dst)
 911   = pprSizeOpOp SLIT("mov") size src dst
 912 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes L src dst
 913 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes L src dst
 914
 915 -- here we do some patching, since the physical registers are only set late
 916 -- in the code generation.
 917 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
 918   | reg1 == reg3
 919   = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
 920 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
 921   | reg2 == reg3
 922   = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
 923 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
 924   | reg1 == reg3
 925   = pprInstr (ADD size (OpImm displ) dst)
 926 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
 927
 928 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
 929   = pprSizeOp SLIT("dec") size dst
 930 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
 931   = pprSizeOp SLIT("inc") size dst
 932 pprInstr (ADD size src dst)
 933   = pprSizeOpOp SLIT("add") size src dst
 934 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
 935 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
 936 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
 937
 938 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
 939 pprInstr (OR  size src dst) = pprSizeOpOp SLIT("or")  size src dst
 940 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor")  size src dst
 941 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
 942 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
 943
 944 pprInstr (SHL size imm dst) = pprSizeImmOp SLIT("shl") size imm dst
 945 pprInstr (SAR size imm dst) = pprSizeImmOp SLIT("sar") size imm dst
 946 pprInstr (SHR size imm dst) = pprSizeImmOp SLIT("shr") size imm dst
 947 pprInstr (BT  size imm src) = pprSizeImmOp SLIT("bt")  size imm src
 948
 949 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp")  size src dst
 950 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test")  size src dst
 951 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
 952 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
 953 pprInstr PUSHA = ptext SLIT("\tpushal")
 954 pprInstr POPA = ptext SLIT("\tpopal")
 955
 956 pprInstr (NOP) = ptext SLIT("\tnop")
 957 pprInstr (CLTD) = ptext SLIT("\tcltd")
 958
 959 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
 960
 961 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
 962
 963 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
 964 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
 965 pprInstr (CALL imm)
 966    = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
 967
 968
 969 -- Simulating a flat register set on the x86 FP stack is tricky.
 970 -- you have to free %st(7) before pushing anything on the FP reg stack
 971 -- so as to preclude the possibility of a FP stack overflow exception.
 972 pprInstr g@(GMOV src dst)
 973    | src == dst
 974    = empty
 975    | otherwise
 976    = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
 977
 978 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
 979 pprInstr g@(GLD sz addr dst)
 980  = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
 981                  pprAddr addr, gsemi, gpop dst 1])
 982
 983 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
 984 pprInstr g@(GST sz src addr)
 985  = pprG g (hcat [gtab, gpush src 0, gsemi,
 986                  text "fstp", pprSize sz, gsp, pprAddr addr])
 987
 988 pprInstr g@(GLDZ dst)
 989  = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
 990 pprInstr g@(GLD1 dst)
 991  = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
 992
 993 pprInstr g@(GFTOD src dst)
 994    = pprG g bogus
 995 pprInstr g@(GFTOI src dst)
 996    = pprG g bogus
 997
 998 pprInstr g@(GDTOF src dst)
 999    = pprG g bogus
1000 pprInstr g@(GDTOI src dst)
1001    = pprG g bogus
1002
1003 pprInstr g@(GITOF src dst)
1004    = pprInstr (GITOD src dst)
1005 pprInstr g@(GITOD src dst)
1006    = pprG g (hcat [gtab, text "pushl ", pprReg L src,
1007                    text " ; ffree %st(7); fildl (%esp) ; ",
1008                    gpop dst 1, text " ; addl $4,%esp"])
1009
1010 pprInstr g@(GCMP sz src1 src2)
1011    = pprG g (hcat [gtab, text "pushl %eax ; ",gpush src1 0]
1012              $$
1013              hcat [gtab, text "fcomp ", greg src2 1,
1014                    text "; fstsw %ax ; sahf ; popl %eax"])
1015
1016 pprInstr g@(GABS sz src dst)
1017    = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1018 pprInstr g@(GNEG sz src dst)
1019    = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1020
1021 pprInstr g@(GSQRT sz src dst)
1022    = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1023              hcat [gtab, gcoerceto sz, gpop dst 1])
1024 pprInstr g@(GSIN sz src dst)
1025    = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1026              hcat [gtab, gcoerceto sz, gpop dst 1])
1027 pprInstr g@(GCOS sz src dst)
1028    = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1029              hcat [gtab, gcoerceto sz, gpop dst 1])
1030 pprInstr g@(GTAN sz src dst)
1031    = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1032                    gpush src 0, text " ; fptan ; ",
1033                    text " fstp %st(0)"] $$
1034              hcat [gtab, gcoerceto sz, gpop dst 1])
1035
1036 -- In the translations for GADD, GMUL, GSUB and GDIV,
1037 -- the first two cases are mere optimisations.  The otherwise clause
1038 -- generates correct code under all circumstances.
1039
1040 pprInstr g@(GADD sz src1 src2 dst)
1041    | src1 == dst
1042    = pprG g (text "\t#GADD-xxxcase1" $$
1043              hcat [gtab, gpush src2 0,
1044                    text " ; faddp %st(0),", greg src1 1])
1045    | src2 == dst
1046    = pprG g (text "\t#GADD-xxxcase2" $$
1047              hcat [gtab, gpush src1 0,
1048                    text " ; faddp %st(0),", greg src2 1])
1049    | otherwise
1050    = pprG g (hcat [gtab, gpush src1 0,
1051                    text " ; fadd ", greg src2 1, text ",%st(0)",
1052                    gsemi, gpop dst 1])
1053
1054
1055 pprInstr g@(GMUL sz src1 src2 dst)
1056    | src1 == dst
1057    = pprG g (text "\t#GMUL-xxxcase1" $$
1058              hcat [gtab, gpush src2 0,
1059                    text " ; fmulp %st(0),", greg src1 1])
1060    | src2 == dst
1061    = pprG g (text "\t#GMUL-xxxcase2" $$
1062              hcat [gtab, gpush src1 0,
1063                    text " ; fmulp %st(0),", greg src2 1])
1064    | otherwise
1065    = pprG g (hcat [gtab, gpush src1 0,
1066                    text " ; fmul ", greg src2 1, text ",%st(0)",
1067                    gsemi, gpop dst 1])
1068
1069
1070 pprInstr g@(GSUB sz src1 src2 dst)
1071    | src1 == dst
1072    = pprG g (text "\t#GSUB-xxxcase1" $$
1073              hcat [gtab, gpush src2 0,
1074                    text " ; fsubrp %st(0),", greg src1 1])
1075    | src2 == dst
1076    = pprG g (text "\t#GSUB-xxxcase2" $$
1077              hcat [gtab, gpush src1 0,
1078                    text " ; fsubp %st(0),", greg src2 1])
1079    | otherwise
1080    = pprG g (hcat [gtab, gpush src1 0,
1081                    text " ; fsub ", greg src2 1, text ",%st(0)",
1082                    gsemi, gpop dst 1])
1083
1084
1085 pprInstr g@(GDIV sz src1 src2 dst)
1086    | src1 == dst
1087    = pprG g (text "\t#GDIV-xxxcase1" $$
1088              hcat [gtab, gpush src2 0,
1089                    text " ; fdivrp %st(0),", greg src1 1])
1090    | src2 == dst
1091    = pprG g (text "\t#GDIV-xxxcase2" $$
1092              hcat [gtab, gpush src1 0,
1093                    text " ; fdivp %st(0),", greg src2 1])
1094    | otherwise
1095    = pprG g (hcat [gtab, gpush src1 0,
1096                    text " ; fdiv ", greg src2 1, text ",%st(0)",
1097                    gsemi, gpop dst 1])
1098
1099
1100 pprInstr GFREE
1101    = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1102             ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1103           ]
1104
1105 --------------------------
1106
1107 -- coerce %st(0) to the specified size
1108 gcoerceto DF = empty
1109 gcoerceto  F = text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1110
1111 gpush reg offset
1112    = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1113 gpop reg offset
1114    = hcat [text "fstp ", greg reg offset]
1115
1116 bogus = text "\tbogus"
1117 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1118 gsemi = text " ; "
1119 gtab  = char '\t'
1120 gsp   = char ' '
1121
1122 gregno (RealReg i) = i
1123 gregno other       = --pprPanic "gregno" (ppr other)
1124                      999   -- bogus; only needed for debug printing
1125
1126 pprG :: Instr -> SDoc -> SDoc
1127 pprG fake actual
1128    = (char '#' <> pprGInstr fake) $$ actual
1129
1130 pprGInstr (GMOV src dst)   = pprSizeRegReg SLIT("gmov") DF src dst
1131 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1132 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1133
1134 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") DF dst
1135 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") DF dst
1136
1137 pprGInstr (GFTOD src dst) = pprSizeSizeRegReg SLIT("gftod") F DF src dst
1138 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L  src dst
1139
1140 pprGInstr (GDTOF src dst) = pprSizeSizeRegReg SLIT("gdtof") DF F src dst
1141 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
1142
1143 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F  src dst
1144 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
1145
1146 pprGInstr (GCMP sz src dst) = pprSizeRegReg SLIT("gcmp") sz src dst
1147 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1148 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1149 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1150 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1151 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1152 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1153
1154 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1155 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1156 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1157 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1158 \end{code}
1159
1160 Continue with I386-only printing bits and bobs:
1161 \begin{code}
1162 pprDollImm :: Imm -> SDoc
1163
1164 pprDollImm i =  ptext SLIT("$") <> pprImm i
1165
1166 pprOperand :: Size -> Operand -> SDoc
1167 pprOperand s (OpReg r)   = pprReg s r
1168 pprOperand s (OpImm i)   = pprDollImm i
1169 pprOperand s (OpAddr ea) = pprAddr ea
1170
1171 pprSizeImmOp :: FAST_STRING -> Size -> Imm -> Operand -> SDoc
1172 pprSizeImmOp name size imm op1
1173   = hcat [
1174         char '\t',
1175         ptext name,
1176         pprSize size,
1177         space,
1178         char '$',
1179         pprImm imm,
1180         comma,
1181         pprOperand size op1
1182     ]
1183
1184 pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc
1185 pprSizeOp name size op1
1186   = hcat [
1187         char '\t',
1188         ptext name,
1189         pprSize size,
1190         space,
1191         pprOperand size op1
1192     ]
1193
1194 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1195 pprSizeOpOp name size op1 op2
1196   = hcat [
1197         char '\t',
1198         ptext name,
1199         pprSize size,
1200         space,
1201         pprOperand size op1,
1202         comma,
1203         pprOperand size op2
1204     ]
1205
1206 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1207 pprSizeByteOpOp name size op1 op2
1208   = hcat [
1209         char '\t',
1210         ptext name,
1211         pprSize size,
1212         space,
1213         pprOperand B op1,
1214         comma,
1215         pprOperand size op2
1216     ]
1217
1218 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc
1219 pprSizeOpReg name size op1 reg
1220   = hcat [
1221         char '\t',
1222         ptext name,
1223         pprSize size,
1224         space,
1225         pprOperand size op1,
1226         comma,
1227         pprReg size reg
1228     ]
1229
1230 pprSizeReg :: FAST_STRING -> Size -> Reg -> SDoc
1231 pprSizeReg name size reg1
1232   = hcat [
1233         char '\t',
1234         ptext name,
1235         pprSize size,
1236         space,
1237         pprReg size reg1
1238     ]
1239
1240 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1241 pprSizeRegReg name size reg1 reg2
1242   = hcat [
1243         char '\t',
1244         ptext name,
1245         pprSize size,
1246         space,
1247         pprReg size reg1,
1248         comma,
1249         pprReg size reg2
1250     ]
1251
1252 pprSizeSizeRegReg :: FAST_STRING -> Size -> Size -> Reg -> Reg -> SDoc
1253 pprSizeSizeRegReg name size1 size2 reg1 reg2
1254   = hcat [
1255         char '\t',
1256         ptext name,
1257         pprSize size1,
1258         pprSize size2,
1259         space,
1260         pprReg size1 reg1,
1261         comma,
1262         pprReg size2 reg2
1263     ]
1264
1265 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1266 pprSizeRegRegReg name size reg1 reg2 reg3
1267   = hcat [
1268         char '\t',
1269         ptext name,
1270         pprSize size,
1271         space,
1272         pprReg size reg1,
1273         comma,
1274         pprReg size reg2,
1275         comma,
1276         pprReg size reg3
1277     ]
1278
1279 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
1280 pprSizeAddr name size op
1281   = hcat [
1282         char '\t',
1283         ptext name,
1284         pprSize size,
1285         space,
1286         pprAddr op
1287     ]
1288
1289 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc
1290 pprSizeAddrReg name size op dst
1291   = hcat [
1292         char '\t',
1293         ptext name,
1294         pprSize size,
1295         space,
1296         pprAddr op,
1297         comma,
1298         pprReg size dst
1299     ]
1300
1301 pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> SDoc
1302 pprSizeRegAddr name size src op
1303   = hcat [
1304         char '\t',
1305         ptext name,
1306         pprSize size,
1307         space,
1308         pprReg size src,
1309         comma,
1310         pprAddr op
1311     ]
1312
1313 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1314 pprOpOp name size op1 op2
1315   = hcat [
1316         char '\t',
1317         ptext name, space,
1318         pprOperand size op1,
1319         comma,
1320         pprOperand size op2
1321     ]
1322
1323 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
1324 pprSizeOpOpCoerce name size1 size2 op1 op2
1325   = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1326         pprOperand size1 op1,
1327         comma,
1328         pprOperand size2 op2
1329     ]
1330
1331 pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc
1332 pprCondInstr name cond arg
1333   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1334
1335 #endif {-i386_TARGET_ARCH-}
1336 \end{code}
1337
1338 %************************************************************************
1339 %*                                                                      *
1340 \subsubsection{@pprInstr@ for a SPARC}
1341 %*                                                                      *
1342 %************************************************************************
1343
1344 \begin{code}
1345 #if sparc_TARGET_ARCH
1346
1347 -- a clumsy hack for now, to handle possible double alignment problems
1348
1349 -- even clumsier, to allow for RegReg regs that show when doing indexed
1350 -- reads (bytearrays).
1351 --
1352
1353 -- Translate to the following:
1354 --    add g1,g2,g1
1355 --    ld  [g1],%fn
1356 --    ld  [g1+4],%f(n+1)
1357 --    sub g1,g2,g1           -- to restore g1
1358 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1359   = vcat [
1360        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1361        hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1362        hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1363        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1364     ]
1365
1366 -- Translate to
1367 --    ld  [addr],%fn
1368 --    ld  [addr+4],%f(n+1)
1369 pprInstr (LD DF addr reg) | maybeToBool off_addr
1370   = vcat [
1371        hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1372        hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1373     ]
1374   where
1375     off_addr = addrOffset addr 4
1376     addr2 = case off_addr of Just x -> x
1377
1378
1379 pprInstr (LD size addr reg)
1380   = hcat [
1381        ptext SLIT("\tld"),
1382        pprSize size,
1383        char '\t',
1384        lbrack,
1385        pprAddr addr,
1386        pp_rbracket_comma,
1387        pprReg reg
1388     ]
1389
1390 -- The same clumsy hack as above
1391
1392 -- Translate to the following:
1393 --    add g1,g2,g1
1394 --    st  %fn,[g1]
1395 --    st  %f(n+1),[g1+4]
1396 --    sub g1,g2,g1           -- to restore g1
1397 pprInstr (ST DF reg (AddrRegReg g1 g2))
1398  = vcat [
1399        hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1400        hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1401              pprReg g1, rbrack],
1402        hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1403              pprReg g1, ptext SLIT("+4]")],
1404        hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1405     ]
1406
1407 -- Translate to
1408 --    st  %fn,[addr]
1409 --    st  %f(n+1),[addr+4]
1410 pprInstr (ST DF reg addr) | maybeToBool off_addr
1411  = vcat [
1412       hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1413             pprAddr addr, rbrack],
1414       hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1415             pprAddr addr2, rbrack]
1416     ]
1417   where
1418     off_addr = addrOffset addr 4
1419     addr2 = case off_addr of Just x -> x
1420
1421 -- no distinction is made between signed and unsigned bytes on stores for the
1422 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1423 -- so we call a special-purpose pprSize for ST..
1424
1425 pprInstr (ST size reg addr)
1426   = hcat [
1427        ptext SLIT("\tst"),
1428        pprStSize size,
1429        char '\t',
1430        pprReg reg,
1431        pp_comma_lbracket,
1432        pprAddr addr,
1433        rbrack
1434     ]
1435
1436 pprInstr (ADD x cc reg1 ri reg2)
1437   | not x && not cc && riZero ri
1438   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1439   | otherwise
1440   = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1441
1442 pprInstr (SUB x cc reg1 ri reg2)
1443   | not x && cc && reg2 == g0
1444   = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1445   | not x && not cc && riZero ri
1446   = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1447   | otherwise
1448   = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1449
1450 pprInstr (AND  b reg1 ri reg2) = pprRegRIReg SLIT("and")  b reg1 ri reg2
1451 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1452
1453 pprInstr (OR b reg1 ri reg2)
1454   | not b && reg1 == g0
1455   = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1456   | otherwise
1457   = pprRegRIReg SLIT("or") b reg1 ri reg2
1458
1459 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1460
1461 pprInstr (XOR  b reg1 ri reg2) = pprRegRIReg SLIT("xor")  b reg1 ri reg2
1462 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1463
1464 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1465 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1466 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1467
1468 pprInstr (SETHI imm reg)
1469   = hcat [
1470         ptext SLIT("\tsethi\t"),
1471         pprImm imm,
1472         comma,
1473         pprReg reg
1474     ]
1475
1476 pprInstr NOP = ptext SLIT("\tnop")
1477
1478 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1479 pprInstr (FABS DF reg1 reg2)
1480   = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1481     (if (reg1 == reg2) then empty
1482      else (<>) (char '\n')
1483           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1484
1485 pprInstr (FADD size reg1 reg2 reg3)
1486   = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1487 pprInstr (FCMP e size reg1 reg2)
1488   = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1489 pprInstr (FDIV size reg1 reg2 reg3)
1490   = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1491
1492 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1493 pprInstr (FMOV DF reg1 reg2)
1494   = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1495     (if (reg1 == reg2) then empty
1496      else (<>) (char '\n')
1497           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1498
1499 pprInstr (FMUL size reg1 reg2 reg3)
1500   = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1501
1502 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1503 pprInstr (FNEG DF reg1 reg2)
1504   = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1505     (if (reg1 == reg2) then empty
1506      else (<>) (char '\n')
1507           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1508
1509 pprInstr (FSQRT size reg1 reg2)     = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1510 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1511 pprInstr (FxTOy size1 size2 reg1 reg2)
1512   = hcat [
1513         ptext SLIT("\tf"),
1514         ptext
1515         (case size1 of
1516             W  -> SLIT("ito")
1517             F  -> SLIT("sto")
1518             DF -> SLIT("dto")),
1519         ptext
1520         (case size2 of
1521             W  -> SLIT("i\t")
1522             F  -> SLIT("s\t")
1523             DF -> SLIT("d\t")),
1524         pprReg reg1, comma, pprReg reg2
1525     ]
1526
1527
1528 pprInstr (BI cond b lab)
1529   = hcat [
1530         ptext SLIT("\tb"), pprCond cond,
1531         if b then pp_comma_a else empty,
1532         char '\t',
1533         pprImm lab
1534     ]
1535
1536 pprInstr (BF cond b lab)
1537   = hcat [
1538         ptext SLIT("\tfb"), pprCond cond,
1539         if b then pp_comma_a else empty,
1540         char '\t',
1541         pprImm lab
1542     ]
1543
1544 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1545
1546 pprInstr (CALL imm n _)
1547   = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1548 \end{code}
1549
1550 Continue with SPARC-only printing bits and bobs:
1551 \begin{code}
1552 pprRI :: RI -> SDoc
1553 pprRI (RIReg r) = pprReg r
1554 pprRI (RIImm r) = pprImm r
1555
1556 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1557 pprSizeRegReg name size reg1 reg2
1558   = hcat [
1559         char '\t',
1560         ptext name,
1561         (case size of
1562             F  -> ptext SLIT("s\t")
1563             DF -> ptext SLIT("d\t")),
1564         pprReg reg1,
1565         comma,
1566         pprReg reg2
1567     ]
1568
1569 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1570 pprSizeRegRegReg name size reg1 reg2 reg3
1571   = hcat [
1572         char '\t',
1573         ptext name,
1574         (case size of
1575             F  -> ptext SLIT("s\t")
1576             DF -> ptext SLIT("d\t")),
1577         pprReg reg1,
1578         comma,
1579         pprReg reg2,
1580         comma,
1581         pprReg reg3
1582     ]
1583
1584 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc
1585 pprRegRIReg name b reg1 ri reg2
1586   = hcat [
1587         char '\t',
1588         ptext name,
1589         if b then ptext SLIT("cc\t") else char '\t',
1590         pprReg reg1,
1591         comma,
1592         pprRI ri,
1593         comma,
1594         pprReg reg2
1595     ]
1596
1597 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc
1598 pprRIReg name b ri reg1
1599   = hcat [
1600         char '\t',
1601         ptext name,
1602         if b then ptext SLIT("cc\t") else char '\t',
1603         pprRI ri,
1604         comma,
1605         pprReg reg1
1606     ]
1607
1608 pp_ld_lbracket    = ptext SLIT("\tld\t[")
1609 pp_rbracket_comma = text "],"
1610 pp_comma_lbracket = text ",["
1611 pp_comma_a        = text ",a"
1612
1613 #endif {-sparc_TARGET_ARCH-}
1614 \end{code}