Implement more of the PPCGenerator state

macaw-ppc/src/Data/Macaw/PPC.hs

@@ -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
+

macaw-ppc/src/Data/Macaw/PPC/Disassemble.hs

@@ -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

macaw-ppc/src/Data/Macaw/PPC/Generator.hs

@@ -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 })