3b299746a93d0e08128c5259aa0625337b173650
[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 Module
12 import Outputable
13 import Platform
14 import Unique
15 import UniqSupply
16
17 import Dwarf.Constants
18 import Dwarf.Types
19
20 import Control.Monad ( mfilter )
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 <> text "-4" -- length of initialLength field
110 in vcat [ ppr cuLabel <> colon
111 , text "\t.long " <> length -- compilation unit size
112 , pprHalf 3 -- DWARF version
113 , sectionOffset (ptext dwarfAbbrevLabel) (ptext dwarfAbbrevLabel)
114 -- abbrevs offset
115 , text "\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 = map (blockToDwarf df) (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 , dwParent = fmap mkAsmTempDieLabel
181 $ mfilter (/= dblCLabel prc)
182 $ fmap dblCLabel (dblParent prc)
183 -- Omit parent if it would be self-referential
184 }
185
186 -- | Generate DWARF info for a block
187 blockToDwarf :: DynFlags -> DebugBlock -> DwarfInfo
188 blockToDwarf df blk
189 = DwarfBlock { dwChildren = concatMap (tickToDwarf df) (dblTicks blk)
190 ++ map (blockToDwarf df) (dblBlocks blk)
191 , dwLabel = dblCLabel blk
192 , dwMarker = marker
193 }
194 where
195 marker
196 | Just _ <- dblPosition blk = Just $ mkAsmTempLabel $ dblLabel blk
197 | otherwise = Nothing -- block was optimized out
198
199 tickToDwarf :: DynFlags -> Tickish () -> [DwarfInfo]
200 tickToDwarf _ (SourceNote ss _) = [DwarfSrcNote ss]
201 tickToDwarf _ _ = []
202
203 -- | Generates the data for the debug frame section, which encodes the
204 -- desired stack unwind behaviour for the debugger
205 debugFrame :: Unique -> [DebugBlock] -> DwarfFrame
206 debugFrame u procs
207 = DwarfFrame { dwCieLabel = mkAsmTempLabel u
208 , dwCieInit = initUws
209 , dwCieProcs = map (procToFrame initUws) procs
210 }
211 where initUws = Map.fromList [(Sp, UwReg Sp 0)]
212
213 -- | Generates unwind information for a procedure debug block
214 procToFrame :: UnwindTable -> DebugBlock -> DwarfFrameProc
215 procToFrame initUws blk
216 = DwarfFrameProc { dwFdeProc = dblCLabel blk
217 , dwFdeHasInfo = dblHasInfoTbl blk
218 , dwFdeBlocks = map (uncurry blockToFrame) blockUws
219 }
220 where blockUws :: [(DebugBlock, UnwindTable)]
221 blockUws = map snd $ sortBy (comparing fst) $ flatten initUws blk
222 flatten uws0 b@DebugBlock{ dblPosition=pos, dblUnwind=uws,
223 dblBlocks=blocks }
224 | Just p <- pos = (p, (b, uws')):nested
225 | otherwise = nested -- block was optimized out
226 where uws' = uws `Map.union` uws0
227 nested = concatMap (flatten uws') blocks
228
229 blockToFrame :: DebugBlock -> UnwindTable -> DwarfFrameBlock
230 blockToFrame blk uws
231 = DwarfFrameBlock { dwFdeBlock = mkAsmTempLabel $ dblLabel blk
232 , dwFdeBlkHasInfo = dblHasInfoTbl blk
233 , dwFdeUnwind = uws
234 }