packages feed

dwarfadt 0.2.0.0 → 0.3

raw patch · 4 files changed

+102/−54 lines, 4 filesdep ~basedep ~dwarf-eldep ~lens

Dependency ranges changed: base, dwarf-el, lens

Files

dumpdwarf.hs view
@@ -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
dwarfadt.cabal view
@@ -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
src/Data/Dwarf/ADT.hs view
@@ -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)
src/Data/Dwarf/ADT/Pretty.hs view
@@ -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)       ]