compiler/nativeGen/Alpha/Ppr.hs

   1
   2 module Alpha.Ppr (
   3 {-
   4         pprReg,
   5         pprSize,
   6         pprCond,
   7         pprAddr,
   8         pprSectionHeader,
   9         pprTypeAndSizeDecl,
  10         pprRI,
  11         pprRegRIReg,
  12         pprSizeRegRegReg
  13 -}
  14 )
  15
  16 where
  17
  18 {-
  19 #include "nativeGen/NCG.h"
  20 #include "HsVersions.h"
  21
  22 import BlockId
  23 import Cmm
  24 import Regs             -- may differ per-platform
  25 import Instrs
  26
  27 import CLabel           ( CLabel, pprCLabel, externallyVisibleCLabel,
  28                           labelDynamic, mkAsmTempLabel, entryLblToInfoLbl )
  29
  30 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
  31 import CLabel       ( mkDeadStripPreventer )
  32 #endif
  33
  34 import Panic            ( panic )
  35 import Unique           ( pprUnique )
  36 import Pretty
  37 import FastString
  38 import qualified Outputable
  39 import Outputable       ( Outputable, pprPanic, ppr, docToSDoc)
  40
  41 import Data.Array.ST
  42 import Data.Word        ( Word8 )
  43 import Control.Monad.ST
  44 import Data.Char        ( chr, ord )
  45 import Data.Maybe       ( isJust )
  46
  47
  48
  49 pprReg :: Reg -> Doc
  50 pprReg r
  51   = case r of
  52       RealReg i      -> ppr_reg_no i
  53       VirtualRegI  u  -> text "%vI_"  <> asmSDoc (pprUnique u)
  54       VirtualRegHi u  -> text "%vHi_" <> asmSDoc (pprUnique u)
  55       VirtualRegF  u  -> text "%vF_"  <> asmSDoc (pprUnique u)
  56       VirtualRegD  u  -> text "%vD_"  <> asmSDoc (pprUnique u)
  57   where
  58     ppr_reg_no :: Int -> Doc
  59     ppr_reg_no i = ptext
  60       (case i of {
  61          0 -> sLit "$0";    1 -> sLit "$1";
  62          2 -> sLit "$2";    3 -> sLit "$3";
  63          4 -> sLit "$4";    5 -> sLit "$5";
  64          6 -> sLit "$6";    7 -> sLit "$7";
  65          8 -> sLit "$8";    9 -> sLit "$9";
  66         10 -> sLit "$10";  11 -> sLit "$11";
  67         12 -> sLit "$12";  13 -> sLit "$13";
  68         14 -> sLit "$14";  15 -> sLit "$15";
  69         16 -> sLit "$16";  17 -> sLit "$17";
  70         18 -> sLit "$18";  19 -> sLit "$19";
  71         20 -> sLit "$20";  21 -> sLit "$21";
  72         22 -> sLit "$22";  23 -> sLit "$23";
  73         24 -> sLit "$24";  25 -> sLit "$25";
  74         26 -> sLit "$26";  27 -> sLit "$27";
  75         28 -> sLit "$28";  29 -> sLit "$29";
  76         30 -> sLit "$30";  31 -> sLit "$31";
  77         32 -> sLit "$f0";  33 -> sLit "$f1";
  78         34 -> sLit "$f2";  35 -> sLit "$f3";
  79         36 -> sLit "$f4";  37 -> sLit "$f5";
  80         38 -> sLit "$f6";  39 -> sLit "$f7";
  81         40 -> sLit "$f8";  41 -> sLit "$f9";
  82         42 -> sLit "$f10"; 43 -> sLit "$f11";
  83         44 -> sLit "$f12"; 45 -> sLit "$f13";
  84         46 -> sLit "$f14"; 47 -> sLit "$f15";
  85         48 -> sLit "$f16"; 49 -> sLit "$f17";
  86         50 -> sLit "$f18"; 51 -> sLit "$f19";
  87         52 -> sLit "$f20"; 53 -> sLit "$f21";
  88         54 -> sLit "$f22"; 55 -> sLit "$f23";
  89         56 -> sLit "$f24"; 57 -> sLit "$f25";
  90         58 -> sLit "$f26"; 59 -> sLit "$f27";
  91         60 -> sLit "$f28"; 61 -> sLit "$f29";
  92         62 -> sLit "$f30"; 63 -> sLit "$f31";
  93         _  -> sLit "very naughty alpha register"
  94       })
  95
  96
  97 pprSize :: Size -> Doc
  98 pprSize x = ptext (case x of
  99          B  -> sLit "b"
 100          Bu -> sLit "bu"
 101 --       W  -> sLit "w" UNUSED
 102 --       Wu -> sLit "wu" UNUSED
 103          L  -> sLit "l"
 104          Q  -> sLit "q"
 105 --       FF -> sLit "f" UNUSED
 106 --       DF -> sLit "d" UNUSED
 107 --       GF -> sLit "g" UNUSED
 108 --       SF -> sLit "s" UNUSED
 109          TF -> sLit "t"
 110
 111
 112 pprCond :: Cond -> Doc
 113 pprCond c
 114  = ptext (case c of
 115                 EQQ  -> sLit "eq"
 116                 LTT  -> sLit "lt"
 117                 LE  -> sLit "le"
 118                 ULT -> sLit "ult"
 119                 ULE -> sLit "ule"
 120                 NE  -> sLit "ne"
 121                 GTT  -> sLit "gt"
 122                 GE  -> sLit "ge")
 123
 124
 125 pprAddr :: AddrMode -> Doc
 126 pprAddr (AddrReg r) = parens (pprReg r)
 127 pprAddr (AddrImm i) = pprImm i
 128 pprAddr (AddrRegImm r1 i)
 129   = (<>) (pprImm i) (parens (pprReg r1))
 130
 131
 132 pprSectionHeader Text
 133     = ptext     (sLit "\t.text\n\t.align 3")
 134
 135 pprSectionHeader Data
 136     = ptext     (sLit "\t.data\n\t.align 3")
 137
 138 pprSectionHeader ReadOnlyData
 139     = ptext     (sLit "\t.data\n\t.align 3")
 140
 141 pprSectionHeader RelocatableReadOnlyData
 142     = ptext     (sLit "\t.data\n\t.align 3")
 143
 144 pprSectionHeader UninitialisedData
 145     = ptext     (sLit "\t.bss\n\t.align 3")
 146
 147 pprSectionHeader ReadOnlyData16
 148     = ptext     (sLit "\t.data\n\t.align 4")
 149
 150 pprSectionHeader (OtherSection sec)
 151     = panic "PprMach.pprSectionHeader: unknown section"
 152
 153
 154 pprTypeAndSizeDecl :: CLabel -> Doc
 155 pprTypeAndSizeDecl lbl
 156   = empty
 157
 158
 159
 160 pprInstr :: Instr -> Doc
 161 pprInstr (COMMENT s) = empty -- nuke 'em
 162 {-
 163 pprInstr (COMMENT s)
 164    =  IF_ARCH_alpha( ((<>) (ptext (sLit "\t# ")) (ftext s))
 165      ,IF_ARCH_sparc( ((<>) (ptext (sLit "# "))   (ftext s))
 166      ,IF_ARCH_i386( ((<>) (ptext (sLit "# "))   (ftext s))
 167      ,IF_ARCH_x86_64( ((<>) (ptext (sLit "# "))   (ftext s))
 168      ,IF_ARCH_powerpc( IF_OS_linux(
 169         ((<>) (ptext (sLit "# ")) (ftext s)),
 170         ((<>) (ptext (sLit "; ")) (ftext s)))
 171      ,)))))
 172 -}
 173 pprInstr (DELTA d)
 174    = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
 175
 176 pprInstr (NEWBLOCK _)
 177    = panic "PprMach.pprInstr: NEWBLOCK"
 178
 179 pprInstr (LDATA _ _)
 180    = panic "PprMach.pprInstr: LDATA"
 181
 182 pprInstr (SPILL reg slot)
 183    = hcat [
 184         ptext (sLit "\tSPILL"),
 185         char '\t',
 186         pprReg reg,
 187         comma,
 188         ptext (sLit "SLOT") <> parens (int slot)]
 189
 190 pprInstr (RELOAD slot reg)
 191    = hcat [
 192         ptext (sLit "\tRELOAD"),
 193         char '\t',
 194         ptext (sLit "SLOT") <> parens (int slot),
 195         comma,
 196         pprReg reg]
 197
 198 pprInstr (LD size reg addr)
 199   = hcat [
 200         ptext (sLit "\tld"),
 201         pprSize size,
 202         char '\t',
 203         pprReg reg,
 204         comma,
 205         pprAddr addr
 206     ]
 207
 208 pprInstr (LDA reg addr)
 209   = hcat [
 210         ptext (sLit "\tlda\t"),
 211         pprReg reg,
 212         comma,
 213         pprAddr addr
 214     ]
 215
 216 pprInstr (LDAH reg addr)
 217   = hcat [
 218         ptext (sLit "\tldah\t"),
 219         pprReg reg,
 220         comma,
 221         pprAddr addr
 222     ]
 223
 224 pprInstr (LDGP reg addr)
 225   = hcat [
 226         ptext (sLit "\tldgp\t"),
 227         pprReg reg,
 228         comma,
 229         pprAddr addr
 230     ]
 231
 232 pprInstr (LDI size reg imm)
 233   = hcat [
 234         ptext (sLit "\tldi"),
 235         pprSize size,
 236         char '\t',
 237         pprReg reg,
 238         comma,
 239         pprImm imm
 240     ]
 241
 242 pprInstr (ST size reg addr)
 243   = hcat [
 244         ptext (sLit "\tst"),
 245         pprSize size,
 246         char '\t',
 247         pprReg reg,
 248         comma,
 249         pprAddr addr
 250     ]
 251
 252 pprInstr (CLR reg)
 253   = hcat [
 254         ptext (sLit "\tclr\t"),
 255         pprReg reg
 256     ]
 257
 258 pprInstr (ABS size ri reg)
 259   = hcat [
 260         ptext (sLit "\tabs"),
 261         pprSize size,
 262         char '\t',
 263         pprRI ri,
 264         comma,
 265         pprReg reg
 266     ]
 267
 268 pprInstr (NEG size ov ri reg)
 269   = hcat [
 270         ptext (sLit "\tneg"),
 271         pprSize size,
 272         if ov then ptext (sLit "v\t") else char '\t',
 273         pprRI ri,
 274         comma,
 275         pprReg reg
 276     ]
 277
 278 pprInstr (ADD size ov reg1 ri reg2)
 279   = hcat [
 280         ptext (sLit "\tadd"),
 281         pprSize size,
 282         if ov then ptext (sLit "v\t") else char '\t',
 283         pprReg reg1,
 284         comma,
 285         pprRI ri,
 286         comma,
 287         pprReg reg2
 288     ]
 289
 290 pprInstr (SADD size scale reg1 ri reg2)
 291   = hcat [
 292         ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
 293         ptext (sLit "add"),
 294         pprSize size,
 295         char '\t',
 296         pprReg reg1,
 297         comma,
 298         pprRI ri,
 299         comma,
 300         pprReg reg2
 301     ]
 302
 303 pprInstr (SUB size ov reg1 ri reg2)
 304   = hcat [
 305         ptext (sLit "\tsub"),
 306         pprSize size,
 307         if ov then ptext (sLit "v\t") else char '\t',
 308         pprReg reg1,
 309         comma,
 310         pprRI ri,
 311         comma,
 312         pprReg reg2
 313     ]
 314
 315 pprInstr (SSUB size scale reg1 ri reg2)
 316   = hcat [
 317         ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
 318         ptext (sLit "sub"),
 319         pprSize size,
 320         char '\t',
 321         pprReg reg1,
 322         comma,
 323         pprRI ri,
 324         comma,
 325         pprReg reg2
 326     ]
 327
 328 pprInstr (MUL size ov reg1 ri reg2)
 329   = hcat [
 330         ptext (sLit "\tmul"),
 331         pprSize size,
 332         if ov then ptext (sLit "v\t") else char '\t',
 333         pprReg reg1,
 334         comma,
 335         pprRI ri,
 336         comma,
 337         pprReg reg2
 338     ]
 339
 340 pprInstr (DIV size uns reg1 ri reg2)
 341   = hcat [
 342         ptext (sLit "\tdiv"),
 343         pprSize size,
 344         if uns then ptext (sLit "u\t") else char '\t',
 345         pprReg reg1,
 346         comma,
 347         pprRI ri,
 348         comma,
 349         pprReg reg2
 350     ]
 351
 352 pprInstr (REM size uns reg1 ri reg2)
 353   = hcat [
 354         ptext (sLit "\trem"),
 355         pprSize size,
 356         if uns then ptext (sLit "u\t") else char '\t',
 357         pprReg reg1,
 358         comma,
 359         pprRI ri,
 360         comma,
 361         pprReg reg2
 362     ]
 363
 364 pprInstr (NOT ri reg)
 365   = hcat [
 366         ptext (sLit "\tnot"),
 367         char '\t',
 368         pprRI ri,
 369         comma,
 370         pprReg reg
 371     ]
 372
 373 pprInstr (AND reg1 ri reg2) = pprRegRIReg (sLit "and") reg1 ri reg2
 374 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg (sLit "andnot") reg1 ri reg2
 375 pprInstr (OR reg1 ri reg2) = pprRegRIReg (sLit "or") reg1 ri reg2
 376 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg (sLit "ornot") reg1 ri reg2
 377 pprInstr (XOR reg1 ri reg2) = pprRegRIReg (sLit "xor") reg1 ri reg2
 378 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg (sLit "xornot") reg1 ri reg2
 379
 380 pprInstr (SLL reg1 ri reg2) = pprRegRIReg (sLit "sll") reg1 ri reg2
 381 pprInstr (SRL reg1 ri reg2) = pprRegRIReg (sLit "srl") reg1 ri reg2
 382 pprInstr (SRA reg1 ri reg2) = pprRegRIReg (sLit "sra") reg1 ri reg2
 383
 384 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg (sLit "zap") reg1 ri reg2
 385 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg (sLit "zapnot") reg1 ri reg2
 386
 387 pprInstr (NOP) = ptext (sLit "\tnop")
 388
 389 pprInstr (CMP cond reg1 ri reg2)
 390   = hcat [
 391         ptext (sLit "\tcmp"),
 392         pprCond cond,
 393         char '\t',
 394         pprReg reg1,
 395         comma,
 396         pprRI ri,
 397         comma,
 398         pprReg reg2
 399     ]
 400
 401 pprInstr (FCLR reg)
 402   = hcat [
 403         ptext (sLit "\tfclr\t"),
 404         pprReg reg
 405     ]
 406
 407 pprInstr (FABS reg1 reg2)
 408   = hcat [
 409         ptext (sLit "\tfabs\t"),
 410         pprReg reg1,
 411         comma,
 412         pprReg reg2
 413     ]
 414
 415 pprInstr (FNEG size reg1 reg2)
 416   = hcat [
 417         ptext (sLit "\tneg"),
 418         pprSize size,
 419         char '\t',
 420         pprReg reg1,
 421         comma,
 422         pprReg reg2
 423     ]
 424
 425 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "add") size reg1 reg2 reg3
 426 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "div") size reg1 reg2 reg3
 427 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "mul") size reg1 reg2 reg3
 428 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "sub") size reg1 reg2 reg3
 429
 430 pprInstr (CVTxy size1 size2 reg1 reg2)
 431   = hcat [
 432         ptext (sLit "\tcvt"),
 433         pprSize size1,
 434         case size2 of {Q -> ptext (sLit "qc"); _ -> pprSize size2},
 435         char '\t',
 436         pprReg reg1,
 437         comma,
 438         pprReg reg2
 439     ]
 440
 441 pprInstr (FCMP size cond reg1 reg2 reg3)
 442   = hcat [
 443         ptext (sLit "\tcmp"),
 444         pprSize size,
 445         pprCond cond,
 446         char '\t',
 447         pprReg reg1,
 448         comma,
 449         pprReg reg2,
 450         comma,
 451         pprReg reg3
 452     ]
 453
 454 pprInstr (FMOV reg1 reg2)
 455   = hcat [
 456         ptext (sLit "\tfmov\t"),
 457         pprReg reg1,
 458         comma,
 459         pprReg reg2
 460     ]
 461
 462 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
 463
 464 pprInstr (BI NEVER reg lab) = empty
 465
 466 pprInstr (BI cond reg lab)
 467   = hcat [
 468         ptext (sLit "\tb"),
 469         pprCond cond,
 470         char '\t',
 471         pprReg reg,
 472         comma,
 473         pprImm lab
 474     ]
 475
 476 pprInstr (BF cond reg lab)
 477   = hcat [
 478         ptext (sLit "\tfb"),
 479         pprCond cond,
 480         char '\t',
 481         pprReg reg,
 482         comma,
 483         pprImm lab
 484     ]
 485
 486 pprInstr (BR lab)
 487   = (<>) (ptext (sLit "\tbr\t")) (pprImm lab)
 488
 489 pprInstr (JMP reg addr hint)
 490   = hcat [
 491         ptext (sLit "\tjmp\t"),
 492         pprReg reg,
 493         comma,
 494         pprAddr addr,
 495         comma,
 496         int hint
 497     ]
 498
 499 pprInstr (BSR imm n)
 500   = (<>) (ptext (sLit "\tbsr\t")) (pprImm imm)
 501
 502 pprInstr (JSR reg addr n)
 503   = hcat [
 504         ptext (sLit "\tjsr\t"),
 505         pprReg reg,
 506         comma,
 507         pprAddr addr
 508     ]
 509
 510 pprInstr (FUNBEGIN clab)
 511   = hcat [
 512         if (externallyVisibleCLabel clab) then
 513             hcat [ptext (sLit "\t.globl\t"), pp_lab, char '\n']
 514         else
 515             empty,
 516         ptext (sLit "\t.ent "),
 517         pp_lab,
 518         char '\n',
 519         pp_lab,
 520         pp_ldgp,
 521         pp_lab,
 522         pp_frame
 523     ]
 524     where
 525         pp_lab = pprCLabel_asm clab
 526
 527         -- NEVER use commas within those string literals, cpp will ruin your day
 528         pp_ldgp  = hcat [ ptext (sLit ":\n\tldgp $29"), char ',', ptext (sLit "0($27)\n") ]
 529         pp_frame = hcat [ ptext (sLit "..ng:\n\t.frame $30"), char ',',
 530                           ptext (sLit "4240"), char ',',
 531                           ptext (sLit "$26"), char ',',
 532                           ptext (sLit "0\n\t.prologue 1") ]
 533
 534 pprInstr (FUNEND clab)
 535   = (<>) (ptext (sLit "\t.align 4\n\t.end ")) (pprCLabel_asm clab)
 536
 537
 538 pprRI :: RI -> Doc
 539
 540 pprRI (RIReg r) = pprReg r
 541 pprRI (RIImm r) = pprImm r
 542
 543 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
 544 pprRegRIReg name reg1 ri reg2
 545   = hcat [
 546         char '\t',
 547         ptext name,
 548         char '\t',
 549         pprReg reg1,
 550         comma,
 551         pprRI ri,
 552         comma,
 553         pprReg reg2
 554     ]
 555
 556 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
 557 pprSizeRegRegReg name size reg1 reg2 reg3
 558   = hcat [
 559         char '\t',
 560         ptext name,
 561         pprSize size,
 562         char '\t',
 563         pprReg reg1,
 564         comma,
 565         pprReg reg2,
 566         comma,
 567         pprReg reg3
 568     ]
 569
 570 -}