mirror of
https://github.com/GaloisInc/macaw.git
synced 2024-12-28 08:34:23 +03:00
Memory interface renamings.
This commit is contained in:
parent
e1e558239e
commit
7e144a51f4
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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'
|
||||
|
||||
|
@ -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
|
||||
|
@ -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 ->
|
||||
|
Loading…
Reference in New Issue
Block a user