trying to fix git

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

@@ -17,6 +17,8 @@ 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.Parameterized.TraversableFC as FC
+import           Data.Parameterized.Some ( Some(..), viewSome )
 
 import qualified SemMC.Architecture.PPC32 as PPC32
 import qualified SemMC.Architecture.PPC64 as PPC64
@@ -31,13 +33,26 @@ import Data.Macaw.PPC.Eval ( mkInitialAbsState,
 import Data.Macaw.PPC.Identify ( identifyCall,
                                  identifyReturn
                                )
-import Data.Macaw.PPC.Arch ( rewriteTermStmt, rewriteStmt, rewritePrimFn )
+import Data.Macaw.PPC.Arch ( rewriteTermStmt,
+                             rewriteStmt,
+                             rewritePrimFn,
+                             valuesInPPCStmt,
+                             ppcPrimFnHasSideEffects,
+                             PPCArch
+                           )
 import Data.Macaw.PPC.PPCReg ( PPCWidth )
 import qualified Data.Macaw.PPC.Semantics.PPC32 as PPC32
 import qualified Data.Macaw.PPC.Semantics.PPC64 as PPC64
 
-archDemandContext :: proxy ppc -> MDS.DemandContext ppc ids
-archDemandContext = undefined
+addValueListDemands :: [Some (Value ppc ids)] -> MDS.DemandComp ppc ids ()
+addValueListDemands = mapM_ (viewSome MDS.addValueDemands)
+
+archDemandContext :: (PPCArch ppc) => proxy ppc -> MDS.DemandContext ppc ids
+archDemandContext _ =
+  MDS.DemandContext { MDS.addArchStmtDemands = addValueListDemands . valuesInPPCStmt
+                    , MDS.addArchFnDemands = addValueListDemands . FC.foldMapFC (\v -> [ Some v ])
+                    , MDS.archFnHasSideEffects = ppcPrimFnHasSideEffects
+                    }
 
 -- | NOTE: There isn't necessarily one answer for this.  This will need to turn
 -- into a function.  With PIC jump tables, it can be smaller than the native size.

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

@@ -1,6 +1,9 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -8,13 +11,18 @@ module Data.Macaw.PPC.Arch (
   PPCTermStmt(..),
   rewriteTermStmt,
   PPCStmt(..),
+  valuesInPPCStmt,
   rewriteStmt,
   PPCPrimFn(..),
-  rewritePrimFn
+  rewritePrimFn,
+  ppcPrimFnHasSideEffects,
+  PPCArch
   ) where
 
 import qualified Text.PrettyPrint.ANSI.Leijen as PP
 import qualified Data.Parameterized.TraversableFC as FC
+import qualified Data.Parameterized.TraversableF as TF
+import           Data.Parameterized.Some ( Some(..) )
 import qualified Data.Macaw.CFG as MC
 import           Data.Macaw.CFG.Rewriter ( Rewriter, rewriteValue, evalRewrittenArchFn )
 import qualified Data.Macaw.Types as MT
@@ -49,16 +57,31 @@ rewriteTermStmt s =
     PPCTrap -> pure PPCTrap
 
 -- | We currently have no PPC-specific statements.  Remove 'None' if we add some.
-data PPCStmt ids where
-  None :: PPCStmt ids
+data PPCStmt (v :: MT.Type -> *) where
+  None :: PPCStmt v
 
-instance MC.PrettyF PPCStmt where
-  prettyF None = PP.text "None"
+instance MC.PrettyF (PPCArchStmt ppc) where
+  prettyF (PPCArchStmt s) =
+    case s of
+      None -> PP.text "None"
 
-type instance MC.ArchStmt PPC64.PPC = PPCStmt
-type instance MC.ArchStmt PPC32.PPC = PPCStmt
+instance TF.FunctorF PPCStmt where
+  fmapF = TF.fmapFDefault
 
-rewriteStmt :: PPCStmt src -> Rewriter ppc src tgt ()
+instance TF.FoldableF PPCStmt where
+  foldMapF = TF.foldMapFDefault
+
+instance TF.TraversableF PPCStmt where
+  traverseF _go stmt =
+    case stmt of
+      None -> pure None
+
+newtype PPCArchStmt ppc ids = PPCArchStmt (PPCStmt (MC.Value ppc ids))
+
+type instance MC.ArchStmt PPC64.PPC = PPCArchStmt PPC64.PPC
+type instance MC.ArchStmt PPC32.PPC = PPCArchStmt PPC32.PPC
+
+rewriteStmt :: PPCArchStmt ppc src -> Rewriter ppc src tgt ()
 rewriteStmt _ = return ()
 
 data PPCPrimFn ppc f tp where
@@ -72,6 +95,13 @@ instance MT.HasRepr (PPCPrimFn ppc (MC.Value ppc ids)) MT.TypeRepr where
     case f of
       IDiv {} -> undefined
 
+-- | Right now, none of the primitive functions has a side effect.  That will
+-- probably change.
+ppcPrimFnHasSideEffects :: PPCPrimFn ppc f tp -> Bool
+ppcPrimFnHasSideEffects pf =
+  case pf of
+    IDiv {} -> False
+
 rewritePrimFn :: (PPCWidth ppc, MC.ArchFn ppc ~ PPCPrimFn ppc)
               => PPCPrimFn ppc (MC.Value ppc src) tp
               -> Rewriter ppc src tgt (MC.Value ppc tgt tp)
@@ -102,3 +132,8 @@ instance FC.TraversableFC (PPCPrimFn ppc) where
 
 type instance MC.ArchFn PPC64.PPC = PPCPrimFn PPC64.PPC
 type instance MC.ArchFn PPC32.PPC = PPCPrimFn PPC32.PPC
+
+valuesInPPCStmt :: PPCArchStmt ppc ids -> [Some (MC.Value ppc ids)]
+valuesInPPCStmt (PPCArchStmt s) = TF.foldMapF (\x -> [Some x]) s
+
+type PPCArch ppc = (PPCWidth ppc, MC.ArchStmt ppc ~ PPCArchStmt ppc, MC.ArchFn ppc ~ PPCPrimFn ppc)

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE TypeOperators #-}
 module Data.Macaw.PPC.Eval (
@@ -11,6 +12,7 @@ module Data.Macaw.PPC.Eval (
 
 import           GHC.TypeLits
 
+import           Control.Lens ( (&) )
 import qualified Data.Set as S
 
 import           Data.Macaw.AbsDomain.AbsState as MA
@@ -18,6 +20,7 @@ import           Data.Macaw.CFG
 import qualified Data.Macaw.Memory as MM
 import           Data.Parameterized.Some ( Some(..) )
 
+import           Data.Macaw.PPC.Arch
 import           Data.Macaw.PPC.PPCReg
 
 preserveRegAcrossSyscall :: (ArchReg ppc ~ PPCReg ppc, 1 <= RegAddrWidth (PPCReg ppc))
@@ -26,26 +29,50 @@ preserveRegAcrossSyscall :: (ArchReg ppc ~ PPCReg ppc, 1 <= RegAddrWidth (PPCReg
                          -> Bool
 preserveRegAcrossSyscall proxy r = S.member (Some r) (linuxSystemCallPreservedRegisters proxy)
 
-mkInitialAbsState :: proxy ppc
+-- | Set up an initial abstract state that holds at the beginning of a basic
+-- block.
+--
+-- The 'MM.Memory' is the mapped memory region
+--
+-- The 'ArchSegmentOff' is the start address of the basic block.
+--
+-- Note that we don't initialize the abstract stack.  On PowerPC, there are no
+-- initial stack entries (since the return address is in the link register).
+mkInitialAbsState :: (PPCWidth ppc)
+                  => proxy ppc
                   -> MM.Memory (RegAddrWidth (ArchReg ppc))
                   -> ArchSegmentOff ppc
                   -> MA.AbsBlockState (ArchReg ppc)
-mkInitialAbsState = undefined
+mkInitialAbsState _ _mem startAddr =
+  MA.top & MA.setAbsIP startAddr
 
-absEvalArchFn :: proxy ppc
+absEvalArchFn :: (PPCArch ppc)
+              => proxy ppc
               -> AbsProcessorState (ArchReg ppc) ids
               -> ArchFn ppc (Value ppc ids) tp
               -> AbsValue (RegAddrWidth (ArchReg ppc)) tp
-absEvalArchFn = undefined
+absEvalArchFn _ _r f =
+  case f of
+    IDiv {} -> MA.TopV
 
+-- | For now, none of the architecture-specific statements have an effect on the
+-- abstract value.
 absEvalArchStmt :: proxy ppc
                 -> AbsProcessorState (ArchReg ppc) ids
                 -> ArchStmt ppc ids
                 -> AbsProcessorState (ArchReg ppc) ids
-absEvalArchStmt = undefined
+absEvalArchStmt _ s _ = s
 
-postCallAbsState :: proxy ppc
+-- | There should be no difference in stack height before and after a call, as
+-- the callee pushes the return address if required.  Return values are also
+-- passed in registers.
+postCallAbsState :: (PPCWidth ppc)
+                 => proxy ppc
                  -> AbsBlockState (ArchReg ppc)
                  -> ArchSegmentOff ppc
                  -> AbsBlockState (ArchReg ppc)
-postCallAbsState = undefined
+postCallAbsState proxy = MA.absEvalCall params
+  where
+    params = MA.CallParams { MA.postCallStackDelta = 0
+                           , MA.preserveReg = \r -> S.member (Some r) (linuxCalleeSaveRegisters proxy)
+                           }

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

@@ -19,7 +19,6 @@ module Data.Macaw.PPC.Generator (
   addStmt,
   addAssignment,
   getReg,
-  blockSeq,
   -- * Lenses
   blockState,
   curPPCState,

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

@@ -13,6 +13,7 @@
 module Data.Macaw.PPC.PPCReg (
   PPCReg(..),
   linuxSystemCallPreservedRegisters,
+  linuxCalleeSaveRegisters,
   PPCWidth,
   ArchWidth(..)
   ) where
@@ -77,6 +78,12 @@ linuxSystemCallPreservedRegisters :: (w ~ MC.RegAddrWidth (PPCReg ppc), 1 <= w)
 linuxSystemCallPreservedRegisters _ =
   S.fromList [ Some (PPC_GP (D.GPR rnum)) | rnum <- [14..31] ]
 
+linuxCalleeSaveRegisters :: (w ~ MC.RegAddrWidth (PPCReg ppc), 1 <= w)
+                         => proxy ppc
+                         -> S.Set (Some (PPCReg ppc))
+linuxCalleeSaveRegisters _ =
+  S.fromList [ Some (PPC_GP (D.GPR rnum)) | rnum <- [14..31] ]
+
 type instance MC.RegAddrWidth (PPCReg PPC32.PPC) = 32
 type instance MC.RegAddrWidth (PPCReg PPC64.PPC) = 64
 

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

@@ -1,14 +1,17 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TemplateHaskell #-}
 module Data.Macaw.PPC.Semantics.PPC32
   ( execInstruction
   ) where
 
 import qualified Dismantle.PPC as D
+import qualified Data.Parameterized.Map as MapF
 import qualified Data.Macaw.CFG as MC
 import qualified Data.Macaw.Types as MT
 import           SemMC.Architecture.PPC32 ( PPC )
 
 import           Data.Macaw.PPC.Generator
+import           Data.Macaw.PPC.Semantics.TH ( genExecInstruction )
 
 execInstruction :: MC.Value ppc s (MT.BVType 32) -> D.Instruction -> Maybe (PPCGenerator PPC s ())
-execInstruction = undefined
+execInstruction =  $(genExecInstruction MapF.empty)