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