mirror of
https://github.com/GaloisInc/macaw.git
synced 2024-12-26 07:33:33 +03:00
Implement more of the PPCGenerator state
This commit is contained in:
Tristan Ravitch
parent
2ec88811c5
commit
adf8a46f91
@ -6,7 +6,6 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
module Data.Macaw.PPC (
|
||||
ppc_linux_info,
|
||||
ppc32_linux_info,
|
||||
ppc64_linux_info
|
||||
) where
|
||||
@ -49,18 +48,7 @@ jumpTableEntrySize :: proxy ppc -> MM.MemWord (ArchAddrWidth ppc)
|
||||
jumpTableEntrySize = undefined
|
||||
|
||||
ppc64_linux_info :: MI.ArchitectureInfo PPC64.PPC
|
||||
ppc64_linux_info = ppc_linux_info (Proxy @PPC64.PPC) undefined
|
||||
|
||||
ppc32_linux_info :: MI.ArchitectureInfo PPC32.PPC
|
||||
ppc32_linux_info = ppc_linux_info (Proxy @PPC32.PPC) undefined
|
||||
|
||||
ppc_linux_info :: (ArchWidth ppc,
|
||||
ArchReg ppc ~ PPCReg ppc,
|
||||
MM.MemWidth (RegAddrWidth (ArchReg ppc)))
|
||||
=> proxy ppc
|
||||
-> (forall s . Value ppc s (MT.BVType (ArchAddrWidth ppc)) -> D.Instruction -> Maybe (PPCGenerator ppc s ()))
|
||||
-> MI.ArchitectureInfo ppc
|
||||
ppc_linux_info proxy lookupSemantics =
|
||||
ppc64_linux_info =
|
||||
MI.ArchitectureInfo { MI.withArchConstraints = undefined
|
||||
, MI.archAddrWidth = undefined
|
||||
, MI.archEndianness = MM.BigEndian
|
||||
@ -78,3 +66,30 @@ ppc_linux_info proxy lookupSemantics =
|
||||
, MI.rewriteArchTermStmt = rewriteArchTermStmt proxy
|
||||
, MI.archDemandContext = archDemandContext proxy
|
||||
}
|
||||
where
|
||||
proxy = Proxy @PPC64.PPC
|
||||
lookupSemantics = undefined
|
||||
|
||||
ppc32_linux_info :: MI.ArchitectureInfo PPC32.PPC
|
||||
ppc32_linux_info =
|
||||
MI.ArchitectureInfo { MI.withArchConstraints = undefined
|
||||
, MI.archAddrWidth = undefined
|
||||
, MI.archEndianness = MM.BigEndian
|
||||
, MI.jumpTableEntrySize = jumpTableEntrySize proxy
|
||||
, MI.disassembleFn = disassembleFn proxy lookupSemantics
|
||||
, MI.preserveRegAcrossSyscall = preserveRegAcrossSyscall proxy
|
||||
, MI.mkInitialAbsState = mkInitialAbsState proxy
|
||||
, MI.absEvalArchFn = absEvalArchFn proxy
|
||||
, MI.absEvalArchStmt = absEvalArchStmt proxy
|
||||
, MI.postCallAbsState = postCallAbsState proxy
|
||||
, MI.identifyCall = identifyCall proxy
|
||||
, MI.identifyReturn = identifyReturn proxy
|
||||
, MI.rewriteArchFn = rewriteArchFn proxy
|
||||
, MI.rewriteArchStmt = rewriteArchStmt proxy
|
||||
, MI.rewriteArchTermStmt = rewriteArchTermStmt proxy
|
||||
, MI.archDemandContext = archDemandContext proxy
|
||||
}
|
||||
where
|
||||
proxy = Proxy @PPC32.PPC
|
||||
lookupSemantics = undefined
|
||||
|
||||
|
||||
@ -10,6 +10,8 @@
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module Data.Macaw.PPC.Disassemble ( disassembleFn ) where
|
||||
|
||||
import GHC.TypeLits
|
||||
|
||||
import Control.Lens ( (&), (^.), (%~) )
|
||||
import Control.Monad ( unless )
|
||||
import qualified Control.Monad.Except as ET
|
||||
@ -102,7 +104,7 @@ disassembleBlock lookupSemantics mem gs curIPAddr maxOffset = do
|
||||
Left genErr -> failAt gs off curIPAddr (GenerationError i genErr)
|
||||
Right gs1 -> undefined
|
||||
|
||||
tryDisassembleBlock :: (ArchWidth ppc, ArchReg ppc ~ PPCReg ppc, MM.MemWidth (ArchAddrWidth ppc))
|
||||
tryDisassembleBlock :: (ArchWidth ppc, ArchReg ppc ~ PPCReg ppc, MM.MemWidth (ArchAddrWidth ppc), KnownNat (RegAddrWidth (PPCReg ppc)))
|
||||
=> (Value ppc s (BVType (ArchAddrWidth ppc)) -> D.Instruction -> Maybe (PPCGenerator ppc s ()))
|
||||
-> MM.Memory (ArchAddrWidth ppc)
|
||||
-> NC.NonceGenerator (ST s) s
|
||||
@ -110,7 +112,7 @@ tryDisassembleBlock :: (ArchWidth ppc, ArchReg ppc ~ PPCReg ppc, MM.MemWidth (Ar
|
||||
-> ArchAddrWord ppc
|
||||
-> DisM ppc s ([Block ppc s], MM.MemWord (ArchAddrWidth ppc))
|
||||
tryDisassembleBlock lookupSemantics mem nonceGen startAddr maxSize = do
|
||||
let gs0 = initGenState nonceGen startAddr
|
||||
let gs0 = initGenState nonceGen startAddr (initRegState startAddr)
|
||||
let startOffset = MM.msegOffset startAddr
|
||||
(nextIPOffset, gs1) <- disassembleBlock lookupSemantics mem gs0 startAddr (startOffset + maxSize)
|
||||
unless (nextIPOffset > startOffset) $ do
|
||||
@ -124,7 +126,7 @@ tryDisassembleBlock lookupSemantics mem nonceGen startAddr maxSize = do
|
||||
--
|
||||
-- Return a list of disassembled blocks as well as the total number of bytes
|
||||
-- occupied by those blocks.
|
||||
disassembleFn :: (ArchWidth ppc, ArchReg ppc ~ PPCReg ppc, MM.MemWidth (RegAddrWidth (ArchReg ppc)))
|
||||
disassembleFn :: (ArchWidth ppc, ArchReg ppc ~ PPCReg ppc, MM.MemWidth (RegAddrWidth (ArchReg ppc)), KnownNat (RegAddrWidth (PPCReg ppc)))
|
||||
=> proxy ppc
|
||||
-> (Value ppc s (BVType (ArchAddrWidth ppc)) -> D.Instruction -> Maybe (PPCGenerator ppc s ()))
|
||||
-- ^ A function to look up the semantics for an instruction. The
|
||||
|
||||
@ -1,10 +1,13 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
module Data.Macaw.PPC.Generator (
|
||||
GenResult(..),
|
||||
GenState,
|
||||
initGenState,
|
||||
initRegState,
|
||||
PPCGenerator,
|
||||
runGenerator,
|
||||
execGenerator,
|
||||
@ -25,6 +28,8 @@ module Data.Macaw.PPC.Generator (
|
||||
GeneratorError(..)
|
||||
) where
|
||||
|
||||
import GHC.TypeLits
|
||||
|
||||
import Control.Lens
|
||||
import qualified Control.Monad.Except as ET
|
||||
import Control.Monad.ST ( ST )
|
||||
@ -37,6 +42,7 @@ import Data.Macaw.CFG
|
||||
import Data.Macaw.CFG.Block
|
||||
import qualified Data.Macaw.Memory as MM
|
||||
import qualified Data.Parameterized.Map as MapF
|
||||
import qualified Data.Parameterized.NatRepr as NR
|
||||
import qualified Data.Parameterized.Nonce as NC
|
||||
|
||||
import Data.Macaw.PPC.PPCReg
|
||||
@ -102,14 +108,33 @@ data GenState ppc s =
|
||||
|
||||
initGenState :: NC.NonceGenerator (ST s) s
|
||||
-> MM.MemSegmentOff (ArchAddrWidth ppc)
|
||||
-> RegState (PPCReg ppc) (Value ppc s)
|
||||
-> GenState ppc s
|
||||
initGenState nonceGen addr =
|
||||
initGenState nonceGen addr st =
|
||||
GenState { assignIdGen = nonceGen
|
||||
, blockSeq = BlockSeq { _nextBlockID = 0, _frontierBlocks = Seq.empty }
|
||||
, _blockState = undefined
|
||||
, _blockState = emptyPreBlock st 0 addr
|
||||
, genAddr = addr
|
||||
}
|
||||
|
||||
initRegState :: (KnownNat (RegAddrWidth (PPCReg ppc)), ArchReg ppc ~ PPCReg ppc, 1 <= RegAddrWidth (PPCReg ppc), MM.MemWidth (RegAddrWidth (PPCReg ppc)), ArchWidth ppc)
|
||||
=> ArchSegmentOff ppc
|
||||
-> RegState (PPCReg ppc) (Value ppc s)
|
||||
initRegState startIP = mkRegState Initial
|
||||
& curIP .~ RelocatableValue NR.knownNat (MM.relativeSegmentAddr startIP)
|
||||
|
||||
emptyPreBlock :: RegState (PPCReg ppc) (Value ppc s)
|
||||
-> Word64
|
||||
-> MM.MemSegmentOff (RegAddrWidth (ArchReg ppc))
|
||||
-> PreBlock ppc s
|
||||
emptyPreBlock s0 idx addr =
|
||||
PreBlock { pBlockIndex = idx
|
||||
, pBlockAddr = addr
|
||||
, _pBlockStmts = Seq.empty
|
||||
, _pBlockState = s0
|
||||
, pBlockApps = MapF.empty
|
||||
}
|
||||
|
||||
blockState :: Simple Lens (GenState ppc s) (PreBlock ppc s)
|
||||
blockState = lens _blockState (\s v -> s { _blockState = v })
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user