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