compiler/nativeGen/Alpha/Ppr.hs-old

   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
 162 pprInstr (DELTA d)
 163    = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
 164
 165 pprInstr (NEWBLOCK _)
 166    = panic "PprMach.pprInstr: NEWBLOCK"
 167
 168 pprInstr (LDATA _ _)
 169    = panic "PprMach.pprInstr: LDATA"
 170
 171 pprInstr (SPILL reg slot)
 172    = hcat [
 173         ptext (sLit "\tSPILL"),
 174         char '\t',
 175         pprReg reg,
 176         comma,
 177         ptext (sLit "SLOT") <> parens (int slot)]
 178
 179 pprInstr (RELOAD slot reg)
 180    = hcat [
 181         ptext (sLit "\tRELOAD"),
 182         char '\t',
 183         ptext (sLit "SLOT") <> parens (int slot),
 184         comma,
 185         pprReg reg]
 186
 187 pprInstr (LD size reg addr)
 188   = hcat [
 189         ptext (sLit "\tld"),
 190         pprSize size,
 191         char '\t',
 192         pprReg reg,
 193         comma,
 194         pprAddr addr
 195     ]
 196
 197 pprInstr (LDA reg addr)
 198   = hcat [
 199         ptext (sLit "\tlda\t"),
 200         pprReg reg,
 201         comma,
 202         pprAddr addr
 203     ]
 204
 205 pprInstr (LDAH reg addr)
 206   = hcat [
 207         ptext (sLit "\tldah\t"),
 208         pprReg reg,
 209         comma,
 210         pprAddr addr
 211     ]
 212
 213 pprInstr (LDGP reg addr)
 214   = hcat [
 215         ptext (sLit "\tldgp\t"),
 216         pprReg reg,
 217         comma,
 218         pprAddr addr
 219     ]
 220
 221 pprInstr (LDI size reg imm)
 222   = hcat [
 223         ptext (sLit "\tldi"),
 224         pprSize size,
 225         char '\t',
 226         pprReg reg,
 227         comma,
 228         pprImm imm
 229     ]
 230
 231 pprInstr (ST size reg addr)
 232   = hcat [
 233         ptext (sLit "\tst"),
 234         pprSize size,
 235         char '\t',
 236         pprReg reg,
 237         comma,
 238         pprAddr addr
 239     ]
 240
 241 pprInstr (CLR reg)
 242   = hcat [
 243         ptext (sLit "\tclr\t"),
 244         pprReg reg
 245     ]
 246
 247 pprInstr (ABS size ri reg)
 248   = hcat [
 249         ptext (sLit "\tabs"),
 250         pprSize size,
 251         char '\t',
 252         pprRI ri,
 253         comma,
 254         pprReg reg
 255     ]
 256
 257 pprInstr (NEG size ov ri reg)
 258   = hcat [
 259         ptext (sLit "\tneg"),
 260         pprSize size,
 261         if ov then ptext (sLit "v\t") else char '\t',
 262         pprRI ri,
 263         comma,
 264         pprReg reg
 265     ]
 266
 267 pprInstr (ADD size ov reg1 ri reg2)
 268   = hcat [
 269         ptext (sLit "\tadd"),
 270         pprSize size,
 271         if ov then ptext (sLit "v\t") else char '\t',
 272         pprReg reg1,
 273         comma,
 274         pprRI ri,
 275         comma,
 276         pprReg reg2
 277     ]
 278
 279 pprInstr (SADD size scale reg1 ri reg2)
 280   = hcat [
 281         ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
 282         ptext (sLit "add"),
 283         pprSize size,
 284         char '\t',
 285         pprReg reg1,
 286         comma,
 287         pprRI ri,
 288         comma,
 289         pprReg reg2
 290     ]
 291
 292 pprInstr (SUB size ov reg1 ri reg2)
 293   = hcat [
 294         ptext (sLit "\tsub"),
 295         pprSize size,
 296         if ov then ptext (sLit "v\t") else char '\t',
 297         pprReg reg1,
 298         comma,
 299         pprRI ri,
 300         comma,
 301         pprReg reg2
 302     ]
 303
 304 pprInstr (SSUB size scale reg1 ri reg2)
 305   = hcat [
 306         ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
 307         ptext (sLit "sub"),
 308         pprSize size,
 309         char '\t',
 310         pprReg reg1,
 311         comma,
 312         pprRI ri,
 313         comma,
 314         pprReg reg2
 315     ]
 316
 317 pprInstr (MUL size ov reg1 ri reg2)
 318   = hcat [
 319         ptext (sLit "\tmul"),
 320         pprSize size,
 321         if ov then ptext (sLit "v\t") else char '\t',
 322         pprReg reg1,
 323         comma,
 324         pprRI ri,
 325         comma,
 326         pprReg reg2
 327     ]
 328
 329 pprInstr (DIV size uns reg1 ri reg2)
 330   = hcat [
 331         ptext (sLit "\tdiv"),
 332         pprSize size,
 333         if uns then ptext (sLit "u\t") else char '\t',
 334         pprReg reg1,
 335         comma,
 336         pprRI ri,
 337         comma,
 338         pprReg reg2
 339     ]
 340
 341 pprInstr (REM size uns reg1 ri reg2)
 342   = hcat [
 343         ptext (sLit "\trem"),
 344         pprSize size,
 345         if uns then ptext (sLit "u\t") else char '\t',
 346         pprReg reg1,
 347         comma,
 348         pprRI ri,
 349         comma,
 350         pprReg reg2
 351     ]
 352
 353 pprInstr (NOT ri reg)
 354   = hcat [
 355         ptext (sLit "\tnot"),
 356         char '\t',
 357         pprRI ri,
 358         comma,
 359         pprReg reg
 360     ]
 361
 362 pprInstr (AND reg1 ri reg2) = pprRegRIReg (sLit "and") reg1 ri reg2
 363 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg (sLit "andnot") reg1 ri reg2
 364 pprInstr (OR reg1 ri reg2) = pprRegRIReg (sLit "or") reg1 ri reg2
 365 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg (sLit "ornot") reg1 ri reg2
 366 pprInstr (XOR reg1 ri reg2) = pprRegRIReg (sLit "xor") reg1 ri reg2
 367 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg (sLit "xornot") reg1 ri reg2
 368
 369 pprInstr (SLL reg1 ri reg2) = pprRegRIReg (sLit "sll") reg1 ri reg2
 370 pprInstr (SRL reg1 ri reg2) = pprRegRIReg (sLit "srl") reg1 ri reg2
 371 pprInstr (SRA reg1 ri reg2) = pprRegRIReg (sLit "sra") reg1 ri reg2
 372
 373 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg (sLit "zap") reg1 ri reg2
 374 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg (sLit "zapnot") reg1 ri reg2
 375
 376 pprInstr (NOP) = ptext (sLit "\tnop")
 377
 378 pprInstr (CMP cond reg1 ri reg2)
 379   = hcat [
 380         ptext (sLit "\tcmp"),
 381         pprCond cond,
 382         char '\t',
 383         pprReg reg1,
 384         comma,
 385         pprRI ri,
 386         comma,
 387         pprReg reg2
 388     ]
 389
 390 pprInstr (FCLR reg)
 391   = hcat [
 392         ptext (sLit "\tfclr\t"),
 393         pprReg reg
 394     ]
 395
 396 pprInstr (FABS reg1 reg2)
 397   = hcat [
 398         ptext (sLit "\tfabs\t"),
 399         pprReg reg1,
 400         comma,
 401         pprReg reg2
 402     ]
 403
 404 pprInstr (FNEG size reg1 reg2)
 405   = hcat [
 406         ptext (sLit "\tneg"),
 407         pprSize size,
 408         char '\t',
 409         pprReg reg1,
 410         comma,
 411         pprReg reg2
 412     ]
 413
 414 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "add") size reg1 reg2 reg3
 415 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "div") size reg1 reg2 reg3
 416 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "mul") size reg1 reg2 reg3
 417 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "sub") size reg1 reg2 reg3
 418
 419 pprInstr (CVTxy size1 size2 reg1 reg2)
 420   = hcat [
 421         ptext (sLit "\tcvt"),
 422         pprSize size1,
 423         case size2 of {Q -> ptext (sLit "qc"); _ -> pprSize size2},
 424         char '\t',
 425         pprReg reg1,
 426         comma,
 427         pprReg reg2
 428     ]
 429
 430 pprInstr (FCMP size cond reg1 reg2 reg3)
 431   = hcat [
 432         ptext (sLit "\tcmp"),
 433         pprSize size,
 434         pprCond cond,
 435         char '\t',
 436         pprReg reg1,
 437         comma,
 438         pprReg reg2,
 439         comma,
 440         pprReg reg3
 441     ]
 442
 443 pprInstr (FMOV reg1 reg2)
 444   = hcat [
 445         ptext (sLit "\tfmov\t"),
 446         pprReg reg1,
 447         comma,
 448         pprReg reg2
 449     ]
 450
 451 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
 452
 453 pprInstr (BI NEVER reg lab) = empty
 454
 455 pprInstr (BI cond reg lab)
 456   = hcat [
 457         ptext (sLit "\tb"),
 458         pprCond cond,
 459         char '\t',
 460         pprReg reg,
 461         comma,
 462         pprImm lab
 463     ]
 464
 465 pprInstr (BF cond reg lab)
 466   = hcat [
 467         ptext (sLit "\tfb"),
 468         pprCond cond,
 469         char '\t',
 470         pprReg reg,
 471         comma,
 472         pprImm lab
 473     ]
 474
 475 pprInstr (BR lab)
 476   = (<>) (ptext (sLit "\tbr\t")) (pprImm lab)
 477
 478 pprInstr (JMP reg addr hint)
 479   = hcat [
 480         ptext (sLit "\tjmp\t"),
 481         pprReg reg,
 482         comma,
 483         pprAddr addr,
 484         comma,
 485         int hint
 486     ]
 487
 488 pprInstr (BSR imm n)
 489   = (<>) (ptext (sLit "\tbsr\t")) (pprImm imm)
 490
 491 pprInstr (JSR reg addr n)
 492   = hcat [
 493         ptext (sLit "\tjsr\t"),
 494         pprReg reg,
 495         comma,
 496         pprAddr addr
 497     ]
 498
 499 pprInstr (FUNBEGIN clab)
 500   = hcat [
 501         if (externallyVisibleCLabel clab) then
 502             hcat [ptext (sLit "\t.globl\t"), pp_lab, char '\n']
 503         else
 504             empty,
 505         ptext (sLit "\t.ent "),
 506         pp_lab,
 507         char '\n',
 508         pp_lab,
 509         pp_ldgp,
 510         pp_lab,
 511         pp_frame
 512     ]
 513     where
 514         pp_lab = pprCLabel_asm clab
 515
 516         -- NEVER use commas within those string literals, cpp will ruin your day
 517         pp_ldgp  = hcat [ ptext (sLit ":\n\tldgp $29"), char ',', ptext (sLit "0($27)\n") ]
 518         pp_frame = hcat [ ptext (sLit "..ng:\n\t.frame $30"), char ',',
 519                           ptext (sLit "4240"), char ',',
 520                           ptext (sLit "$26"), char ',',
 521                           ptext (sLit "0\n\t.prologue 1") ]
 522
 523 pprInstr (FUNEND clab)
 524   = (<>) (ptext (sLit "\t.align 4\n\t.end ")) (pprCLabel_asm clab)
 525
 526
 527 pprRI :: RI -> Doc
 528
 529 pprRI (RIReg r) = pprReg r
 530 pprRI (RIImm r) = pprImm r
 531
 532 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
 533 pprRegRIReg name reg1 ri reg2
 534   = hcat [
 535         char '\t',
 536         ptext name,
 537         char '\t',
 538         pprReg reg1,
 539         comma,
 540         pprRI ri,
 541         comma,
 542         pprReg reg2
 543     ]
 544
 545 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
 546 pprSizeRegRegReg name size reg1 reg2 reg3
 547   = hcat [
 548         char '\t',
 549         ptext name,
 550         pprSize size,
 551         char '\t',
 552         pprReg reg1,
 553         comma,
 554         pprReg reg2,
 555         comma,
 556         pprReg reg3
 557     ]
 558
 559 -}
 560
 561
 562