GaloisInc/macaw
1
1
Fork 0
mirror of https://github.com/GaloisInc/macaw.git synced 2024-12-03 10:51:25 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into release_2_1_0

Browse Source
This commit is contained in:
Kevin Quick 2020-05-22 01:31:23 -07:00 committed by GitHub
commit 4a56736888
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
macaw-ppc/src/Data/Macaw/PPC/Disassemble.hs
View File

@ -117,7 +117,7 @@ disassembleBlock lookupSemantics gs curIPAddr blockOff maxOffset = do
let seg = MM.segoffSegment curIPAddr let seg = MM.segoffSegment curIPAddr
let off = MM.segoffOffset curIPAddr let off = MM.segoffOffset curIPAddr
case readInstruction curIPAddr of case readInstruction curIPAddr of
Left err -> failAt gs off curIPAddr (DecodeError err) Left err -> failAt gs blockOff curIPAddr (DecodeError err)
Right (i, bytesRead) -> do Right (i, bytesRead) -> do
-- traceM ("II: " ++ show i) -- traceM ("II: " ++ show i)
let nextIPOffset = off + bytesRead let nextIPOffset = off + bytesRead
@ -127,10 +127,10 @@ disassembleBlock lookupSemantics gs curIPAddr blockOff maxOffset = do
-- executes, rather than before as in X86. We have to pass in the -- executes, rather than before as in X86. We have to pass in the
-- physical address of the instruction here. -- physical address of the instruction here.
ipVal <- case MM.asAbsoluteAddr (MM.segoffAddr curIPAddr) of ipVal <- case MM.asAbsoluteAddr (MM.segoffAddr curIPAddr) of
Nothing -> failAt gs off curIPAddr (InstructionAtUnmappedAddr i) Nothing -> failAt gs blockOff curIPAddr (InstructionAtUnmappedAddr i)
Just addr -> return (BVValue (SP.addrWidth SP.knownVariant) (fromIntegral addr)) Just addr -> return (BVValue (SP.addrWidth SP.knownVariant) (fromIntegral addr))
case lookupSemantics ipVal i of case lookupSemantics ipVal i of
Nothing -> failAt gs off curIPAddr (UnsupportedInstruction i) Nothing -> failAt gs blockOff curIPAddr (UnsupportedInstruction i)
Just transformer -> do Just transformer -> do
-- Once we have the semantics for the instruction (represented by a -- Once we have the semantics for the instruction (represented by a
-- state transformer), we apply the state transformer and then extract -- state transformer), we apply the state transformer and then extract
@ -141,7 +141,7 @@ disassembleBlock lookupSemantics gs curIPAddr blockOff maxOffset = do
addStmt (Comment (T.pack lineStr)) addStmt (Comment (T.pack lineStr))
asAtomicStateUpdate (MM.segoffAddr curIPAddr) transformer) asAtomicStateUpdate (MM.segoffAddr curIPAddr) transformer)
case egs1 of case egs1 of
Left genErr -> failAt gs off curIPAddr (GenerationError i genErr) Left genErr -> failAt gs blockOff curIPAddr (GenerationError i genErr)
Right gs1 -> do Right gs1 -> do
case gs1 of case gs1 of
UnfinishedPartialBlock preBlock UnfinishedPartialBlock preBlock
@ -176,7 +176,7 @@ tryDisassembleBlock lookupSemantics nonceGen startAddr regState maxSize = do
(nextIPOffset, block) <- disassembleBlock lookupSemantics gs0 startAddr 0 (startOffset + fromIntegral maxSize) (nextIPOffset, block) <- disassembleBlock lookupSemantics gs0 startAddr 0 (startOffset + fromIntegral maxSize)
unless (nextIPOffset > startOffset) $ do unless (nextIPOffset > startOffset) $ do
let reason = InvalidNextIP (fromIntegral nextIPOffset) (fromIntegral startOffset) let reason = InvalidNextIP (fromIntegral nextIPOffset) (fromIntegral startOffset)
failAt gs0 nextIPOffset startAddr reason failAt gs0 0 startAddr reason
return (block, fromIntegral (nextIPOffset - startOffset)) return (block, fromIntegral (nextIPOffset - startOffset))
-- | Disassemble a block from the given start address (which points into the -- | Disassemble a block from the given start address (which points into the
@ -202,11 +202,11 @@ disassembleFn :: (ppc ~ SP.AnyPPC var, PPCArchConstraints var)
disassembleFn _ lookupSemantics nonceGen startAddr regState maxSize = do disassembleFn _ lookupSemantics nonceGen startAddr regState maxSize = do
mr <- ET.runExceptT (unDisM (tryDisassembleBlock lookupSemantics nonceGen startAddr regState maxSize)) mr <- ET.runExceptT (unDisM (tryDisassembleBlock lookupSemantics nonceGen startAddr regState maxSize))
case mr of case mr of
Left (blocks, off, _exn) -> Left (blocks, bytes, _exn) ->
-- Note that we discard exn here: it is actually extraneous since the -- Note that we discard exn here: it is actually extraneous since the
-- 'failAt' function converts exceptions raised during translation into -- 'failAt' function converts exceptions raised during translation into
-- macaw 'TranslationError' block terminators. -- macaw 'TranslationError' block terminators.
return (blocks, off) return (blocks, bytes)
Right (blocks, bytes) -> return (blocks, bytes) Right (blocks, bytes) -> return (blocks, bytes)
type LocatedError ppc ids = (Block ppc ids, Int, TranslationError (ArchAddrWidth ppc)) type LocatedError ppc ids = (Block ppc ids, Int, TranslationError (ArchAddrWidth ppc))
@ -272,10 +272,10 @@ failAt :: forall v ids s a
-> MM.MemSegmentOff (SP.AddrWidth v) -> MM.MemSegmentOff (SP.AddrWidth v)
-> TranslationErrorReason (SP.AddrWidth v) -> TranslationErrorReason (SP.AddrWidth v)
-> DisM (SP.AnyPPC v) ids s a -> DisM (SP.AnyPPC v) ids s a
failAt gs offset curIPAddr reason = do failAt gs bytesConsumed curIPAddr reason = do
let exn = TranslationError { transErrorAddr = curIPAddr let exn = TranslationError { transErrorAddr = curIPAddr
, transErrorReason = reason , transErrorReason = reason
} }
let term = (`TranslateError` T.pack (show exn)) let term = (`TranslateError` T.pack (show exn))
let b = finishBlock' (gs ^. blockState) term let b = finishBlock' (gs ^. blockState) term
ET.throwError (b, fromIntegral offset, exn) ET.throwError (b, fromIntegral bytesConsumed, exn)