2 -- The above warning supression flag is a temporary kludge.
3 -- While working on this module you are encouraged to remove it and fix
4 -- any warnings in the module. See
5 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
8 -----------------------------------------------------------------------------
10 -- Pretty-printing assembly language
12 -- (c) The University of Glasgow 1993-2005
14 -----------------------------------------------------------------------------
16 -- We start with the @pprXXX@s with some cross-platform commonality
17 -- (e.g., 'pprReg'); we conclude with the no-commonality monster,
20 #include "nativeGen/NCG.h"
23 pprNatCmmTop, pprBasicBlock, pprSectionHeader, pprData,
24 pprInstr, pprSize, pprUserReg, pprImm
27 #include "HsVersions.h"
33 import Regs -- may differ per-platform
37 import CLabel ( CLabel, pprCLabel, externallyVisibleCLabel,
38 labelDynamic, mkAsmTempLabel, entryLblToInfoLbl )
39 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
40 import CLabel ( mkDeadStripPreventer )
43 import Panic ( panic )
44 import Unique ( pprUnique )
47 import qualified Outputable
48 import Outputable ( Outputable, pprPanic, ppr, docToSDoc)
51 import Data.Word ( Word8 )
52 import Control.Monad.ST
53 import Data.Char ( chr, ord )
54 import Data.Maybe ( isJust )
59 #elif powerpc_TARGET_ARCH
61 #elif i386_TARGET_ARCH || x86_64_TARGET_ARCH
63 #elif sparc_TARGET_ARCH
66 #error "Regs: not defined for this architecture"
71 -- -----------------------------------------------------------------------------
72 -- Printing this stuff out
74 pprNatCmmTop :: NatCmmTop -> Doc
75 pprNatCmmTop (CmmData section dats) =
76 pprSectionHeader section $$ vcat (map pprData dats)
78 -- special case for split markers:
79 pprNatCmmTop (CmmProc [] lbl _ (ListGraph [])) = pprLabel lbl
81 pprNatCmmTop (CmmProc info lbl params (ListGraph blocks)) =
82 pprSectionHeader Text $$
83 (if null info then -- blocks guaranteed not null, so label needed
86 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
87 pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
90 vcat (map pprData info) $$
91 pprLabel (entryLblToInfoLbl lbl)
93 vcat (map pprBasicBlock blocks)
94 -- above: Even the first block gets a label, because with branch-chain
95 -- elimination, it might be the target of a goto.
96 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
97 -- If we are using the .subsections_via_symbols directive
98 -- (available on recent versions of Darwin),
99 -- we have to make sure that there is some kind of reference
100 -- from the entry code to a label on the _top_ of of the info table,
101 -- so that the linker will not think it is unreferenced and dead-strip
102 -- it. That's why the label is called a DeadStripPreventer (_dsp).
103 $$ if not (null info)
105 <+> pprCLabel_asm (entryLblToInfoLbl lbl)
107 <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
112 pprBasicBlock :: NatBasicBlock -> Doc
113 pprBasicBlock (BasicBlock (BlockId id) instrs) =
114 pprLabel (mkAsmTempLabel id) $$
115 vcat (map pprInstr instrs)
118 pprData :: CmmStatic -> Doc
119 pprData (CmmAlign bytes) = pprAlign bytes
120 pprData (CmmDataLabel lbl) = pprLabel lbl
121 pprData (CmmString str) = pprASCII str
122 pprData (CmmUninitialised bytes) = ptext (sLit s) <> int bytes
124 #if defined(solaris2_TARGET_OS)
129 pprData (CmmStaticLit lit) = pprDataItem lit
131 pprGloblDecl :: CLabel -> Doc
133 | not (externallyVisibleCLabel lbl) = empty
134 | otherwise = ptext IF_ARCH_sparc((sLit ".global "),
138 pprTypeAndSizeDecl :: CLabel -> Doc
139 pprTypeAndSizeDecl lbl
141 | not (externallyVisibleCLabel lbl) = empty
142 | otherwise = ptext (sLit ".type ") <>
143 pprCLabel_asm lbl <> ptext (sLit ", @object")
148 pprLabel :: CLabel -> Doc
149 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
153 = vcat (map do1 str) $$ do1 0
156 do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
159 IF_ARCH_alpha(ptext (sLit ".align ") <> int pow2,
160 IF_ARCH_i386(ptext (sLit ".align ") <> int IF_OS_darwin(pow2,bytes),
161 IF_ARCH_x86_64(ptext (sLit ".align ") <> int IF_OS_darwin(pow2,bytes),
162 IF_ARCH_sparc(ptext (sLit ".align ") <> int bytes,
163 IF_ARCH_powerpc(ptext (sLit ".align ") <> int pow2,)))))
167 log2 :: Int -> Int -- cache the common ones
172 log2 n = 1 + log2 (n `quot` 2)
175 -- -----------------------------------------------------------------------------
176 -- pprInstr: print an 'Instr'
178 instance Outputable Instr where
179 ppr instr = Outputable.docToSDoc $ pprInstr instr