Memory interface renamings.

This commit is contained in:
Joe Hendrix 2018-01-29 11:05:19 -08:00
parent e1e558239e
commit 7e144a51f4
No known key found for this signature in database
GPG Key ID: 8DFA5FF784098C4F
5 changed files with 63 additions and 48 deletions

View File

@ -428,7 +428,7 @@ summarizeCall :: forall arch ids
-> FunctionArgsM arch ids ()
summarizeCall mem lbl proc_state isTailCall = do
knownAddrs <- gets computedAddrSet
case asLiteralAddr (proc_state^.boundValue ip_reg) of
case valueAsMemAddr (proc_state^.boundValue ip_reg) of
Just faddr0
| Just faddr <- asSegmentOff mem faddr0
, Set.member faddr knownAddrs -> do

View File

@ -34,6 +34,8 @@ module Data.Macaw.CFG.Core
, BVValue
, valueAsApp
, valueAsArchFn
, valueAsMemAddr
, valueAsSegmentOff
, asLiteralAddr
, asBaseOffset
, asInt64Constant
@ -112,8 +114,7 @@ import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
import qualified Text.PrettyPrint.ANSI.Leijen as PP
import Data.Macaw.CFG.App
import Data.Macaw.Memory ( MemWord, MemWidth, MemAddr, MemSegmentOff, Endianness(..)
, absoluteAddr)
import Data.Macaw.Memory
import Data.Macaw.Types
import Data.Macaw.Utils.Pretty
@ -446,12 +447,27 @@ valueAsArchFn _ = Nothing
-- | This returns a segmented address if the value can be interpreted as a literal memory
-- address, and returns nothing otherwise.
valueAsMemAddr :: MemWidth (ArchAddrWidth arch)
=> BVValue arch ids (ArchAddrWidth arch)
-> Maybe (ArchMemAddr arch)
valueAsMemAddr (BVValue _ val) = Just $ absoluteAddr (fromInteger val)
valueAsMemAddr (RelocatableValue _ i) = Just i
valueAsMemAddr _ = Nothing
asLiteralAddr :: MemWidth (ArchAddrWidth arch)
=> BVValue arch ids (ArchAddrWidth arch)
-> Maybe (ArchMemAddr arch)
asLiteralAddr (BVValue _ val) = Just $ absoluteAddr (fromInteger val)
asLiteralAddr (RelocatableValue _ i) = Just i
asLiteralAddr _ = Nothing
=> BVValue arch ids (ArchAddrWidth arch)
-> Maybe (ArchMemAddr arch)
asLiteralAddr = valueAsMemAddr
{-# DEPRECATED asLiteralAddr "Use valueAsMemAddr" #-}
-- | Returns a segment offset associated with the value if one can be defined.
valueAsSegmentOff :: Memory (ArchAddrWidth arch)
-> BVValue arch ids (ArchAddrWidth arch)
-> Maybe (ArchSegmentOff arch)
valueAsSegmentOff mem v = do
a <- addrWidthClass (memAddrWidth mem) (valueAsMemAddr v)
asSegmentOff mem a
asInt64Constant :: Value arch ids (BVType 64) -> Maybe Int64
asInt64Constant (BVValue _ o) = Just (fromInteger o)

View File

@ -215,15 +215,13 @@ eliminateDeadStmts ainfo bs0 = elimDeadStmtsInBlock demandSet <$> bs0
-- Memory utilities
-- | Return true if range is entirely contained within a single read only segment.Q
rangeInReadonlySegment :: Memory w
-> MemAddr w -- ^ Start of range
rangeInReadonlySegment :: MemWidth w
=> MemSegmentOff w -- ^ Start of range
-> MemWord w -- ^ The size of the range
-> Bool
rangeInReadonlySegment mem base size = addrWidthClass (memAddrWidth mem) $
case asSegmentOff mem base of
Just mseg -> size <= segmentSize (msegSegment mseg) - msegOffset mseg
&& Perm.isReadonly (segmentFlags (msegSegment mseg))
Nothing -> False
rangeInReadonlySegment mseg size =
size <= segmentSize (msegSegment mseg) - msegOffset mseg
&& Perm.isReadonly (segmentFlags (msegSegment mseg))
------------------------------------------------------------------------
-- DiscoveryState utilities
@ -390,17 +388,16 @@ mergeIntraJump src ab tgt = do
matchJumpTable :: MemWidth (ArchAddrWidth arch)
=> Memory (ArchAddrWidth arch)
-> BVValue arch ids (ArchAddrWidth arch) -- ^ Memory address that IP is read from.
-> Maybe (ArchMemAddr arch, BVValue arch ids (ArchAddrWidth arch))
-> Maybe (ArchSegmentOff arch, BVValue arch ids (ArchAddrWidth arch))
matchJumpTable mem read_addr
-- Turn the read address into base + offset.
| Just (BVAdd _ offset base_val) <- valueAsApp read_addr
, Just base <- asLiteralAddr base_val
, Just mseg <- valueAsSegmentOff mem base_val
-- Turn the offset into a multiple by an index.
, Just (BVMul _ (BVValue _ mul) jump_index) <- valueAsApp offset
, mul == toInteger (addrSize (memAddrWidth mem))
, Just mseg <- asSegmentOff mem base
, Perm.isReadonly (segmentFlags (msegSegment mseg)) = do
Just (base, jump_index)
Just (mseg, jump_index)
matchJumpTable _ _ =
Nothing
@ -430,16 +427,15 @@ showJumpTableBoundsError err =
-- not a block table.
getJumpTableBounds :: ArchitectureInfo a
-> AbsProcessorState (ArchReg a) ids -- ^ Current processor registers.
-> ArchMemAddr a -- ^ Base
-> ArchSegmentOff a -- ^ Base
-> BVValue a ids (ArchAddrWidth a) -- ^ Index in jump table
-> Either (JumpTableBoundsError a ids) (ArchAddrWord a)
-- ^ One past last index in jump table or nothing
getJumpTableBounds info regs base jump_index = withArchConstraints info $
case transferValue regs jump_index of
StridedInterval (SI.StridedInterval _ index_base index_range index_stride) -> do
let mem = absMem regs
let index_end = index_base + (index_range + 1) * index_stride
if rangeInReadonlySegment mem base (jumpTableEntrySize info * fromInteger index_end) then
if rangeInReadonlySegment base (jumpTableEntrySize info * fromInteger index_end) then
case Jmp.unsignedUpperBound (regs^.indexBounds) jump_index of
Right (Jmp.IntegerUpperBound bnd) | bnd == index_range -> Right $! fromInteger index_end
Right bnd -> Left (UpperBoundMismatch bnd index_range)
@ -536,7 +532,7 @@ identifyCallTargets absState ip = do
case assignRhs a of
-- See if we can get a value out of a concrete memory read.
ReadMem addr (BVMemRepr _ end)
| Just laddr <- asLiteralAddr addr
| Just laddr <- valueAsMemAddr addr
, Right val <- readAddr mem end laddr ->
segOffAddrs (asSegmentOff mem val) ++ def
_ -> def
@ -591,7 +587,7 @@ parseFetchAndExecute ctx lbl_idx stmts regs s' = do
}
-- Jump to a block within this function.
| Just tgt_mseg <- asSegmentOff mem =<< asLiteralAddr (s'^.boundValue ip_reg)
| Just tgt_mseg <- asSegmentOff mem =<< valueAsMemAddr (s'^.boundValue ip_reg)
, segmentFlags (msegSegment tgt_mseg) `Perm.hasPerm` Perm.execute
-- The target address cannot be this function entry point.
--
@ -647,7 +643,7 @@ parseFetchAndExecute ctx lbl_idx stmts regs s' = do
-- Stop jump table when we have reached computed bounds.
return (reverse prev)
resolveJump prev idx = do
let read_addr = base & incAddr (toInteger (8 * idx))
let read_addr = relativeSegmentAddr base & incAddr (toInteger (8 * idx))
case readAddr mem (archEndianness arch_info) read_addr of
Right tgt_addr
| Just read_mseg <- asSegmentOff mem read_addr
@ -679,7 +675,7 @@ parseFetchAndExecute ctx lbl_idx stmts regs s' = do
-- "identifyCall" case, so this must be a tail call, assuming we trust our
-- known function entry info.
| pctxTrustKnownFns ctx
, Just tgt_mseg <- asSegmentOff mem =<< asLiteralAddr (s'^.boundValue ip_reg)
, Just tgt_mseg <- valueAsSegmentOff mem (s'^.boundValue ip_reg)
, tgt_mseg `elem` pctxKnownFnEntries ctx ->
finishWithTailCall absProcState'

View File

@ -387,7 +387,7 @@ dropSegmentRangeListBytes [] _ =
-- SegmentContents
-- | A sequence of values in the segment.
newtype SegmentContents w = SegmentContents (Map.Map (MemWord w) (SegmentRange w))
newtype SegmentContents w = SegmentContents { segContentsMap :: Map.Map (MemWord w) (SegmentRange w) }
-- | Create the segment contents from a list of ranges.
contentsFromList :: MemWidth w => [SegmentRange w] -> SegmentContents w
@ -402,22 +402,24 @@ contentsSize (SegmentContents m) =
-- | Return list of contents from given word or 'Nothing' if this can't be done
-- due to a relocation.
contentsAfter :: MemWidth w
=> MemWord w
-> SegmentContents w
-> Maybe [SegmentRange w]
contentsAfter off (SegmentContents m) = do
let (premap,mv,post) = Map.splitLookup off m
contentsAfterSegmentOff :: MemWidth w
=> MemSegmentOff w
-> Either (MemoryError w) [SegmentRange w]
contentsAfterSegmentOff mseg = do
let off = msegOffset mseg
let contents = segmentContents (msegSegment mseg)
let (premap,mv,post) = Map.splitLookup off (segContentsMap contents)
case mv of
Just v -> Just $ v : Map.elems post
Just v -> Right $ v : Map.elems post
Nothing ->
case Map.maxViewWithKey premap of
Nothing | off == 0 -> Just []
| otherwise -> error $ "Memory.contentsAfter invalid contents"
Just ((pre_off, ByteRegion bs),_) ->
Nothing | off == 0 -> Right []
| otherwise -> error $ "Memory.contentsAfterSegmentOff invalid contents"
Just ((pre_off, ByteRegion bs),_) -> do
let v = ByteRegion (BS.drop (fromIntegral (off - pre_off)) bs)
in Just $ v : Map.elems post
Just ((_, SymbolicRef{}),_) -> Nothing
Right $ v : Map.elems post
Just ((_, SymbolicRef{}),_) ->
Left (UnexpectedRelocation (relativeSegmentAddr mseg))
contentsList :: SegmentContents w -> [(MemWord w, SegmentRange w)]
contentsList (SegmentContents m) = Map.toList m
@ -776,19 +778,20 @@ data MemSymbol w = MemSymbol { memSymbolName :: !BS.ByteString
------------------------------------------------------------------------
-- Memory reading utilities
resolveMemAddr :: Memory w -> MemAddr w -> Either (MemoryError w) (MemSegmentOff w)
resolveMemAddr mem addr =
case asSegmentOff mem addr of
Just p -> Right p
Nothing -> Left (InvalidAddr addr)
-- | Return contents starting from location or throw a memory error if there
-- is an unaligned relocation.
addrContentsAfter :: Memory w
-> MemAddr w
-> Either (MemoryError w) [SegmentRange w]
addrContentsAfter mem addr = addrWidthClass (memAddrWidth mem) $ do
MemSegmentOff seg off <-
case asSegmentOff mem addr of
Just p -> pure p
Nothing -> Left (InvalidAddr addr)
case contentsAfter off (segmentContents seg) of
Just l -> Right l
Nothing -> Left (UnexpectedRelocation addr)
addrContentsAfter mem addr = do
addrWidthClass (memAddrWidth mem) $
contentsAfterSegmentOff =<< resolveMemAddr mem addr
-- | Attemtp to read a bytestring of the given length
readByteString :: Memory w -> MemAddr w -> Word64 -> Either (MemoryError w) BS.ByteString

View File

@ -427,7 +427,7 @@ identifyX86Call mem stmts0 s = go (Seq.fromList stmts0) Seq.empty
-- Check this is the right length.
, Just Refl <- testEquality (typeRepr next_sp) (typeRepr val)
-- Check if value is a valid literal address
, Just val_a <- asLiteralAddr val
, Just val_a <- valueAsMemAddr val
-- Check if segment of address is marked as executable.
, Just ret_addr <- asSegmentOff mem val_a
, segmentFlags (msegSegment ret_addr) `Perm.hasPerm` Perm.execute ->