Commit 8476ce24 authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

Dwarf: Produce .dwarf_aranges section

Test Plan: Check with `readelf --debug-dump=ranges`

Reviewers: scpmw, austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1174
parent cbf58a21
......@@ -39,13 +39,15 @@ dwarfGen df modLoc us blocks = do
let procs = debugSplitProcs blocks
stripBlocks dbg = dbg { dblBlocks = [] }
compPath <- getCurrentDirectory
let dwarfUnit = DwarfCompileUnit
let lowLabel = dblCLabel $ head procs
highLabel = mkAsmTempEndLabel $ dblCLabel $ last procs
dwarfUnit = DwarfCompileUnit
{ dwChildren = map (procToDwarf df) (map stripBlocks procs)
, dwName = fromMaybe "" (ml_hs_file modLoc)
, dwCompDir = addTrailingPathSeparator compPath
, dwProducer = cProjectName ++ " " ++ cProjectVersion
, dwLowLabel = dblCLabel $ head procs
, dwHighLabel = mkAsmTempEndLabel $ dblCLabel $ last procs
, dwLowLabel = lowLabel
, dwHighLabel = highLabel
, dwLineLabel = dwarfLineLabel
}
......@@ -62,7 +64,8 @@ dwarfGen df modLoc us blocks = do
-- .debug_info section: Information records on procedures and blocks
let -- unique to identify start and end compilation unit .debug_inf
(unitU, us') = takeUniqFromSupply us
infoSct = vcat [ dwarfInfoSection
infoSct = vcat [ ptext dwarfInfoLabel <> colon
, dwarfInfoSection
, compileUnitHeader unitU
, pprDwarfInfo haveSrc dwarfUnit
, compileUnitFooter unitU
......@@ -79,18 +82,23 @@ dwarfGen df modLoc us blocks = do
ptext dwarfFrameLabel <> colon $$
pprDwarfFrame (debugFrame framesU procs)
return (infoSct $$ abbrevSct $$ lineSct $$ frameSct, us'')
-- .aranges section: Information about the bounds of compilation units
let aranges = dwarfARangesSection $$
pprDwarfARange (DwarfARange lowLabel highLabel unitU)
return (infoSct $$ abbrevSct $$ lineSct $$ frameSct $$ aranges, us'')
-- | Header for a compilation unit, establishing global format
-- parameters
compileUnitHeader :: Unique -> SDoc
compileUnitHeader unitU = sdocWithPlatform $ \plat ->
let cuLabel = mkAsmTempLabel unitU
let cuLabel = mkAsmTempLabel unitU -- sits right before initialLength field
length = ppr (mkAsmTempEndLabel cuLabel) <> char '-' <> ppr cuLabel
in vcat [ ptext (sLit "\t.long ") <> length -- compilation unit size
, ppr cuLabel <> colon
, ptext (sLit "\t.word 3") -- DWARF version
, sectionOffset dwarfAbbrevLabel dwarfAbbrevLabel
<> ptext (sLit "-4") -- length of initialLength field
in vcat [ ppr cuLabel <> colon
, ptext (sLit "\t.long ") <> length -- compilation unit size
, pprHalf 3 -- DWARF version
, sectionOffset (ptext dwarfAbbrevLabel) (ptext dwarfAbbrevLabel)
-- abbrevs offset
, ptext (sLit "\t.byte ") <> ppr (platformWordSize plat) -- word size
]
......
......@@ -115,12 +115,13 @@ dW_OP_call_frame_cfa = 0x9c
-- | Dwarf section declarations
dwarfInfoSection, dwarfAbbrevSection, dwarfLineSection,
dwarfFrameSection, dwarfGhcSection :: SDoc
dwarfInfoSection = dwarfSection "info"
dwarfAbbrevSection = dwarfSection "abbrev"
dwarfLineSection = dwarfSection "line"
dwarfFrameSection = dwarfSection "frame"
dwarfGhcSection = dwarfSection "ghc"
dwarfFrameSection, dwarfGhcSection, dwarfARangesSection :: SDoc
dwarfInfoSection = dwarfSection "info"
dwarfAbbrevSection = dwarfSection "abbrev"
dwarfLineSection = dwarfSection "line"
dwarfFrameSection = dwarfSection "frame"
dwarfGhcSection = dwarfSection "ghc"
dwarfARangesSection = dwarfSection "aranges"
dwarfSection :: String -> SDoc
dwarfSection name = sdocWithPlatform $ \plat -> ftext $ mkFastString $
......
......@@ -3,11 +3,15 @@ module Dwarf.Types
DwarfInfo(..)
, pprDwarfInfo
, pprAbbrevDecls
-- * Dwarf address range table
, DwarfARange(..)
, pprDwarfARange
-- * Dwarf frame
, DwarfFrame(..), DwarfFrameProc(..), DwarfFrameBlock(..)
, pprDwarfFrame
-- * Utilities
, pprByte
, pprHalf
, pprData4'
, pprDwWord
, pprWord
......@@ -25,6 +29,7 @@ import Encoding
import FastString
import Outputable
import Platform
import Unique
import Reg
import Dwarf.Constants
......@@ -126,7 +131,7 @@ pprDwarfInfoOpen haveSrc (DwarfCompileUnit _ name producer compDir lowLabel
$$ pprWord (ppr lowLabel)
$$ pprWord (ppr highLabel)
$$ if haveSrc
then sectionOffset lineLbl dwarfLineLabel
then sectionOffset (ptext lineLbl) (ptext dwarfLineLabel)
else empty
pprDwarfInfoOpen _ (DwarfSubprogram _ name label) = sdocWithDynFlags $ \df ->
pprAbbrev DwAbbrSubprogram
......@@ -147,6 +152,44 @@ pprDwarfInfoOpen _ (DwarfBlock _ label marker) = sdocWithDynFlags $ \df ->
pprDwarfInfoClose :: SDoc
pprDwarfInfoClose = pprAbbrev DwAbbrNull
-- | A DWARF address range. This is used by the debugger to quickly locate
-- which compilation unit a given address belongs to. This type assumes
-- a non-segmented address-space.
data DwarfARange
= DwarfARange
{ dwArngStartLabel :: CLabel
, dwArngEndLabel :: CLabel
, dwArngUnitUnique :: Unique
-- ^ from which the corresponding label in @.debug_info@ is derived
}
-- | Print assembler directives corresponding to a DWARF @.debug_aranges@
-- address table entry.
pprDwarfARange :: DwarfARange -> SDoc
pprDwarfARange arng = sdocWithPlatform $ \plat ->
let wordSize = platformWordSize plat
paddingSize = 4 :: Int
-- header is 12 bytes long.
-- entry is 8 bytes (32-bit platform) or 16 bytes (64-bit platform).
-- pad such that first entry begins at multiple of entry size.
pad n = vcat $ replicate n $ pprByte 0
initialLength = 8 + paddingSize + 2*2*wordSize
length = ppr (dwArngEndLabel arng)
<> char '-' <> ppr (dwArngStartLabel arng)
in pprDwWord (ppr initialLength)
$$ pprHalf 2
$$ sectionOffset (ppr $ mkAsmTempLabel $ dwArngUnitUnique arng)
(ptext dwarfInfoLabel)
$$ pprByte (fromIntegral wordSize)
$$ pprByte 0
$$ pad paddingSize
-- beginning of body
$$ pprWord (ppr $ dwArngStartLabel arng)
$$ pprWord length
-- terminus
$$ pprWord (char '0')
$$ pprWord (char '0')
-- | Information about unwind instructions for a procedure. This
-- corresponds to a "Common Information Entry" (CIE) in DWARF.
data DwarfFrame
......@@ -366,6 +409,10 @@ wordAlign = sdocWithPlatform $ \plat ->
pprByte :: Word8 -> SDoc
pprByte x = ptext (sLit "\t.byte ") <> ppr (fromIntegral x :: Word)
-- | Assembly for a two-byte constant integer
pprHalf :: Word16 -> SDoc
pprHalf x = ptext (sLit "\t.hword ") <> ppr (fromIntegral x :: Word)
-- | Assembly for a constant DWARF flag
pprFlag :: Bool -> SDoc
pprFlag f = pprByte (if f then 0xff else 0x00)
......@@ -442,9 +489,9 @@ escapeChar c
-- us to just reference the target directly, and will figure out on
-- their own that we actually need an offset. Finally, Windows has
-- a special directive to refer to relative offsets. Fun.
sectionOffset :: LitString -> LitString -> SDoc
sectionOffset :: SDoc -> SDoc -> SDoc
sectionOffset target section = sdocWithPlatform $ \plat ->
case platformOS plat of
OSDarwin -> pprDwWord (ptext target <> char '-' <> ptext section)
OSMinGW32 -> text "\t.secrel32 " <> ptext target
_other -> pprDwWord (ptext target)
OSDarwin -> pprDwWord (target <> char '-' <> section)
OSMinGW32 -> text "\t.secrel32 " <> target
_other -> pprDwWord target
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment