More work on disassemble

This commit is contained in:
Tristan Ravitch 2017-10-02 14:29:15 -07:00
parent 385bff0c4d
commit 7869f0e6c7
2 changed files with 19 additions and 5 deletions

View File

@ -2,9 +2,13 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Macaw.PPC.Disassemble ( disassembleFn ) where module Data.Macaw.PPC.Disassemble ( disassembleFn ) where
import Control.Lens ( (^.) )
import Control.Monad ( unless )
import qualified Control.Monad.Except as ET import qualified Control.Monad.Except as ET
import Control.Monad.ST ( ST ) import Control.Monad.ST ( ST )
import Control.Monad.Trans ( lift ) import Control.Monad.Trans ( lift )
import qualified Data.Foldable as F
import Data.Word ( Word64 )
import Data.Macaw.AbsDomain.AbsState as MA import Data.Macaw.AbsDomain.AbsState as MA
import Data.Macaw.CFG import Data.Macaw.CFG
@ -20,18 +24,26 @@ newtype DisM s a = DisM { unDisM :: ET.ExceptT DisassembleException (ST s) a }
Monad, Monad,
ET.MonadError DisassembleException) ET.MonadError DisassembleException)
data DisassembleException = DisassembleException data DisassembleException = InvalidNextIP Word64 Word64
deriving (Show) deriving (Show)
liftST :: ST s a -> DisM s a liftST :: ST s a -> DisM s a
liftST = DisM . lift liftST = DisM . lift
tryDisassembleBlock :: MM.Memory (ArchAddrWidth ppc) tryDisassembleBlock :: (MM.MemWidth (RegAddrWidth (ArchReg ppc)))
-> NC.NonceGenerator (ST ids) ids => MM.Memory (ArchAddrWidth ppc)
-> NC.NonceGenerator (ST s) s
-> ArchSegmentOff ppc -> ArchSegmentOff ppc
-> ArchAddrWord ppc -> ArchAddrWord ppc
-> DisM s ([Block ppc ids], MM.MemWord (ArchAddrWidth ppc)) -> DisM s ([Block ppc s], MM.MemWord (ArchAddrWidth ppc))
tryDisassembleBlock = undefined tryDisassembleBlock mem nonceGen startAddr maxSize = do
let gs0 = initGenState nonceGen startAddr
let startOffset = MM.msegOffset startAddr
(nextIPOffset, gs1) <- liftST $ runGenerator gs0 $ undefined
unless (nextIPOffset > startOffset) $ do
ET.throwError (InvalidNextIP (fromIntegral nextIPOffset) (fromIntegral startOffset))
let blocks = F.toList (blockSeq gs1 ^. frontierBlocks)
return (blocks, 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
-- 'MM.Memory'). -- 'MM.Memory').

View File

@ -13,11 +13,13 @@ module Data.Macaw.PPC.Generator (
addStmt, addStmt,
addAssignment, addAssignment,
getReg, getReg,
blockSeq,
-- * Lenses -- * Lenses
blockState, blockState,
curPPCState, curPPCState,
pBlockStmts, pBlockStmts,
pBlockState, pBlockState,
frontierBlocks
) where ) where
import Control.Lens import Control.Lens