diff --git a/dumpdwarf.hs b/dumpdwarf.hs --- a/dumpdwarf.hs +++ b/dumpdwarf.hs @@ -12,4 +12,4 @@ main = do [filename] <- getArgs (_, (cuDies, _)) <- loadElfDwarf Dwarf.LittleEndian filename - putStrLn . drawTree . fmap show . head $ map dieTree cuDies + mapM_ (putStrLn . drawTree . fmap show) $ map dieTree cuDies diff --git a/dwarfadt.cabal b/dwarfadt.cabal --- a/dwarfadt.cabal +++ b/dwarfadt.cabal @@ -1,5 +1,5 @@ name: dwarfadt -version: 0.2.0.0 +version: 0.3 synopsis: High-level wrapper around the dwarf library description: dwarf is an excellent library to read dwarf files, but the output of parsing dwarf is very low-level and difficult to work with. @@ -27,7 +27,7 @@ other-modules: Data.Dwarf.AttrGetter , Data.Dwarf.Lens build-depends: base >=4 && <5, elf >=0.27 - , bytestring-mmap >=0.2, dwarf-el >=0.1 && <0.3, lens >=3.9 && <5 + , bytestring-mmap >=0.2, dwarf-el >=0.2 && <0.3, lens >=3.9 && <4.3 , bytestring >=0.9, containers >= 0.3, transformers >= 0.3 , pretty >= 1.1 ghc-options: -Wall diff --git a/src/Data/Dwarf/ADT.hs b/src/Data/Dwarf/ADT.hs --- a/src/Data/Dwarf/ADT.hs +++ b/src/Data/Dwarf/ADT.hs @@ -7,6 +7,7 @@ , Def(..), DefType(..) , TypeRef(..) , BaseType(..) + , Loc(..) , Typedef(..) , PtrType(..) , ConstType(..) @@ -15,11 +16,14 @@ , SubrangeType(..), ArrayType(..) , EnumerationType(..), Enumerator(..) , SubroutineType(..), FormalParameter(..) + , InlineType(..) , Subprogram(..) , Variable(..) ) where import Control.Applicative (Applicative(..), (<$>)) +import Control.Lens (_1) +import Control.Lens.Operators import Control.Monad (when) import Control.Monad.Fix (MonadFix, mfix) import Control.Monad.Trans.Class (lift) @@ -32,7 +36,7 @@ import Data.Int (Int64) import Data.List (intercalate) import Data.Map (Map) -import Data.Maybe (fromMaybe, maybeToList) +import Data.Maybe (maybeToList) import Data.Traversable (traverse) import Data.Word (Word, Word64) import qualified Control.Monad.Trans.Reader as Reader @@ -237,12 +241,22 @@ , membDecl :: Decl , membLoc :: loc , membType :: TypeRef + , membByteSize :: Maybe Word64 + , membBitSize :: Maybe Word64 + , membBitOffset :: Maybe Word64 } deriving (Eq, Ord, Show) parseMember :: (Dwarf.Reader -> AttrGetterT M loc) -> DIE -> M (Boxed (Member loc)) parseMember getLoc die = box DW_TAG_member die $ - Member <$> getMName <*> getDecl <*> getLoc (dieReader die) <*> parseTypeRef + Member + <$> getMName + <*> getDecl + <*> getLoc (dieReader die) + <*> parseTypeRef + <*> AttrGetter.findAttr DW_AT_byte_size _ATVAL_UINT + <*> AttrGetter.findAttr DW_AT_bit_size _ATVAL_UINT + <*> AttrGetter.findAttr DW_AT_bit_offset _ATVAL_UINT -- DW_AT_name=(DW_ATVAL_STRING "__pthread_mutex_s") -- DW_AT_byte_size=(DW_ATVAL_UINT 24) @@ -256,8 +270,8 @@ , stMembers :: [Boxed (Member Dwarf.DW_OP)] } deriving (Eq, Ord, Show) -getDeclaration :: AttrGetterT M Bool -getDeclaration = fromMaybe False <$> AttrGetter.findAttr DW_AT_declaration _ATVAL_BOOL +flag :: DW_AT -> AttrGetterT M Bool +flag atId = ((Just True ==) <$> AttrGetter.findAttr atId _ATVAL_BOOL) parseStructureType :: [DIE] -> AttrGetterT M StructureType parseStructureType children = @@ -265,7 +279,7 @@ <$> getMName <*> getMByteSize <*> getDecl - <*> getDeclaration + <*> flag DW_AT_declaration <*> mapM (lift . parseMember getLoc) children where getLoc reader = @@ -371,30 +385,39 @@ parseFormalParameter :: DIE -> M (Boxed FormalParameter) parseFormalParameter die = - box DW_TAG_formal_parameter die $ - FormalParameter - <$> getMName - <*> getDecl - <*> (fmap (parseLoc (dieReader die)) <$> AttrGetter.findAttrVal DW_AT_location) - <*> parseTypeRef + box DW_TAG_formal_parameter die $ do + -- for now, ignore abstract origins + _ <- AttrGetter.findAttrVal DW_AT_abstract_origin + FormalParameter + <$> getMName + <*> getDecl + <*> (fmap (parseLoc (dieReader die)) <$> AttrGetter.findAttrVal DW_AT_location) + <*> parseTypeRef -- DW_AT_prototyped=(DW_ATVAL_BOOL True) -- DW_AT_type=(DW_ATVAL_REF (DieID 62)) data SubroutineType = SubroutineType { subrPrototyped :: Bool , subrRetType :: TypeRef + -- TODO: Reduce duplication with subprogram formal params , subrFormalParameters :: [Boxed FormalParameter] + , subrHaveUnspecified :: Bool } deriving (Eq, Ord, Show) -getPrototyped :: AttrGetterT M Bool -getPrototyped = fromMaybe False <$> AttrGetter.findAttr DW_AT_prototyped _ATVAL_BOOL - parseSubroutineType :: [DIE] -> AttrGetterT M SubroutineType -parseSubroutineType children = +parseSubroutineType children = do + (params, haveUnspecified) <- lift (parseParameters children) SubroutineType - <$> getPrototyped - <*> parseTypeRef - <*> mapM (lift . parseFormalParameter) children + <$> flag DW_AT_prototyped + <*> parseTypeRef + <*> pure params + <*> pure haveUnspecified + where + parseParameters [] = pure ([], False) + parseParameters [die] | dieTag die == DW_TAG_unspecified_parameters = pure ([], True) + parseParameters (die:dies) = do + param <- parseFormalParameter die + parseParameters dies <&> _1 %~ (param :) getLowPC :: AttrGetterT M Word64 getLowPC = AttrGetter.getAttr DW_AT_low_pc _ATVAL_UINT @@ -405,6 +428,22 @@ getMHighPC :: AttrGetterT M (Maybe Word64) getMHighPC = AttrGetter.findAttr DW_AT_high_pc _ATVAL_UINT +data InlineType = InlineType + { inlineRequested :: Bool + , inlineHappened :: Bool + } deriving (Eq, Ord, Show) + +parseInlineType :: Word64 -> InlineType +parseInlineType 0 = InlineType False False +parseInlineType 1 = InlineType False True +parseInlineType 2 = InlineType True False +parseInlineType 3 = InlineType True True +parseInlineType n = error $ "Unknown inline type: " ++ show n + +getInlineType :: AttrGetterT M (Maybe InlineType) +getInlineType = + fmap parseInlineType <$> AttrGetter.findAttr DW_AT_inline _ATVAL_UINT + -- DW_AT_name=(DW_ATVAL_STRING "sfs") -- DW_AT_decl_file=(DW_ATVAL_UINT 1) -- DW_AT_decl_line=(DW_ATVAL_UINT 135) @@ -416,29 +455,27 @@ , varLoc :: Maybe Loc , varExternal :: Bool , varDeclaration :: Bool + , varArtificial :: Bool , varType :: TypeRef + , varConstVal :: Maybe Word64 } deriving (Eq, Ord, Show) parseVariable :: Dwarf.Reader -> AttrGetterT M name -> AttrGetterT M (Variable name) -parseVariable reader getVarName = +parseVariable reader getVarName = do + -- for now, ignore abstract origins + _ <- AttrGetter.findAttrVal DW_AT_abstract_origin Variable - <$> getVarName - <*> getDecl - <*> (fmap (parseLoc reader) <$> AttrGetter.findAttrVal DW_AT_location) - <*> getExternal - <*> getDeclaration - <*> parseTypeRef + <$> getVarName + <*> getDecl + <*> (fmap (parseLoc reader) <$> AttrGetter.findAttrVal DW_AT_location) + <*> flag DW_AT_external + <*> flag DW_AT_declaration + <*> flag DW_AT_artificial + <*> parseTypeRef + <*> AttrGetter.findAttr DW_AT_const_value _ATVAL_UINT --- DW_AT_name=(DW_ATVAL_STRING "selinux_enabled_check") --- DW_AT_decl_file=(DW_ATVAL_UINT 1) --- DW_AT_decl_line=(DW_ATVAL_UINT 133) --- DW_AT_prototyped=(DW_ATVAL_BOOL True) --- DW_AT_type=(DW_ATVAL_REF (DieID 62)) --- DW_AT_low_pc=(DW_ATVAL_UINT 135801260) --- DW_AT_high_pc=(DW_ATVAL_UINT 135801563) --- DW_AT_frame_base=(DW_ATVAL_UINT 0) data Subprogram = Subprogram - { subprogName :: String + { subprogName :: Maybe String -- abstract-origin subprograms are anonymous , subprogDecl :: Decl , subprogPrototyped :: Bool , subprogExternal :: Bool @@ -449,6 +486,10 @@ , subprogUnspecifiedParameters :: Bool , subprogVariables :: [Boxed (Variable (Maybe String))] , subprogType :: TypeRef + , subprogInline :: Maybe InlineType + , subprogDeclaration :: Bool + , subprogArtificial :: Bool + , subprogLinkageName :: Maybe String } deriving (Eq, Ord, Show) data SubprogramChild @@ -462,17 +503,18 @@ noChildren DIE{dieChildren=[]} = id noChildren die@DIE{dieChildren=cs} = error $ "Unexpected children: " ++ show cs ++ " in " ++ show die -getExternal :: AttrGetterT M Bool -getExternal = fromMaybe False <$> AttrGetter.findAttr DW_AT_external _ATVAL_BOOL - parseSubprogram :: Dwarf.Reader -> [DIE] -> AttrGetterT M Subprogram parseSubprogram reader children = do parsedChildren <- mapM (lift . parseChild) children + -- for now, ignore abstract origins & GNU extended attr for now + _ <- AttrGetter.findAttrVal $ DW_AT_user 0x2117 + _ <- AttrGetter.findAttrVal $ DW_AT_user 0x2116 + _ <- AttrGetter.findAttrVal DW_AT_abstract_origin Subprogram - <$> getName + <$> getMName <*> getDecl - <*> getPrototyped - <*> getExternal + <*> flag DW_AT_prototyped + <*> flag DW_AT_external <*> getMLowPC <*> getMHighPC <*> (fmap (parseLoc reader) <$> AttrGetter.findAttrVal DW_AT_frame_base) @@ -480,6 +522,10 @@ <*> pure (SubprogramChildUnspecifiedParameters `elem` parsedChildren) <*> pure [x | SubprogramChildVariable x <- parsedChildren] <*> parseTypeRef + <*> getInlineType + <*> flag DW_AT_declaration + <*> flag DW_AT_artificial + <*> AttrGetter.findAttr DW_AT_linkage_name _ATVAL_STRING where parseChild child = case dieTag child of @@ -532,8 +578,8 @@ DW_TAG_subroutine_type -> DefSubroutineType <$> parseSubroutineType (dieChildren die) _ -> error $ "unsupported def type: " ++ show die -parseDefI :: DIE -> M (Boxed Def) -parseDefI die = +parseDef :: DIE -> M (Boxed Def) +parseDef die = case dieTag die of DW_TAG_variable -> mkBox die . noChildren die $ @@ -546,9 +592,6 @@ cachedMake (dieId die) $ parseDefTypeI die -parseDef :: DIE -> M (Boxed Def) -parseDef die = parseDefI die - -- DW_AT_producer=(DW_ATVAL_STRING "GNU C 4.4.5") -- DW_AT_language=(DW_ATVAL_UINT 1) -- DW_AT_name=(DW_ATVAL_STRING "../src/closures.c") @@ -563,6 +606,7 @@ , cuCompDir :: String , cuLowPc :: Word64 , cuHighPc :: Maybe Word64 + , cuMRanges :: Maybe Word64 , cuStmtList :: Word64 -- TODO: Parse this further -- , cuLineNumInfo :: ([String], [Dwarf.DW_LNE]) , cuDefs :: [Boxed Def] @@ -579,6 +623,7 @@ <*> AttrGetter.getAttr DW_AT_comp_dir _ATVAL_STRING <*> getLowPC <*> getMHighPC + <*> AttrGetter.findAttr DW_AT_ranges _ATVAL_UINT <*> AttrGetter.getAttr DW_AT_stmt_list _ATVAL_UINT -- lineNumInfo <*> mapM (lift . parseDef) (dieChildren die) diff --git a/src/Data/Dwarf/ADT/Pretty.hs b/src/Data/Dwarf/ADT/Pretty.hs --- a/src/Data/Dwarf/ADT/Pretty.hs +++ b/src/Data/Dwarf/ADT/Pretty.hs @@ -85,8 +85,9 @@ data Precedence = Prefix | Postfix -paramList :: [Boxed ADT.FormalParameter] -> PP.Doc -paramList params = "(" <> PP.hcat (List.intersperse ", " (map param params)) <> ")" +paramList :: [Boxed ADT.FormalParameter] -> Bool -> PP.Doc +paramList params haveUnspecifiedParams = + "(" <> PP.hcat (List.intersperse ", " (map param params ++ ["..." | haveUnspecifiedParams])) <> ")" where param Boxed @@ -142,8 +143,8 @@ annotate (simplePrecedence Postfix) (<> PP.parens (PP.hcat $ PP.punctuate PP.comma (map (subRange . bData) r))) $ recurseType t DefSubroutineType ADT.SubroutineType - { ADT.subrRetType = t, ADT.subrFormalParameters = params } -> - annotate (simplePrecedence Postfix) (<> paramList params) $ recurseType t + { ADT.subrRetType = t, ADT.subrFormalParameters = params, ADT.subrHaveUnspecified = unspec } -> + annotate (simplePrecedence Postfix) (<> paramList params unspec) $ recurseType t defTypedef :: ADT.Typedef -> PP.Doc defTypedef (ADT.Typedef name _ typeRef) = "typedef " <> ppType (Just name) typeRef @@ -164,9 +165,10 @@ , ADT.subprogFormalParameters = params , ADT.subprogLowPC = lowPC , ADT.subprogHighPC = highPC + , ADT.subprogUnspecifiedParameters = unspec } = PP.hcat - [ ppType (Just name) typ, paramList params + [ ppType name typ, paramList params unspec , " at (", m lowPC, ":", m highPC, ")" ] where @@ -198,7 +200,7 @@ compilationUnit :: Boxed ADT.CompilationUnit -> PP.Doc compilationUnit - (Boxed i (ADT.CompilationUnit producer language name compDir lowPc highPc _stmtList defs)) + (Boxed i (ADT.CompilationUnit producer language name compDir lowPc highPc ranges _stmtList defs)) = PP.vcat [ "Compilation unit at " <> showPP i , indent $ PP.vcat @@ -208,6 +210,7 @@ , "compDir = " <> showPP compDir , "lowPc = " <> showPP lowPc , "highPc = " <> showPP highPc + , "ranges = " <> showPP ranges , "defs = " , " " <> PP.vcat (mapMaybe def defs) ]