1 -----------------------------------------------------------------------------
3 -- Pretty-printing assembly language
5 -- (c) The University of Glasgow 1993-2005
7 -----------------------------------------------------------------------------
22 #include "HsVersions.h"
23 #include "nativeGen/NCG.h"
40 import Unique ( Uniquable(..), pprUnique )
41 import qualified Outputable
42 import Outputable (Outputable, panic)
47 -- -----------------------------------------------------------------------------
48 -- Printing this stuff out
50 pprNatCmmTop :: NatCmmTop Instr -> Doc
51 pprNatCmmTop (CmmData section dats) =
52 pprSectionHeader section $$ vcat (map pprData dats)
54 -- special case for split markers:
55 pprNatCmmTop (CmmProc [] lbl (ListGraph [])) = pprLabel lbl
57 pprNatCmmTop (CmmProc info lbl (ListGraph blocks)) =
58 pprSectionHeader Text $$
59 (if null info then -- blocks guaranteed not null, so label needed
62 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
63 pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
66 vcat (map pprData info) $$
67 pprLabel (entryLblToInfoLbl lbl)
69 vcat (map pprBasicBlock blocks)
70 -- above: Even the first block gets a label, because with branch-chain
71 -- elimination, it might be the target of a goto.
72 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
73 -- If we are using the .subsections_via_symbols directive
74 -- (available on recent versions of Darwin),
75 -- we have to make sure that there is some kind of reference
76 -- from the entry code to a label on the _top_ of of the info table,
77 -- so that the linker will not think it is unreferenced and dead-strip
78 -- it. That's why the label is called a DeadStripPreventer (_dsp).
81 <+> pprCLabel_asm (entryLblToInfoLbl lbl)
83 <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
88 pprBasicBlock :: NatBasicBlock Instr -> Doc
89 pprBasicBlock (BasicBlock blockid instrs) =
90 pprLabel (mkAsmTempLabel (getUnique blockid)) $$
91 vcat (map pprInstr instrs)
94 pprData :: CmmStatic -> Doc
95 pprData (CmmAlign bytes) = pprAlign bytes
96 pprData (CmmDataLabel lbl) = pprLabel lbl
97 pprData (CmmString str) = pprASCII str
98 pprData (CmmUninitialised bytes) = ptext (sLit ".skip ") <> int bytes
99 pprData (CmmStaticLit lit) = pprDataItem lit
101 pprGloblDecl :: CLabel -> Doc
103 | not (externallyVisibleCLabel lbl) = empty
104 | otherwise = ptext (sLit ".global ") <> pprCLabel_asm lbl
106 pprTypeAndSizeDecl :: CLabel -> Doc
108 pprTypeAndSizeDecl lbl
109 | not (externallyVisibleCLabel lbl) = empty
110 | otherwise = ptext (sLit ".type ") <>
111 pprCLabel_asm lbl <> ptext (sLit ", @object")
117 pprLabel :: CLabel -> Doc
118 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
121 pprASCII :: [Word8] -> Doc
123 = vcat (map do1 str) $$ do1 0
126 do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
128 pprAlign :: Int -> Doc
130 ptext (sLit ".align ") <> int bytes
133 -- -----------------------------------------------------------------------------
134 -- pprInstr: print an 'Instr'
136 instance Outputable Instr where
137 ppr instr = Outputable.docToSDoc $ pprInstr instr
140 -- | Pretty print a register.
146 VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u)
147 VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u)
148 VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u)
149 VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u)
150 VirtualRegSSE u -> text "%vSSE_" <> asmSDoc (pprUnique u)
158 -> text "(" <> pprReg_ofRegNo r1
159 <> text "|" <> pprReg_ofRegNo r2
164 -- | Pretty print a register name, based on this register number.
165 -- The definition has been unfolded so we get a jump-table in the
166 -- object code. This function is called quite a lot when emitting the asm file..
168 pprReg_ofRegNo :: Int -> Doc
172 0 -> sLit "%g0"; 1 -> sLit "%g1";
173 2 -> sLit "%g2"; 3 -> sLit "%g3";
174 4 -> sLit "%g4"; 5 -> sLit "%g5";
175 6 -> sLit "%g6"; 7 -> sLit "%g7";
176 8 -> sLit "%o0"; 9 -> sLit "%o1";
177 10 -> sLit "%o2"; 11 -> sLit "%o3";
178 12 -> sLit "%o4"; 13 -> sLit "%o5";
179 14 -> sLit "%o6"; 15 -> sLit "%o7";
180 16 -> sLit "%l0"; 17 -> sLit "%l1";
181 18 -> sLit "%l2"; 19 -> sLit "%l3";
182 20 -> sLit "%l4"; 21 -> sLit "%l5";
183 22 -> sLit "%l6"; 23 -> sLit "%l7";
184 24 -> sLit "%i0"; 25 -> sLit "%i1";
185 26 -> sLit "%i2"; 27 -> sLit "%i3";
186 28 -> sLit "%i4"; 29 -> sLit "%i5";
187 30 -> sLit "%i6"; 31 -> sLit "%i7";
188 32 -> sLit "%f0"; 33 -> sLit "%f1";
189 34 -> sLit "%f2"; 35 -> sLit "%f3";
190 36 -> sLit "%f4"; 37 -> sLit "%f5";
191 38 -> sLit "%f6"; 39 -> sLit "%f7";
192 40 -> sLit "%f8"; 41 -> sLit "%f9";
193 42 -> sLit "%f10"; 43 -> sLit "%f11";
194 44 -> sLit "%f12"; 45 -> sLit "%f13";
195 46 -> sLit "%f14"; 47 -> sLit "%f15";
196 48 -> sLit "%f16"; 49 -> sLit "%f17";
197 50 -> sLit "%f18"; 51 -> sLit "%f19";
198 52 -> sLit "%f20"; 53 -> sLit "%f21";
199 54 -> sLit "%f22"; 55 -> sLit "%f23";
200 56 -> sLit "%f24"; 57 -> sLit "%f25";
201 58 -> sLit "%f26"; 59 -> sLit "%f27";
202 60 -> sLit "%f28"; 61 -> sLit "%f29";
203 62 -> sLit "%f30"; 63 -> sLit "%f31";
204 _ -> sLit "very naughty sparc register" })
207 -- | Pretty print a size for an instruction suffix.
208 pprSize :: Size -> Doc
218 _ -> panic "SPARC.Ppr.pprSize: no match")
221 -- | Pretty print a size for an instruction suffix.
222 -- eg LD is 32bit on sparc, but LDD is 64 bit.
223 pprStSize :: Size -> Doc
233 _ -> panic "SPARC.Ppr.pprSize: no match")
236 -- | Pretty print a condition code.
237 pprCond :: Cond -> Doc
259 -- | Pretty print an address mode.
260 pprAddr :: AddrMode -> Doc
263 AddrRegReg r1 (RegReal (RealRegSingle 0))
267 -> hcat [ pprReg r1, char '+', pprReg r2 ]
269 AddrRegImm r1 (ImmInt i)
270 | i == 0 -> pprReg r1
271 | not (fits13Bits i) -> largeOffsetError i
272 | otherwise -> hcat [ pprReg r1, pp_sign, int i ]
274 pp_sign = if i > 0 then char '+' else empty
276 AddrRegImm r1 (ImmInteger i)
277 | i == 0 -> pprReg r1
278 | not (fits13Bits i) -> largeOffsetError i
279 | otherwise -> hcat [ pprReg r1, pp_sign, integer i ]
281 pp_sign = if i > 0 then char '+' else empty
284 -> hcat [ pprReg r1, char '+', pprImm imm ]
287 -- | Pretty print an immediate value.
292 ImmInteger i -> integer i
293 ImmCLbl l -> pprCLabel_asm l
294 ImmIndex l i -> pprCLabel_asm l <> char '+' <> int i
298 -> pprImm a <> char '+' <> pprImm b
301 -> pprImm a <> char '-' <> lparen <> pprImm b <> rparen
304 -> hcat [ text "%lo(", pprImm i, rparen ]
307 -> hcat [ text "%hi(", pprImm i, rparen ]
309 -- these should have been converted to bytes and placed
310 -- in the data section.
311 ImmFloat _ -> ptext (sLit "naughty float immediate")
312 ImmDouble _ -> ptext (sLit "naughty double immediate")
315 -- | Pretty print a section \/ segment header.
316 -- On SPARC all the data sections must be at least 8 byte aligned
317 -- incase we store doubles in them.
319 pprSectionHeader :: Section -> Doc
322 Text -> ptext (sLit ".text\n\t.align 4")
323 Data -> ptext (sLit ".data\n\t.align 8")
324 ReadOnlyData -> ptext (sLit ".text\n\t.align 8")
325 RelocatableReadOnlyData -> ptext (sLit ".text\n\t.align 8")
326 UninitialisedData -> ptext (sLit ".bss\n\t.align 8")
327 ReadOnlyData16 -> ptext (sLit ".data\n\t.align 16")
328 OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section"
331 -- | Pretty print a data item.
332 pprDataItem :: CmmLit -> Doc
334 = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
338 ppr_item II8 _ = [ptext (sLit "\t.byte\t") <> pprImm imm]
339 ppr_item II32 _ = [ptext (sLit "\t.long\t") <> pprImm imm]
341 ppr_item FF32 (CmmFloat r _)
342 = let bs = floatToBytes (fromRational r)
343 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
345 ppr_item FF64 (CmmFloat r _)
346 = let bs = doubleToBytes (fromRational r)
347 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
349 ppr_item II16 _ = [ptext (sLit "\t.short\t") <> pprImm imm]
350 ppr_item II64 _ = [ptext (sLit "\t.quad\t") <> pprImm imm]
351 ppr_item _ _ = panic "SPARC.Ppr.pprDataItem: no match"
354 -- | Pretty print an instruction.
355 pprInstr :: Instr -> Doc
362 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
364 -- Newblocks and LData should have been slurped out before producing the .s file.
365 pprInstr (NEWBLOCK _)
366 = panic "X86.Ppr.pprInstr: NEWBLOCK"
369 = panic "PprMach.pprInstr: LDATA"
371 -- 64 bit FP loads are expanded into individual instructions in CodeGen.Expand
372 pprInstr (LD FF64 _ reg)
373 | RegReal (RealRegSingle{}) <- reg
374 = panic "SPARC.Ppr: not emitting potentially misaligned LD FF64 instr"
376 pprInstr (LD size addr reg)
387 -- 64 bit FP storees are expanded into individual instructions in CodeGen.Expand
388 pprInstr (ST FF64 reg _)
389 | RegReal (RealRegSingle{}) <- reg
390 = panic "SPARC.Ppr: not emitting potentially misaligned ST FF64 instr"
392 -- no distinction is made between signed and unsigned bytes on stores for the
393 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
394 -- so we call a special-purpose pprSize for ST..
395 pprInstr (ST size reg addr)
407 pprInstr (ADD x cc reg1 ri reg2)
408 | not x && not cc && riZero ri
409 = hcat [ ptext (sLit "\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
412 = pprRegRIReg (if x then sLit "addx" else sLit "add") cc reg1 ri reg2
415 pprInstr (SUB x cc reg1 ri reg2)
416 | not x && cc && reg2 == g0
417 = hcat [ ptext (sLit "\tcmp\t"), pprReg reg1, comma, pprRI ri ]
419 | not x && not cc && riZero ri
420 = hcat [ ptext (sLit "\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
423 = pprRegRIReg (if x then sLit "subx" else sLit "sub") cc reg1 ri reg2
425 pprInstr (AND b reg1 ri reg2) = pprRegRIReg (sLit "and") b reg1 ri reg2
427 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg (sLit "andn") b reg1 ri reg2
429 pprInstr (OR b reg1 ri reg2)
430 | not b && reg1 == g0
431 = let doit = hcat [ ptext (sLit "\tmov\t"), pprRI ri, comma, pprReg reg2 ]
433 RIReg rrr | rrr == reg2 -> empty
437 = pprRegRIReg (sLit "or") b reg1 ri reg2
439 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg (sLit "orn") b reg1 ri reg2
441 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg (sLit "xor") b reg1 ri reg2
442 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg (sLit "xnor") b reg1 ri reg2
444 pprInstr (SLL reg1 ri reg2) = pprRegRIReg (sLit "sll") False reg1 ri reg2
445 pprInstr (SRL reg1 ri reg2) = pprRegRIReg (sLit "srl") False reg1 ri reg2
446 pprInstr (SRA reg1 ri reg2) = pprRegRIReg (sLit "sra") False reg1 ri reg2
448 pprInstr (RDY rd) = ptext (sLit "\trd\t%y,") <> pprReg rd
449 pprInstr (WRY reg1 reg2)
450 = ptext (sLit "\twr\t")
457 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg (sLit "smul") b reg1 ri reg2
458 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg (sLit "umul") b reg1 ri reg2
459 pprInstr (SDIV b reg1 ri reg2) = pprRegRIReg (sLit "sdiv") b reg1 ri reg2
460 pprInstr (UDIV b reg1 ri reg2) = pprRegRIReg (sLit "udiv") b reg1 ri reg2
462 pprInstr (SETHI imm reg)
464 ptext (sLit "\tsethi\t"),
471 = ptext (sLit "\tnop")
473 pprInstr (FABS size reg1 reg2)
474 = pprSizeRegReg (sLit "fabs") size reg1 reg2
476 pprInstr (FADD size reg1 reg2 reg3)
477 = pprSizeRegRegReg (sLit "fadd") size reg1 reg2 reg3
479 pprInstr (FCMP e size reg1 reg2)
480 = pprSizeRegReg (if e then sLit "fcmpe" else sLit "fcmp") size reg1 reg2
482 pprInstr (FDIV size reg1 reg2 reg3)
483 = pprSizeRegRegReg (sLit "fdiv") size reg1 reg2 reg3
485 pprInstr (FMOV size reg1 reg2)
486 = pprSizeRegReg (sLit "fmov") size reg1 reg2
488 pprInstr (FMUL size reg1 reg2 reg3)
489 = pprSizeRegRegReg (sLit "fmul") size reg1 reg2 reg3
491 pprInstr (FNEG size reg1 reg2)
492 = pprSizeRegReg (sLit "fneg") size reg1 reg2
494 pprInstr (FSQRT size reg1 reg2)
495 = pprSizeRegReg (sLit "fsqrt") size reg1 reg2
497 pprInstr (FSUB size reg1 reg2 reg3)
498 = pprSizeRegRegReg (sLit "fsub") size reg1 reg2 reg3
500 pprInstr (FxTOy size1 size2 reg1 reg2)
508 _ -> panic "SPARC.Ppr.pprInstr.FxToY: no match"),
515 _ -> panic "SPARC.Ppr.pprInstr.FxToY: no match"),
516 pprReg reg1, comma, pprReg reg2
520 pprInstr (BI cond b blockid)
522 ptext (sLit "\tb"), pprCond cond,
523 if b then pp_comma_a else empty,
525 pprCLabel_asm (mkAsmTempLabel (getUnique blockid))
528 pprInstr (BF cond b blockid)
530 ptext (sLit "\tfb"), pprCond cond,
531 if b then pp_comma_a else empty,
533 pprCLabel_asm (mkAsmTempLabel (getUnique blockid))
536 pprInstr (JMP addr) = (<>) (ptext (sLit "\tjmp\t")) (pprAddr addr)
537 pprInstr (JMP_TBL op _ _) = pprInstr (JMP op)
539 pprInstr (CALL (Left imm) n _)
540 = hcat [ ptext (sLit "\tcall\t"), pprImm imm, comma, int n ]
542 pprInstr (CALL (Right reg) n _)
543 = hcat [ ptext (sLit "\tcall\t"), pprReg reg, comma, int n ]
546 -- | Pretty print a RI
548 pprRI (RIReg r) = pprReg r
549 pprRI (RIImm r) = pprImm r
552 -- | Pretty print a two reg instruction.
553 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
554 pprSizeRegReg name size reg1 reg2
559 FF32 -> ptext (sLit "s\t")
560 FF64 -> ptext (sLit "d\t")
561 _ -> panic "SPARC.Ppr.pprSizeRegReg: no match"),
569 -- | Pretty print a three reg instruction.
570 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
571 pprSizeRegRegReg name size reg1 reg2 reg3
576 FF32 -> ptext (sLit "s\t")
577 FF64 -> ptext (sLit "d\t")
578 _ -> panic "SPARC.Ppr.pprSizeRegReg: no match"),
587 -- | Pretty print an instruction of two regs and a ri.
588 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
589 pprRegRIReg name b reg1 ri reg2
593 if b then ptext (sLit "cc\t") else char '\t',
602 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
603 pprRIReg name b ri reg1
607 if b then ptext (sLit "cc\t") else char '\t',
615 pp_ld_lbracket :: Doc
616 pp_ld_lbracket = ptext (sLit "\tld\t[")
619 pp_rbracket_comma :: Doc
620 pp_rbracket_comma = text "],"
623 pp_comma_lbracket :: Doc
624 pp_comma_lbracket = text ",["
628 pp_comma_a = text ",a"