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