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
163 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
165 pprInstr (NEWBLOCK _)
166 = panic "PprMach.pprInstr: NEWBLOCK"
169 = panic "PprMach.pprInstr: LDATA"
171 pprInstr (SPILL reg slot)
173 ptext (sLit "\tSPILL"),
177 ptext (sLit "SLOT") <> parens (int slot)]
179 pprInstr (RELOAD slot reg)
181 ptext (sLit "\tRELOAD"),
183 ptext (sLit "SLOT") <> parens (int slot),
187 pprInstr (LD size reg addr)
197 pprInstr (LDA reg addr)
199 ptext (sLit "\tlda\t"),
205 pprInstr (LDAH reg addr)
207 ptext (sLit "\tldah\t"),
213 pprInstr (LDGP reg addr)
215 ptext (sLit "\tldgp\t"),
221 pprInstr (LDI size reg imm)
223 ptext (sLit "\tldi"),
231 pprInstr (ST size reg addr)
243 ptext (sLit "\tclr\t"),
247 pprInstr (ABS size ri reg)
249 ptext (sLit "\tabs"),
257 pprInstr (NEG size ov ri reg)
259 ptext (sLit "\tneg"),
261 if ov then ptext (sLit "v\t") else char '\t',
267 pprInstr (ADD size ov reg1 ri reg2)
269 ptext (sLit "\tadd"),
271 if ov then ptext (sLit "v\t") else char '\t',
279 pprInstr (SADD size scale reg1 ri reg2)
281 ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
292 pprInstr (SUB size ov reg1 ri reg2)
294 ptext (sLit "\tsub"),
296 if ov then ptext (sLit "v\t") else char '\t',
304 pprInstr (SSUB size scale reg1 ri reg2)
306 ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
317 pprInstr (MUL size ov reg1 ri reg2)
319 ptext (sLit "\tmul"),
321 if ov then ptext (sLit "v\t") else char '\t',
329 pprInstr (DIV size uns reg1 ri reg2)
331 ptext (sLit "\tdiv"),
333 if uns then ptext (sLit "u\t") else char '\t',
341 pprInstr (REM size uns reg1 ri reg2)
343 ptext (sLit "\trem"),
345 if uns then ptext (sLit "u\t") else char '\t',
353 pprInstr (NOT ri reg)
355 ptext (sLit "\tnot"),
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
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
373 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg (sLit "zap") reg1 ri reg2
374 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg (sLit "zapnot") reg1 ri reg2
376 pprInstr (NOP) = ptext (sLit "\tnop")
378 pprInstr (CMP cond reg1 ri reg2)
380 ptext (sLit "\tcmp"),
392 ptext (sLit "\tfclr\t"),
396 pprInstr (FABS reg1 reg2)
398 ptext (sLit "\tfabs\t"),
404 pprInstr (FNEG size reg1 reg2)
406 ptext (sLit "\tneg"),
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
419 pprInstr (CVTxy size1 size2 reg1 reg2)
421 ptext (sLit "\tcvt"),
423 case size2 of {Q -> ptext (sLit "qc"); _ -> pprSize size2},
430 pprInstr (FCMP size cond reg1 reg2 reg3)
432 ptext (sLit "\tcmp"),
443 pprInstr (FMOV reg1 reg2)
445 ptext (sLit "\tfmov\t"),
451 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
453 pprInstr (BI NEVER reg lab) = empty
455 pprInstr (BI cond reg lab)
465 pprInstr (BF cond reg lab)
476 = (<>) (ptext (sLit "\tbr\t")) (pprImm lab)
478 pprInstr (JMP reg addr hint)
480 ptext (sLit "\tjmp\t"),
489 = (<>) (ptext (sLit "\tbsr\t")) (pprImm imm)
491 pprInstr (JSR reg addr n)
493 ptext (sLit "\tjsr\t"),
499 pprInstr (FUNBEGIN clab)
501 if (externallyVisibleCLabel clab) then
502 hcat [ptext (sLit "\t.globl\t"), pp_lab, char '\n']
505 ptext (sLit "\t.ent "),
514 pp_lab = pprCLabel_asm clab
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") ]
523 pprInstr (FUNEND clab)
524 = (<>) (ptext (sLit "\t.align 4\n\t.end ")) (pprCLabel_asm clab)
529 pprRI (RIReg r) = pprReg r
530 pprRI (RIImm r) = pprImm r
532 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
533 pprRegRIReg name reg1 ri reg2
545 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
546 pprSizeRegRegReg name size reg1 reg2 reg3