b19f534bbd21ef22f3326b6f31f5e6736d85ddd9
[ghc.git] / compiler / nativeGen / Dwarf.hs
1 module Dwarf (
2 dwarfGen
3 ) where
4
5 import CLabel
6 import CmmExpr ( GlobalReg(..) )
7 import Config ( cProjectName, cProjectVersion )
8 import CoreSyn ( Tickish(..) )
9 import Debug
10 import DynFlags
11 import FastString
12 import Module
13 import Outputable
14 import Platform
15 import Unique
16 import UniqSupply
17
18 import Dwarf.Constants
19 import Dwarf.Types
20
21 import Data.Maybe
22 import Data.List ( sortBy )
23 import Data.Ord ( comparing )
24 import qualified Data.Map as Map
25 import System.FilePath
26 import System.Directory ( getCurrentDirectory )
27
28 import qualified Compiler.Hoopl as H
29
30 -- | Generate DWARF/debug information
31 dwarfGen :: DynFlags -> ModLocation -> UniqSupply -> [DebugBlock]
32 -> IO (SDoc, UniqSupply)
33 dwarfGen _ _ us [] = return (empty, us)
34 dwarfGen df modLoc us blocks = do
35
36 -- Convert debug data structures to DWARF info records
37 -- We strip out block information when running with -g0 or -g1.
38 let procs = debugSplitProcs blocks
39 stripBlocks dbg
40 | debugLevel df < 2 = dbg { dblBlocks = [] }
41 | otherwise = dbg
42 compPath <- getCurrentDirectory
43 let lowLabel = dblCLabel $ head procs
44 highLabel = mkAsmTempEndLabel $ dblCLabel $ last procs
45 dwarfUnit = DwarfCompileUnit
46 { dwChildren = map (procToDwarf df) (map stripBlocks procs)
47 , dwName = fromMaybe "" (ml_hs_file modLoc)
48 , dwCompDir = addTrailingPathSeparator compPath
49 , dwProducer = cProjectName ++ " " ++ cProjectVersion
50 , dwLowLabel = lowLabel
51 , dwHighLabel = highLabel
52 , dwLineLabel = dwarfLineLabel
53 }
54
55 -- Check whether we have any source code information, so we do not
56 -- end up writing a pointer to an empty .debug_line section
57 -- (dsymutil on Mac Os gets confused by this).
58 let haveSrcIn blk = isJust (dblSourceTick blk) && isJust (dblPosition blk)
59 || any haveSrcIn (dblBlocks blk)
60 haveSrc = any haveSrcIn procs
61
62 -- .debug_abbrev section: Declare the format we're using
63 let abbrevSct = pprAbbrevDecls haveSrc
64
65 -- .debug_info section: Information records on procedures and blocks
66 let -- unique to identify start and end compilation unit .debug_inf
67 (unitU, us') = takeUniqFromSupply us
68 infoSct = vcat [ ptext dwarfInfoLabel <> colon
69 , dwarfInfoSection
70 , compileUnitHeader unitU
71 , pprDwarfInfo haveSrc dwarfUnit
72 , compileUnitFooter unitU
73 ]
74
75 -- .debug_line section: Generated mainly by the assembler, but we
76 -- need to label it
77 let lineSct = dwarfLineSection $$
78 ptext dwarfLineLabel <> colon
79
80 -- .debug_frame section: Information about the layout of the GHC stack
81 let (framesU, us'') = takeUniqFromSupply us'
82 frameSct = dwarfFrameSection $$
83 ptext dwarfFrameLabel <> colon $$
84 pprDwarfFrame (debugFrame framesU procs)
85
86 -- .aranges section: Information about the bounds of compilation units
87 let aranges' | gopt Opt_SplitSections df = map mkDwarfARange procs
88 | otherwise = [DwarfARange lowLabel highLabel]
89 let aranges = dwarfARangesSection $$ pprDwarfARanges aranges' unitU
90
91 return (infoSct $$ abbrevSct $$ lineSct $$ frameSct $$ aranges, us'')
92
93 -- | Build an address range entry for one proc.
94 -- With split sections, each proc needs its own entry, since they may get
95 -- scattered in the final binary. Without split sections, we could make a
96 -- single arange based on the first/last proc.
97 mkDwarfARange :: DebugBlock -> DwarfARange
98 mkDwarfARange proc = DwarfARange start end
99 where
100 start = dblCLabel proc
101 end = mkAsmTempEndLabel start
102
103 -- | Header for a compilation unit, establishing global format
104 -- parameters
105 compileUnitHeader :: Unique -> SDoc
106 compileUnitHeader unitU = sdocWithPlatform $ \plat ->
107 let cuLabel = mkAsmTempLabel unitU -- sits right before initialLength field
108 length = ppr (mkAsmTempEndLabel cuLabel) <> char '-' <> ppr cuLabel
109 <> ptext (sLit "-4") -- length of initialLength field
110 in vcat [ ppr cuLabel <> colon
111 , ptext (sLit "\t.long ") <> length -- compilation unit size
112 , pprHalf 3 -- DWARF version
113 , sectionOffset (ptext dwarfAbbrevLabel) (ptext dwarfAbbrevLabel)
114 -- abbrevs offset
115 , ptext (sLit "\t.byte ") <> ppr (platformWordSize plat) -- word size
116 ]
117
118 -- | Compilation unit footer, mainly establishing size of debug sections
119 compileUnitFooter :: Unique -> SDoc
120 compileUnitFooter unitU =
121 let cuEndLabel = mkAsmTempEndLabel $ mkAsmTempLabel unitU
122 in ppr cuEndLabel <> colon
123
124 -- | Splits the blocks by procedures. In the result all nested blocks
125 -- will come from the same procedure as the top-level block. See
126 -- Note [Splitting DebugBlocks] for details.
127 debugSplitProcs :: [DebugBlock] -> [DebugBlock]
128 debugSplitProcs b = concat $ H.mapElems $ mergeMaps $ map (split Nothing) b
129 where mergeMaps = foldr (H.mapUnionWithKey (const (++))) H.mapEmpty
130 split :: Maybe DebugBlock -> DebugBlock -> H.LabelMap [DebugBlock]
131 split parent blk = H.mapInsert prc [blk'] nested
132 where prc = dblProcedure blk
133 blk' = blk { dblBlocks = own_blks
134 , dblParent = parent
135 }
136 own_blks = fromMaybe [] $ H.mapLookup prc nested
137 nested = mergeMaps $ map (split parent') $ dblBlocks blk
138 -- Figure out who should be the parent of nested blocks.
139 -- If @blk@ is optimized out then it isn't a good choice
140 -- and we just use its parent.
141 parent'
142 | Nothing <- dblPosition blk = parent
143 | otherwise = Just blk
144
145 {-
146 Note [Splitting DebugBlocks]
147
148 DWARF requires that we break up the the nested DebugBlocks produced from
149 the C-- AST. For instance, we begin with tick trees containing nested procs.
150 For example,
151
152 proc A [tick1, tick2]
153 block B [tick3]
154 proc C [tick4]
155
156 when producing DWARF we need to procs (which are represented in DWARF as
157 TAG_subprogram DIEs) to be top-level DIEs. debugSplitProcs is responsible for
158 this transform, pulling out the nested procs into top-level procs.
159
160 However, in doing this we need to be careful to preserve the parentage of the
161 nested procs. This is the reason DebugBlocks carry the dblParent field, allowing
162 us to reorganize the above tree as,
163
164 proc A [tick1, tick2]
165 block B [tick3]
166 proc C [tick4] parent=B
167
168 Here we have annotated the new proc C with an attribute giving its original
169 parent, B.
170 -}
171
172 -- | Generate DWARF info for a procedure debug block
173 procToDwarf :: DynFlags -> DebugBlock -> DwarfInfo
174 procToDwarf df prc
175 = DwarfSubprogram { dwChildren = foldr blockToDwarf [] $ dblBlocks prc
176 , dwName = case dblSourceTick prc of
177 Just s@SourceNote{} -> sourceName s
178 _otherwise -> showSDocDump df $ ppr $ dblLabel prc
179 , dwLabel = dblCLabel prc
180 }
181
182 -- | Generate DWARF info for a block
183 blockToDwarf :: DebugBlock -> [DwarfInfo] -> [DwarfInfo]
184 blockToDwarf blk dws
185 | isJust (dblPosition blk) = dw : dws
186 | otherwise = nested ++ dws -- block was optimized out, flatten
187 where nested = foldr blockToDwarf [] $ dblBlocks blk
188 dw = DwarfBlock { dwChildren = nested
189 , dwLabel = dblCLabel blk
190 , dwMarker = mkAsmTempLabel (dblLabel blk)
191 }
192
193 -- | Generates the data for the debug frame section, which encodes the
194 -- desired stack unwind behaviour for the debugger
195 debugFrame :: Unique -> [DebugBlock] -> DwarfFrame
196 debugFrame u procs
197 = DwarfFrame { dwCieLabel = mkAsmTempLabel u
198 , dwCieInit = initUws
199 , dwCieProcs = map (procToFrame initUws) procs
200 }
201 where initUws = Map.fromList [(Sp, UwReg Sp 0)]
202
203 -- | Generates unwind information for a procedure debug block
204 procToFrame :: UnwindTable -> DebugBlock -> DwarfFrameProc
205 procToFrame initUws blk
206 = DwarfFrameProc { dwFdeProc = dblCLabel blk
207 , dwFdeHasInfo = dblHasInfoTbl blk
208 , dwFdeBlocks = map (uncurry blockToFrame) blockUws
209 }
210 where blockUws :: [(DebugBlock, UnwindTable)]
211 blockUws = map snd $ sortBy (comparing fst) $ flatten initUws blk
212 flatten uws0 b@DebugBlock{ dblPosition=pos, dblUnwind=uws,
213 dblBlocks=blocks }
214 | Just p <- pos = (p, (b, uws')):nested
215 | otherwise = nested -- block was optimized out
216 where uws' = uws `Map.union` uws0
217 nested = concatMap (flatten uws') blocks
218
219 blockToFrame :: DebugBlock -> UnwindTable -> DwarfFrameBlock
220 blockToFrame blk uws
221 = DwarfFrameBlock { dwFdeBlock = mkAsmTempLabel $ dblLabel blk
222 , dwFdeBlkHasInfo = dblHasInfoTbl blk
223 , dwFdeUnwind = uws
224 }