mirror of
https://github.com/GaloisInc/macaw.git
synced 2024-12-24 22:53:43 +03:00
Add arch-specific decls + type instances + rewriters
This also lets us add 'withArchConstraints' easily.
This commit is contained in:
parent
8a1195b1c6
commit
a851cddebd
@ -17,6 +17,7 @@ cabal-version: >=1.10
|
||||
|
||||
library
|
||||
exposed-modules: Data.Macaw.PPC
|
||||
Data.Macaw.PPC.Arch
|
||||
Data.Macaw.PPC.Disassemble
|
||||
Data.Macaw.PPC.Eval
|
||||
Data.Macaw.PPC.Generator
|
||||
@ -35,6 +36,7 @@ library
|
||||
semmc-ppc,
|
||||
lens,
|
||||
macaw-base,
|
||||
ansi-wl-pprint,
|
||||
mtl,
|
||||
parameterized-utils
|
||||
hs-source-dirs: src
|
||||
|
@ -16,9 +16,7 @@ import qualified Data.Macaw.Architecture.Info as MI
|
||||
import Data.Macaw.CFG
|
||||
import qualified Data.Macaw.CFG.DemandSet as MDS
|
||||
import qualified Data.Macaw.Memory as MM
|
||||
import qualified Data.Macaw.Types as MT
|
||||
|
||||
import qualified Dismantle.PPC as D
|
||||
import qualified SemMC.Architecture.PPC32 as PPC32
|
||||
import qualified SemMC.Architecture.PPC64 as PPC64
|
||||
|
||||
@ -32,10 +30,7 @@ import Data.Macaw.PPC.Eval ( mkInitialAbsState,
|
||||
import Data.Macaw.PPC.Identify ( identifyCall,
|
||||
identifyReturn
|
||||
)
|
||||
import Data.Macaw.PPC.Rewrite ( rewriteArchFn,
|
||||
rewriteArchStmt,
|
||||
rewriteArchTermStmt
|
||||
)
|
||||
import Data.Macaw.PPC.Arch ( rewriteTermStmt, rewriteStmt, rewritePrimFn )
|
||||
|
||||
archDemandContext :: proxy ppc -> MDS.DemandContext ppc ids
|
||||
archDemandContext = undefined
|
||||
@ -47,7 +42,7 @@ jumpTableEntrySize = undefined
|
||||
|
||||
ppc64_linux_info :: MI.ArchitectureInfo PPC64.PPC
|
||||
ppc64_linux_info =
|
||||
MI.ArchitectureInfo { MI.withArchConstraints = undefined
|
||||
MI.ArchitectureInfo { MI.withArchConstraints = \x -> x
|
||||
, MI.archAddrWidth = MM.Addr64
|
||||
, MI.archEndianness = MM.BigEndian
|
||||
, MI.jumpTableEntrySize = jumpTableEntrySize proxy
|
||||
@ -59,9 +54,9 @@ ppc64_linux_info =
|
||||
, 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.rewriteArchFn = rewritePrimFn
|
||||
, MI.rewriteArchStmt = rewriteStmt
|
||||
, MI.rewriteArchTermStmt = rewriteTermStmt
|
||||
, MI.archDemandContext = archDemandContext proxy
|
||||
}
|
||||
where
|
||||
@ -70,7 +65,7 @@ ppc64_linux_info =
|
||||
|
||||
ppc32_linux_info :: MI.ArchitectureInfo PPC32.PPC
|
||||
ppc32_linux_info =
|
||||
MI.ArchitectureInfo { MI.withArchConstraints = undefined
|
||||
MI.ArchitectureInfo { MI.withArchConstraints = \x -> x
|
||||
, MI.archAddrWidth = MM.Addr32
|
||||
, MI.archEndianness = MM.BigEndian
|
||||
, MI.jumpTableEntrySize = jumpTableEntrySize proxy
|
||||
@ -82,9 +77,9 @@ ppc32_linux_info =
|
||||
, 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.rewriteArchFn = rewritePrimFn
|
||||
, MI.rewriteArchStmt = rewriteStmt
|
||||
, MI.rewriteArchTermStmt = rewriteTermStmt
|
||||
, MI.archDemandContext = archDemandContext proxy
|
||||
}
|
||||
where
|
||||
|
96
macaw-ppc/src/Data/Macaw/PPC/Arch.hs
Normal file
96
macaw-ppc/src/Data/Macaw/PPC/Arch.hs
Normal file
@ -0,0 +1,96 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
module Data.Macaw.PPC.Arch (
|
||||
PPCTermStmt(..),
|
||||
rewriteTermStmt,
|
||||
PPCStmt(..),
|
||||
rewriteStmt,
|
||||
PPCPrimFn(..),
|
||||
rewritePrimFn
|
||||
) where
|
||||
|
||||
import qualified Text.PrettyPrint.ANSI.Leijen as PP
|
||||
import qualified Data.Parameterized.TraversableFC as FC
|
||||
import qualified Data.Macaw.CFG as MC
|
||||
import Data.Macaw.CFG.Rewriter ( Rewriter, rewriteValue, evalRewrittenArchFn )
|
||||
import qualified Data.Macaw.Types as MT
|
||||
|
||||
import qualified SemMC.Architecture.PPC32 as PPC32
|
||||
import qualified SemMC.Architecture.PPC64 as PPC64
|
||||
|
||||
import Data.Macaw.PPC.PPCReg
|
||||
|
||||
data PPCTermStmt ids where
|
||||
PPCSyscall :: PPCTermStmt ids
|
||||
|
||||
type instance MC.ArchTermStmt PPC64.PPC = PPCTermStmt
|
||||
type instance MC.ArchTermStmt PPC32.PPC = PPCTermStmt
|
||||
|
||||
instance MC.PrettyF PPCTermStmt where
|
||||
prettyF ts =
|
||||
case ts of
|
||||
PPCSyscall -> PP.text "ppc_syscall"
|
||||
|
||||
rewriteTermStmt :: PPCTermStmt src -> Rewriter ppc src tgt (PPCTermStmt tgt)
|
||||
rewriteTermStmt s =
|
||||
case s of
|
||||
PPCSyscall -> pure PPCSyscall
|
||||
|
||||
-- | We currently have no PPC-specific statements. Remove 'None' if we add some.
|
||||
data PPCStmt ids where
|
||||
None :: PPCStmt ids
|
||||
|
||||
instance MC.PrettyF PPCStmt where
|
||||
prettyF None = PP.text "None"
|
||||
|
||||
type instance MC.ArchStmt PPC64.PPC = PPCStmt
|
||||
type instance MC.ArchStmt PPC32.PPC = PPCStmt
|
||||
|
||||
rewriteStmt :: PPCStmt src -> Rewriter ppc src tgt ()
|
||||
rewriteStmt _ = return ()
|
||||
|
||||
data PPCPrimFn ppc f tp where
|
||||
IDiv :: proxy ppc
|
||||
-> f (MT.BVType (MC.RegAddrWidth (MC.ArchReg ppc)))
|
||||
-> f (MT.BVType (MC.RegAddrWidth (MC.ArchReg ppc)))
|
||||
-> PPCPrimFn ppc f (MT.BVType (MC.RegAddrWidth (MC.ArchReg ppc)))
|
||||
|
||||
instance MT.HasRepr (PPCPrimFn ppc (MC.Value ppc ids)) MT.TypeRepr where
|
||||
typeRepr f =
|
||||
case f of
|
||||
IDiv {} -> undefined
|
||||
|
||||
rewritePrimFn :: (PPCWidth ppc, MC.ArchFn ppc ~ PPCPrimFn ppc)
|
||||
=> PPCPrimFn ppc (MC.Value ppc src) tp
|
||||
-> Rewriter ppc src tgt (MC.Value ppc tgt tp)
|
||||
rewritePrimFn f =
|
||||
case f of
|
||||
IDiv p lhs rhs -> do
|
||||
tgtFn <- IDiv p <$> rewriteValue lhs <*> rewriteValue rhs
|
||||
evalRewrittenArchFn tgtFn
|
||||
|
||||
ppPrimFn :: (Applicative m) => (forall u . f u -> m PP.Doc) -> PPCPrimFn ppc f tp -> m PP.Doc
|
||||
ppPrimFn _pp f =
|
||||
case f of
|
||||
IDiv {} -> pure (PP.text "idiv")
|
||||
|
||||
instance MC.IsArchFn (PPCPrimFn ppc) where
|
||||
ppArchFn = ppPrimFn
|
||||
|
||||
instance FC.FunctorFC (PPCPrimFn ppc) where
|
||||
fmapFC = FC.fmapFCDefault
|
||||
|
||||
instance FC.FoldableFC (PPCPrimFn ppc) where
|
||||
foldMapFC = FC.foldMapFCDefault
|
||||
|
||||
instance FC.TraversableFC (PPCPrimFn ppc) where
|
||||
traverseFC go f =
|
||||
case f of
|
||||
IDiv p lhs rhs -> IDiv p <$> go lhs <*> go rhs
|
||||
|
||||
type instance MC.ArchFn PPC64.PPC = PPCPrimFn PPC64.PPC
|
||||
type instance MC.ArchFn PPC32.PPC = PPCPrimFn PPC32.PPC
|
Loading…
Reference in New Issue
Block a user