GaloisInc/macaw
1
1
Fork 0
mirror of https://github.com/GaloisInc/macaw.git synced 2024-12-28 08:34:23 +03:00
Code Issues Projects Releases Wiki Activity

Update Dwarf; add addrListBit.

Browse Source
This commit is contained in:
Joe Hendrix 2017-09-07 13:39:56 -07:00
parent b9eea0e891
commit a4ed0e4ac7
No known key found for this signature in database
GPG Key ID: 8DFA5FF784098C4F
3 changed files with 46 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Data/Macaw/Discovery.hs
View File

@ -189,7 +189,7 @@ rewriteTermStmt tstmt = do
tgtCond <- rewriteValue c
case () of
_ | Just (NotApp cn) <- valueAsApp tgtCond -> do
Branch cn <$> pure f <*> pure t
pure $ Branch cn f t
| otherwise ->
pure $ Branch tgtCond t f
Syscall regs ->

49
src/Data/Macaw/Dwarf.hs
View File

@ -105,6 +105,7 @@ instance Monad m => WarnMonad String (WarnT m) where
------------------------------------------------------------------------
-- Parser
-- | The context needed to read dwarf entries.
data ParserState = ParserState { expectedPointerWidth :: !Word64
-- ^ Number of bytes a pointer is expected to have.
, readerInfo :: !Dwarf.Reader
@ -149,6 +150,7 @@ attributeAsUInt :: DW_ATVAL -> Parser Word64
attributeAsUInt (DW_ATVAL_UINT u) = pure u
attributeAsUInt _ = fail "Could not interpret as UInt"
-- | Parse an attribute as a DIE identifier.
attributeAsDieID :: DW_ATVAL -> Parser DieID
attributeAsDieID (DW_ATVAL_REF r) = pure r
attributeAsDieID _ = fail "Could not interpret as DieID."
@ -397,7 +399,7 @@ data BaseType = BaseTypeDef { baseSize :: !Word64
deriving (Show)
data Member tp = Member { memberName :: !String
, memberDeclLoc :: !DeclLoc
, memberDeclLoc :: !(Maybe DeclLoc)
, memberLoc :: !(Maybe Word64)
, memberType :: tp
}
@ -424,9 +426,11 @@ data EnumDecl = EnumDecl { enumDeclName :: Maybe String
}
deriving (Show)
data SubroutineTypeDecl = SubroutineTypeDecl { fntypePrototyped :: !Bool
, fntypeFormals :: ![DIE]
}
data SubroutineTypeDecl tp
= SubroutineTypeDecl { fntypePrototyped :: !(Maybe Bool)
, fntypeFormals :: ![DIE]
, fntypeType :: !(Maybe tp)
}
deriving (Show)
data Typedef tp = Typedef { typedefName :: !String
@ -463,7 +467,7 @@ data TypeF tp
| UnionType !(UnionDecl tp)
-- ^ Denotes a C union
| EnumType !EnumDecl
| SubroutinePtrType !SubroutineTypeDecl
| SubroutinePtrType !(SubroutineTypeDecl tp)
| TypedefType !(Typedef tp)
deriving (Show)
@ -476,10 +480,12 @@ unionMembersLens = lens unionMembers (\s v -> s { unionMembers = v })
memberTypeLens :: Lens (Member a) (Member b) a b
memberTypeLens = lens memberType (\s v -> s { memberType = v })
subroutineTypeLens :: Lens (SubroutineTypeDecl a) (SubroutineTypeDecl b) (Maybe a) (Maybe b)
subroutineTypeLens = lens fntypeType (\s v -> s { fntypeType = v })
typedefTypeLens :: Lens (Typedef a) (Typedef b) a b
typedefTypeLens = lens typedefType (\s v -> s { typedefType = v })
traverseSubtypes :: Traversal (TypeF a) (TypeF b) a b
traverseSubtypes f tf =
case tf of
@ -495,7 +501,7 @@ traverseSubtypes f tf =
StructType s -> StructType <$> (structMembersLens . traverse . memberTypeLens) f s
UnionType u -> UnionType <$> (unionMembersLens . traverse . memberTypeLens) f u
EnumType e -> pure (EnumType e)
SubroutinePtrType d -> pure (SubroutinePtrType d)
SubroutinePtrType d -> SubroutinePtrType <$> (subroutineTypeLens . traverse) f d
TypedefType tp -> TypedefType <$> typedefTypeLens f tp
parseMember :: V.Vector FilePath -> DIE -> Parser (Member DieID)
@ -504,10 +510,15 @@ parseMember file_vec d = runDIEParser "parseMember" d $ do
name <- getSingleAttribute DW_AT_name attributeAsString
tp <- getSingleAttribute DW_AT_type attributeAsDieID
memLoc <- getMaybeAttribute DW_AT_data_member_location attributeAsUInt
declLoc <- parseDeclLoc file_vec
artificial <- fromMaybe False <$> getMaybeAttribute DW_AT_artificial attributeAsBool
mdloc <-
if artificial then
pure Nothing
else
Just <$> parseDeclLoc file_vec
pure $! Member { memberName = name
, memberDeclLoc = declLoc
, memberDeclLoc = mdloc
, memberLoc = memLoc
, memberType = tp
}
@ -526,7 +537,7 @@ data PreType
| ConstTypeF !DieID
-- ^ A const value with the given die ID.
| VolatileTypeF !DieID
| SubroutineTypeF !SubroutineTypeDecl
| SubroutineTypeF !(SubroutineTypeDecl DieID)
-- | A type parser takes the file vector and returns either a `TypeF` or `Nothing`.
--
@ -639,13 +650,18 @@ parseEnumerationType file_vec = do
}
pure $ PreTypeF $ EnumType e
-- | Parse a subroutine type.
parseSubroutineType :: TypeParser
parseSubroutineType _ = do
proto <- getSingleAttribute DW_AT_prototyped attributeAsBool
proto <- getMaybeAttribute DW_AT_prototyped attributeAsBool
ignoreAttribute DW_AT_sibling
formals <- parseChildrenList DW_TAG_formal_parameter pure
tp <- getMaybeAttribute DW_AT_type attributeAsDieID
let sub = SubroutineTypeDecl { fntypePrototyped = proto
, fntypeFormals = formals
, fntypeFormals = formals
, fntypeType = tp
}
pure $ SubroutineTypeF sub
@ -663,6 +679,7 @@ typeParsers = Map.fromList
, (,) DW_TAG_subroutine_type parseSubroutineType
]
-- | Parse a type given a vector identifying file vectors.
parseTypeMap :: V.Vector FilePath -> DIEParser (Map DieID Type)
parseTypeMap file_vec = do
let go :: (DW_TAG, TypeParser) -> DIEParser [(DieID, PreType)]
@ -719,7 +736,7 @@ resolveTypeMap m = r
resolve :: PreType -> Maybe Type
resolve (PreTypeF (PointerType (Just d)))
| Just (SubroutineTypeF decl) <- Map.lookup d premap =
Just $ Type { typeF = SubroutinePtrType decl
Just $ Type { typeF = SubroutinePtrType (decl & subroutineTypeLens . traverse %~ g)
, typeIsConst = False
, typeIsVolatile = False
}
@ -919,7 +936,7 @@ parseSubprogram file_vec typeMap d = runDIEParser "parseSubprogram" d $ do
Just <$> parseSubprogramDef file_vec typeMap
name <- getSingleAttribute DW_AT_name attributeAsString
prototyped <- getSingleAttribute DW_AT_prototyped attributeAsBool
prototyped <- getMaybeAttribute DW_AT_prototyped attributeAsBool
artificial <- fromMaybe False <$> getMaybeAttribute DW_AT_artificial attributeAsBool
mloc <-
if artificial then
@ -936,12 +953,14 @@ parseSubprogram file_vec typeMap d = runDIEParser "parseSubprogram" d $ do
ignoreAttribute DW_AT_type
ignoreChild DW_TAG_formal_parameter
ignoreChild DW_TAG_label
ignoreChild DW_TAG_lexical_block
ignoreChild DW_TAG_unspecified_parameters
pure Subprogram { subExternal = ext
, subName = name
, subDeclLoc = mloc
, subPrototyped = prototyped
, subPrototyped = fromMaybe False prototyped
, subDef = def
, subVars = Map.fromList [ (varDieID v, v) | v <- vars ]
}

14
src/Data/Macaw/Memory.hs
View File

@ -72,6 +72,7 @@ module Data.Macaw.Memory
, asSegmentOff
, diffAddr
, incAddr
, addrLeastBit
, clearAddrLeastBit
-- * Reading
, MemoryError(..)
@ -190,6 +191,8 @@ bsWord64le bs
-- | This represents a particular numeric address in memory.
--
-- Internally, the address is stored with all bits greater than the
-- width equal to 0.
newtype MemWord (w :: Nat) = MemWord { _memWordValue :: Word64 }
instance Show (MemWord w) where
@ -679,11 +682,16 @@ viewAddr (AbsoluteAddr addr) = Left addr
viewAddr (RelativeAddr seg off) = Right (seg,off)
-- | Clear the least significant bit of an address.
clearAddrLeastBit :: MemWidth w => MemAddr w -> MemAddr w
clearAddrLeastBit :: MemAddr w -> MemAddr w
clearAddrLeastBit sa =
case sa of
AbsoluteAddr a -> AbsoluteAddr (a .&. complement 1)
RelativeAddr seg off -> RelativeAddr seg (off .&. complement 1)
AbsoluteAddr (MemWord a) -> AbsoluteAddr (MemWord (a .&. complement 1))
RelativeAddr seg (MemWord off) -> RelativeAddr seg (MemWord (off .&. complement 1))
-- | Return True if least-significant bit in addr is set.
addrLeastBit :: MemAddr w -> Bool
addrLeastBit (AbsoluteAddr (MemWord a)) = a `testBit` 0
addrLeastBit (RelativeAddr _ (MemWord off)) = off `testBit` 0
-- | Increment an address by a fixed amount.
incAddr :: MemWidth w => Integer -> MemAddr w -> MemAddr w