19 #include "nativeGen/NCG.h"
20 #include "HsVersions.h"
24 import Regs -- may differ per-platform
27 import CLabel ( CLabel, pprCLabel, externallyVisibleCLabel,
28 labelDynamic, mkAsmTempLabel, entryLblToInfoLbl )
30 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
31 import CLabel ( mkDeadStripPreventer )
34 import Panic ( panic )
35 import Unique ( pprUnique )
38 import qualified Outputable
39 import Outputable ( Outputable, pprPanic, ppr, docToSDoc)
42 import Data.Word ( Word8 )
43 import Control.Monad.ST
44 import Data.Char ( chr, ord )
45 import Data.Maybe ( isJust )
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)
58 ppr_reg_no :: Int -> Doc
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"
97 pprSize :: Size -> Doc
98 pprSize x = ptext (case x of
101 -- W -> sLit "w" UNUSED
102 -- Wu -> sLit "wu" UNUSED
105 -- FF -> sLit "f" UNUSED
106 -- DF -> sLit "d" UNUSED
107 -- GF -> sLit "g" UNUSED
108 -- SF -> sLit "s" UNUSED
112 pprCond :: Cond -> Doc
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))
132 pprSectionHeader Text
133 = ptext (sLit "\t.text\n\t.align 3")
135 pprSectionHeader Data
136 = ptext (sLit "\t.data\n\t.align 3")
138 pprSectionHeader ReadOnlyData
139 = ptext (sLit "\t.data\n\t.align 3")
141 pprSectionHeader RelocatableReadOnlyData
142 = ptext (sLit "\t.data\n\t.align 3")
144 pprSectionHeader UninitialisedData
145 = ptext (sLit "\t.bss\n\t.align 3")
147 pprSectionHeader ReadOnlyData16
148 = ptext (sLit "\t.data\n\t.align 4")
150 pprSectionHeader (OtherSection sec)
151 = panic "PprMach.pprSectionHeader: unknown section"
154 pprTypeAndSizeDecl :: CLabel -> Doc
155 pprTypeAndSizeDecl lbl
160 pprInstr :: Instr -> Doc
161 pprInstr (COMMENT s) = empty -- nuke 'em
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)))
174 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
176 pprInstr (NEWBLOCK _)
177 = panic "PprMach.pprInstr: NEWBLOCK"
180 = panic "PprMach.pprInstr: LDATA"
182 pprInstr (SPILL reg slot)
184 ptext (sLit "\tSPILL"),
188 ptext (sLit "SLOT") <> parens (int slot)]
190 pprInstr (RELOAD slot reg)
192 ptext (sLit "\tRELOAD"),
194 ptext (sLit "SLOT") <> parens (int slot),
198 pprInstr (LD size reg addr)
208 pprInstr (LDA reg addr)
210 ptext (sLit "\tlda\t"),
216 pprInstr (LDAH reg addr)
218 ptext (sLit "\tldah\t"),
224 pprInstr (LDGP reg addr)
226 ptext (sLit "\tldgp\t"),
232 pprInstr (LDI size reg imm)
234 ptext (sLit "\tldi"),
242 pprInstr (ST size reg addr)
254 ptext (sLit "\tclr\t"),
258 pprInstr (ABS size ri reg)
260 ptext (sLit "\tabs"),
268 pprInstr (NEG size ov ri reg)
270 ptext (sLit "\tneg"),
272 if ov then ptext (sLit "v\t") else char '\t',
278 pprInstr (ADD size ov reg1 ri reg2)
280 ptext (sLit "\tadd"),
282 if ov then ptext (sLit "v\t") else char '\t',
290 pprInstr (SADD size scale reg1 ri reg2)
292 ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
303 pprInstr (SUB size ov reg1 ri reg2)
305 ptext (sLit "\tsub"),
307 if ov then ptext (sLit "v\t") else char '\t',
315 pprInstr (SSUB size scale reg1 ri reg2)
317 ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
328 pprInstr (MUL size ov reg1 ri reg2)
330 ptext (sLit "\tmul"),
332 if ov then ptext (sLit "v\t") else char '\t',
340 pprInstr (DIV size uns reg1 ri reg2)
342 ptext (sLit "\tdiv"),
344 if uns then ptext (sLit "u\t") else char '\t',
352 pprInstr (REM size uns reg1 ri reg2)
354 ptext (sLit "\trem"),
356 if uns then ptext (sLit "u\t") else char '\t',
364 pprInstr (NOT ri reg)
366 ptext (sLit "\tnot"),
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
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
384 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg (sLit "zap") reg1 ri reg2
385 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg (sLit "zapnot") reg1 ri reg2
387 pprInstr (NOP) = ptext (sLit "\tnop")
389 pprInstr (CMP cond reg1 ri reg2)
391 ptext (sLit "\tcmp"),
403 ptext (sLit "\tfclr\t"),
407 pprInstr (FABS reg1 reg2)
409 ptext (sLit "\tfabs\t"),
415 pprInstr (FNEG size reg1 reg2)
417 ptext (sLit "\tneg"),
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
430 pprInstr (CVTxy size1 size2 reg1 reg2)
432 ptext (sLit "\tcvt"),
434 case size2 of {Q -> ptext (sLit "qc"); _ -> pprSize size2},
441 pprInstr (FCMP size cond reg1 reg2 reg3)
443 ptext (sLit "\tcmp"),
454 pprInstr (FMOV reg1 reg2)
456 ptext (sLit "\tfmov\t"),
462 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
464 pprInstr (BI NEVER reg lab) = empty
466 pprInstr (BI cond reg lab)
476 pprInstr (BF cond reg lab)
487 = (<>) (ptext (sLit "\tbr\t")) (pprImm lab)
489 pprInstr (JMP reg addr hint)
491 ptext (sLit "\tjmp\t"),
500 = (<>) (ptext (sLit "\tbsr\t")) (pprImm imm)
502 pprInstr (JSR reg addr n)
504 ptext (sLit "\tjsr\t"),
510 pprInstr (FUNBEGIN clab)
512 if (externallyVisibleCLabel clab) then
513 hcat [ptext (sLit "\t.globl\t"), pp_lab, char '\n']
516 ptext (sLit "\t.ent "),
525 pp_lab = pprCLabel_asm clab
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") ]
534 pprInstr (FUNEND clab)
535 = (<>) (ptext (sLit "\t.align 4\n\t.end ")) (pprCLabel_asm clab)
540 pprRI (RIReg r) = pprReg r
541 pprRI (RIImm r) = pprImm r
543 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
544 pprRegRIReg name reg1 ri reg2
556 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
557 pprSizeRegRegReg name size reg1 reg2 reg3