1 -----------------------------------------------------------------------------
3 -- Pretty-printing assembly language
5 -- (c) The University of Glasgow 1993-2005
7 -----------------------------------------------------------------------------
22 #include "nativeGen/NCG.h"
23 #include "HsVersions.h"
39 import Unique ( pprUnique, Uniquable(..) )
42 import qualified Outputable
43 import Outputable ( Outputable, panic )
49 -- -----------------------------------------------------------------------------
50 -- Printing this stuff out
52 pprNatCmmTop :: NatCmmTop Instr -> Doc
53 pprNatCmmTop (CmmData section dats) =
54 pprSectionHeader section $$ vcat (map pprData dats)
56 -- special case for split markers:
57 pprNatCmmTop (CmmProc [] lbl (ListGraph [])) = pprLabel lbl
59 pprNatCmmTop (CmmProc info lbl (ListGraph blocks)) =
60 pprSectionHeader Text $$
61 (if null info then -- blocks guaranteed not null, so label needed
64 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
65 pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
68 vcat (map pprData info) $$
69 pprLabel (entryLblToInfoLbl lbl)
71 vcat (map pprBasicBlock blocks)
72 -- above: Even the first block gets a label, because with branch-chain
73 -- elimination, it might be the target of a goto.
74 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
75 -- If we are using the .subsections_via_symbols directive
76 -- (available on recent versions of Darwin),
77 -- we have to make sure that there is some kind of reference
78 -- from the entry code to a label on the _top_ of of the info table,
79 -- so that the linker will not think it is unreferenced and dead-strip
80 -- it. That's why the label is called a DeadStripPreventer (_dsp).
83 <+> pprCLabel_asm (entryLblToInfoLbl lbl)
85 <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
90 pprBasicBlock :: NatBasicBlock Instr -> Doc
91 pprBasicBlock (BasicBlock blockid instrs) =
92 pprLabel (mkAsmTempLabel (getUnique blockid)) $$
93 vcat (map pprInstr instrs)
96 pprData :: CmmStatic -> Doc
97 pprData (CmmAlign bytes) = pprAlign bytes
98 pprData (CmmDataLabel lbl) = pprLabel lbl
99 pprData (CmmString str) = pprASCII str
102 pprData (CmmUninitialised bytes) = ptext (sLit ".space ") <> int bytes
104 pprData (CmmUninitialised bytes) = ptext (sLit ".skip ") <> int bytes
107 pprData (CmmStaticLit lit) = pprDataItem lit
109 pprGloblDecl :: CLabel -> Doc
111 | not (externallyVisibleCLabel lbl) = empty
112 | otherwise = ptext IF_ARCH_sparc((sLit ".global "),
116 pprTypeAndSizeDecl :: CLabel -> Doc
118 pprTypeAndSizeDecl lbl
119 | not (externallyVisibleCLabel lbl) = empty
120 | otherwise = ptext (sLit ".type ") <>
121 pprCLabel_asm lbl <> ptext (sLit ", @object")
127 pprLabel :: CLabel -> Doc
128 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
131 pprASCII :: [Word8] -> Doc
133 = vcat (map do1 str) $$ do1 0
136 do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
138 pprAlign :: Int -> Doc
140 ptext (sLit ".align ") <> int pow2
144 log2 :: Int -> Int -- cache the common ones
149 log2 n = 1 + log2 (n `quot` 2)
152 -- -----------------------------------------------------------------------------
153 -- pprInstr: print an 'Instr'
155 instance Outputable Instr where
156 ppr instr = Outputable.docToSDoc $ pprInstr instr
163 RegReal (RealRegSingle i) -> ppr_reg_no i
164 RegReal (RealRegPair{}) -> panic "PPC.pprReg: no reg pairs on this arch"
165 RegVirtual (VirtualRegI u) -> text "%vI_" <> asmSDoc (pprUnique u)
166 RegVirtual (VirtualRegHi u) -> text "%vHi_" <> asmSDoc (pprUnique u)
167 RegVirtual (VirtualRegF u) -> text "%vF_" <> asmSDoc (pprUnique u)
168 RegVirtual (VirtualRegD u) -> text "%vD_" <> asmSDoc (pprUnique u)
169 RegVirtual (VirtualRegSSE u) -> text "%vSSE_" <> asmSDoc (pprUnique u)
172 ppr_reg_no :: Int -> Doc
175 0 -> sLit "r0"; 1 -> sLit "r1";
176 2 -> sLit "r2"; 3 -> sLit "r3";
177 4 -> sLit "r4"; 5 -> sLit "r5";
178 6 -> sLit "r6"; 7 -> sLit "r7";
179 8 -> sLit "r8"; 9 -> sLit "r9";
180 10 -> sLit "r10"; 11 -> sLit "r11";
181 12 -> sLit "r12"; 13 -> sLit "r13";
182 14 -> sLit "r14"; 15 -> sLit "r15";
183 16 -> sLit "r16"; 17 -> sLit "r17";
184 18 -> sLit "r18"; 19 -> sLit "r19";
185 20 -> sLit "r20"; 21 -> sLit "r21";
186 22 -> sLit "r22"; 23 -> sLit "r23";
187 24 -> sLit "r24"; 25 -> sLit "r25";
188 26 -> sLit "r26"; 27 -> sLit "r27";
189 28 -> sLit "r28"; 29 -> sLit "r29";
190 30 -> sLit "r30"; 31 -> sLit "r31";
191 32 -> sLit "f0"; 33 -> sLit "f1";
192 34 -> sLit "f2"; 35 -> sLit "f3";
193 36 -> sLit "f4"; 37 -> sLit "f5";
194 38 -> sLit "f6"; 39 -> sLit "f7";
195 40 -> sLit "f8"; 41 -> sLit "f9";
196 42 -> sLit "f10"; 43 -> sLit "f11";
197 44 -> sLit "f12"; 45 -> sLit "f13";
198 46 -> sLit "f14"; 47 -> sLit "f15";
199 48 -> sLit "f16"; 49 -> sLit "f17";
200 50 -> sLit "f18"; 51 -> sLit "f19";
201 52 -> sLit "f20"; 53 -> sLit "f21";
202 54 -> sLit "f22"; 55 -> sLit "f23";
203 56 -> sLit "f24"; 57 -> sLit "f25";
204 58 -> sLit "f26"; 59 -> sLit "f27";
205 60 -> sLit "f28"; 61 -> sLit "f29";
206 62 -> sLit "f30"; 63 -> sLit "f31";
207 _ -> sLit "very naughty powerpc register"
210 ppr_reg_no :: Int -> Doc
211 ppr_reg_no i | i <= 31 = int i -- GPRs
212 | i <= 63 = int (i-32) -- FPRs
213 | otherwise = ptext (sLit "very naughty powerpc register")
218 pprSize :: Size -> Doc
226 _ -> panic "PPC.Ppr.pprSize: no match")
229 pprCond :: Cond -> Doc
233 EQQ -> sLit "eq"; NE -> sLit "ne";
234 LTT -> sLit "lt"; GE -> sLit "ge";
235 GTT -> sLit "gt"; LE -> sLit "le";
236 LU -> sLit "lt"; GEU -> sLit "ge";
237 GU -> sLit "gt"; LEU -> sLit "le"; })
242 pprImm (ImmInt i) = int i
243 pprImm (ImmInteger i) = integer i
244 pprImm (ImmCLbl l) = pprCLabel_asm l
245 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
246 pprImm (ImmLit s) = s
248 pprImm (ImmFloat _) = ptext (sLit "naughty float immediate")
249 pprImm (ImmDouble _) = ptext (sLit "naughty double immediate")
251 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
252 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
253 <> lparen <> pprImm b <> rparen
257 = hcat [ pp_lo, pprImm i, rparen ]
262 = hcat [ pp_hi, pprImm i, rparen ]
267 = hcat [ pp_ha, pprImm i, rparen ]
273 = pprImm i <> text "@l"
276 = pprImm i <> text "@h"
279 = pprImm i <> text "@ha"
284 pprAddr :: AddrMode -> Doc
285 pprAddr (AddrRegReg r1 r2)
286 = pprReg r1 <+> ptext (sLit ", ") <+> pprReg r2
288 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
289 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
290 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
293 pprSectionHeader :: Section -> Doc
297 Text -> ptext (sLit ".text\n.align 2")
298 Data -> ptext (sLit ".data\n.align 2")
299 ReadOnlyData -> ptext (sLit ".const\n.align 2")
300 RelocatableReadOnlyData -> ptext (sLit ".const_data\n.align 2")
301 UninitialisedData -> ptext (sLit ".const_data\n.align 2")
302 ReadOnlyData16 -> ptext (sLit ".const\n.align 4")
303 OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section"
308 Text -> ptext (sLit ".text\n.align 2")
309 Data -> ptext (sLit ".data\n.align 2")
310 ReadOnlyData -> ptext (sLit ".section .rodata\n\t.align 2")
311 RelocatableReadOnlyData -> ptext (sLit ".data\n\t.align 2")
312 UninitialisedData -> ptext (sLit ".section .bss\n\t.align 2")
313 ReadOnlyData16 -> ptext (sLit ".section .rodata\n\t.align 4")
314 OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section"
319 pprDataItem :: CmmLit -> Doc
321 = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
325 ppr_item II8 _ = [ptext (sLit "\t.byte\t") <> pprImm imm]
327 ppr_item II32 _ = [ptext (sLit "\t.long\t") <> pprImm imm]
329 ppr_item FF32 (CmmFloat r _)
330 = let bs = floatToBytes (fromRational r)
331 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
333 ppr_item FF64 (CmmFloat r _)
334 = let bs = doubleToBytes (fromRational r)
335 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
337 ppr_item II16 _ = [ptext (sLit "\t.short\t") <> pprImm imm]
339 ppr_item II64 (CmmInt x _) =
340 [ptext (sLit "\t.long\t")
342 (fromIntegral (x `shiftR` 32) :: Word32)),
343 ptext (sLit "\t.long\t")
344 <> int (fromIntegral (fromIntegral x :: Word32))]
347 = panic "PPC.Ppr.pprDataItem: no match"
350 pprInstr :: Instr -> Doc
352 pprInstr (COMMENT _) = empty -- nuke 'em
355 = IF_ARCH_alpha( ((<>) (ptext (sLit "\t# ")) (ftext s))
356 ,IF_ARCH_sparc( ((<>) (ptext (sLit "# ")) (ftext s))
357 ,IF_ARCH_i386( ((<>) (ptext (sLit "# ")) (ftext s))
358 ,IF_ARCH_x86_64( ((<>) (ptext (sLit "# ")) (ftext s))
359 ,IF_ARCH_powerpc( IF_OS_linux(
360 ((<>) (ptext (sLit "# ")) (ftext s)),
361 ((<>) (ptext (sLit "; ")) (ftext s)))
365 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
367 pprInstr (NEWBLOCK _)
368 = panic "PprMach.pprInstr: NEWBLOCK"
371 = panic "PprMach.pprInstr: LDATA"
374 pprInstr (SPILL reg slot)
376 ptext (sLit "\tSPILL"),
380 ptext (sLit "SLOT") <> parens (int slot)]
382 pprInstr (RELOAD slot reg)
384 ptext (sLit "\tRELOAD"),
386 ptext (sLit "SLOT") <> parens (int slot),
391 pprInstr (LD sz reg addr) = hcat [
400 _ -> panic "PPC.Ppr.pprInstr: no match"
402 case addr of AddrRegImm _ _ -> empty
403 AddrRegReg _ _ -> char 'x',
409 pprInstr (LA sz reg addr) = hcat [
418 _ -> panic "PPC.Ppr.pprInstr: no match"
420 case addr of AddrRegImm _ _ -> empty
421 AddrRegReg _ _ -> char 'x',
427 pprInstr (ST sz reg addr) = hcat [
431 case addr of AddrRegImm _ _ -> empty
432 AddrRegReg _ _ -> char 'x',
438 pprInstr (STU sz reg addr) = hcat [
443 case addr of AddrRegImm _ _ -> empty
444 AddrRegReg _ _ -> char 'x',
449 pprInstr (LIS reg imm) = hcat [
457 pprInstr (LI reg imm) = hcat [
465 pprInstr (MR reg1 reg2)
466 | reg1 == reg2 = empty
469 case targetClassOfReg reg1 of
470 RcInteger -> ptext (sLit "mr")
471 _ -> ptext (sLit "fmr"),
477 pprInstr (CMP sz reg ri) = hcat [
493 pprInstr (CMPL sz reg ri) = hcat [
509 pprInstr (BCC cond blockid) = hcat [
516 where lbl = mkAsmTempLabel (getUnique blockid)
518 pprInstr (BCCFAR cond blockid) = vcat [
521 pprCond (condNegate cond),
525 ptext (sLit "\tb\t"),
529 where lbl = mkAsmTempLabel (getUnique blockid)
531 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
538 pprInstr (MTCTR reg) = hcat [
540 ptext (sLit "mtctr"),
544 pprInstr (BCTR _ _) = hcat [
548 pprInstr (BL lbl _) = hcat [
549 ptext (sLit "\tbl\t"),
552 pprInstr (BCTRL _) = hcat [
556 pprInstr (ADD reg1 reg2 ri) = pprLogic (sLit "add") reg1 reg2 ri
557 pprInstr (ADDIS reg1 reg2 imm) = hcat [
559 ptext (sLit "addis"),
568 pprInstr (ADDC reg1 reg2 reg3) = pprLogic (sLit "addc") reg1 reg2 (RIReg reg3)
569 pprInstr (ADDE reg1 reg2 reg3) = pprLogic (sLit "adde") reg1 reg2 (RIReg reg3)
570 pprInstr (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3)
571 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mullw") reg1 reg2 ri
572 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic (sLit "mull") reg1 reg2 ri
573 pprInstr (DIVW reg1 reg2 reg3) = pprLogic (sLit "divw") reg1 reg2 (RIReg reg3)
574 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic (sLit "divwu") reg1 reg2 (RIReg reg3)
576 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
577 hcat [ ptext (sLit "\tmullwo\t"), pprReg reg1, ptext (sLit ", "),
578 pprReg reg2, ptext (sLit ", "),
580 hcat [ ptext (sLit "\tmfxer\t"), pprReg reg1 ],
581 hcat [ ptext (sLit "\trlwinm\t"), pprReg reg1, ptext (sLit ", "),
582 pprReg reg1, ptext (sLit ", "),
583 ptext (sLit "2, 31, 31") ]
586 -- for some reason, "andi" doesn't exist.
587 -- we'll use "andi." instead.
588 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
590 ptext (sLit "andi."),
598 pprInstr (AND reg1 reg2 ri) = pprLogic (sLit "and") reg1 reg2 ri
600 pprInstr (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri
601 pprInstr (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri
603 pprInstr (XORIS reg1 reg2 imm) = hcat [
605 ptext (sLit "xoris"),
614 pprInstr (EXTS sz reg1 reg2) = hcat [
624 pprInstr (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2
625 pprInstr (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2
627 pprInstr (SLW reg1 reg2 ri) = pprLogic (sLit "slw") reg1 reg2 (limitShiftRI ri)
628 pprInstr (SRW reg1 reg2 ri) = pprLogic (sLit "srw") reg1 reg2 (limitShiftRI ri)
629 pprInstr (SRAW reg1 reg2 ri) = pprLogic (sLit "sraw") reg1 reg2 (limitShiftRI ri)
630 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
631 ptext (sLit "\trlwinm\t"),
643 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF (sLit "fadd") sz reg1 reg2 reg3
644 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF (sLit "fsub") sz reg1 reg2 reg3
645 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF (sLit "fmul") sz reg1 reg2 reg3
646 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") sz reg1 reg2 reg3
647 pprInstr (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2
649 pprInstr (FCMP reg1 reg2) = hcat [
651 ptext (sLit "fcmpu\tcr0, "),
652 -- Note: we're using fcmpu, not fcmpo
653 -- The difference is with fcmpo, compare with NaN is an invalid operation.
654 -- We don't handle invalid fp ops, so we don't care
660 pprInstr (FCTIWZ reg1 reg2) = pprUnary (sLit "fctiwz") reg1 reg2
661 pprInstr (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2
663 pprInstr (CRNOR dst src1 src2) = hcat [
664 ptext (sLit "\tcrnor\t"),
672 pprInstr (MFCR reg) = hcat [
679 pprInstr (MFLR reg) = hcat [
686 pprInstr (FETCHPC reg) = vcat [
687 ptext (sLit "\tbcl\t20,31,1f"),
688 hcat [ ptext (sLit "1:\tmflr\t"), pprReg reg ]
691 pprInstr LWSYNC = ptext (sLit "\tlwsync")
693 -- pprInstr _ = panic "pprInstr (ppc)"
696 pprLogic :: LitString -> Reg -> Reg -> RI -> Doc
697 pprLogic op reg1 reg2 ri = hcat [
712 pprUnary :: LitString -> Reg -> Reg -> Doc
713 pprUnary op reg1 reg2 = hcat [
723 pprBinaryF :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
724 pprBinaryF op sz reg1 reg2 reg3 = hcat [
737 pprRI (RIReg r) = pprReg r
738 pprRI (RIImm r) = pprImm r
741 pprFSize :: Size -> Doc
742 pprFSize FF64 = empty
743 pprFSize FF32 = char 's'
744 pprFSize _ = panic "PPC.Ppr.pprFSize: no match"
746 -- limit immediate argument for shift instruction to range 0..32
747 -- (yes, the maximum is really 32, not 31)
748 limitShiftRI :: RI -> RI
749 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)