ppc: Generalize some error handling around the TOC

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

@@ -25,7 +25,7 @@ module Data.Macaw.PPC (
   TOC.lookupTOCAbs,
   TOC.entryPoints,
   BE.parseTOC,
-  BE.TOCException(..)
+  TOC.TOCException(..)
   ) where
 
 import           Data.Proxy ( Proxy(..) )

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

@@ -2,8 +2,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 module Data.Macaw.PPC.BinaryFormat.ELF (
-  parseTOC,
-  TOCException(..)
+  parseTOC
   ) where
 
 import           GHC.TypeLits ( KnownNat, natVal )
@@ -14,6 +13,7 @@ import qualified Data.ByteString.Char8 as C8
 import qualified Data.Map.Strict as M
 import           Data.Proxy ( Proxy(..) )
 import qualified Data.Serialize.Get as G
+import           Data.Typeable ( Typeable )
 import qualified Data.Word.Indexed as W
 
 import qualified Data.ElfEdit as E
@@ -35,6 +35,7 @@ import qualified Data.Macaw.PPC.TOC as TOC
 parseTOC :: forall ppc m
           . (KnownNat (MC.ArchAddrWidth ppc),
              MM.MemWidth (MC.ArchAddrWidth ppc),
+             Typeable ppc,
              X.MonadThrow m)
          => E.Elf (MC.ArchAddrWidth ppc)
          -> m (TOC.TOC ppc)
@@ -42,18 +43,12 @@ parseTOC e =
   case E.findSectionByName (C8.pack ".opd") e of
     [sec] ->
       case G.runGet (parseFunctionDescriptors (Proxy @ppc) (fromIntegral ptrSize)) (E.elfSectionData sec) of
-        Left msg -> X.throwM (TOCParseError msg)
+        Left msg -> X.throwM ((TOC.TOCParseError msg) :: TOC.TOCException ppc)
         Right t -> return (TOC.toc t)
-    _ -> X.throwM (MissingTOCSection ".opd")
+    _ -> X.throwM ((TOC.MissingTOCSection ".opd") :: TOC.TOCException ppc)
   where
     ptrSize = natVal (Proxy @(MC.ArchAddrWidth ppc))
 
-data TOCException = MissingTOCSection String
-                  | TOCParseError String
-                  deriving (Show)
-
-instance X.Exception TOCException
-
 parseFunctionDescriptors :: (KnownNat (MC.ArchAddrWidth ppc), MM.MemWidth (MC.ArchAddrWidth ppc))
                          => proxy ppc
                          -> Int

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

@@ -16,6 +16,7 @@ import           GHC.TypeLits
 
 import           Control.Lens ( (&), (.~), (^.) )
 import qualified Data.Set as S
+import           Data.Typeable ( Typeable )
 
 import           Data.Macaw.AbsDomain.AbsState as MA
 import           Data.Macaw.CFG
@@ -75,7 +76,7 @@ postPPCTermStmtAbsState preservePred mem s0 regState stmt =
 --
 -- One value that is definitely set is the link register, which holds the
 -- abstract return value.
-mkInitialAbsState :: (PPCArchConstraints ppc)
+mkInitialAbsState :: (PPCArchConstraints ppc, Typeable ppc)
                   => proxy ppc
                   -> TOC.TOC ppc
                   -> MM.Memory (RegAddrWidth (ArchReg ppc))

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

@@ -17,6 +17,7 @@ import qualified Data.Macaw.CFG as MC
 import qualified Data.Macaw.Memory.ElfLoader as EL
 import qualified Data.Macaw.Memory.LoadCommon as LC
 import           Data.Macaw.PPC.PPCReg ()
+import           Data.Typeable ( Typeable )
 
 import qualified SemMC.Architecture.PPC32 as PPC32
 import qualified SemMC.Architecture.PPC64 as PPC64
@@ -42,6 +43,7 @@ loadPPCBinary :: (w ~ MC.ArchAddrWidth ppc,
                   BL.BinaryFormatData (E.Elf w) ~ EL.SectionIndexMap w,
                   BL.Diagnostic (E.Elf w) ~ EL.MemLoadWarning,
                   MC.MemWidth w,
+                  Typeable ppc,
                   KnownNat w)
               => BL.BinaryRepr (E.Elf w)
               -> LC.LoadOptions

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

@@ -1,19 +1,35 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE FlexibleContexts #-}
 module Data.Macaw.PPC.TOC (
   TOC,
   toc,
   lookupTOC,
   lookupTOCAbs,
-  entryPoints
+  entryPoints,
+  TOCException(..)
   ) where
 
+import qualified Control.Monad.Catch as X
 import qualified Data.Macaw.AbsDomain.AbsState as MA
 import qualified Data.Macaw.CFG as MC
 import qualified Data.Macaw.Types as MT
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
+import           Data.Typeable ( Typeable )
 import qualified Data.Word.Indexed as W
 
+data TOCException ppc = MissingTOCEntry (MC.ArchSegmentOff ppc)
+                      | MissingTOCSection String
+                      | TOCParseError String
+
+deriving instance (MC.MemWidth (MC.ArchAddrWidth ppc)) => Show (TOCException ppc)
+
+instance (Typeable ppc, MC.MemWidth (MC.ArchAddrWidth ppc)) => X.Exception (TOCException ppc)
+
 -- | The Table of Contents (TOC) of a PowerPC binary
 --
 -- Note that different ABIs and container formats store the TOC in different
@@ -27,10 +43,10 @@ toc :: M.Map (MC.MemAddr (MC.ArchAddrWidth ppc)) (W.W (MC.ArchAddrWidth ppc))
 toc = TOC
 
 -- | A variant of 'lookupTOC' that returns a macaw 'MA.AbsValue'
-lookupTOCAbs :: (MC.MemWidth (MC.ArchAddrWidth ppc))
+lookupTOCAbs :: (MC.MemWidth (MC.ArchAddrWidth ppc), X.MonadThrow m, Typeable ppc)
              => TOC ppc
              -> MC.ArchSegmentOff ppc
-             -> Maybe (MA.AbsValue (MC.ArchAddrWidth ppc) (MT.BVType (MC.ArchAddrWidth ppc)))
+             -> m (MA.AbsValue (MC.ArchAddrWidth ppc) (MT.BVType (MC.ArchAddrWidth ppc)))
 lookupTOCAbs t addr = toAbsVal <$> lookupTOC t addr
   where
     toAbsVal = MA.FinSet . S.singleton . W.unW
@@ -44,11 +60,18 @@ lookupTOCAbs t addr = toAbsVal <$> lookupTOC t addr
 -- Returns the value of the TOC base pointer (i.e., the value in @r2@ when a
 -- function begins executing) for the function whose entry point is at address
 -- @addr@.
-lookupTOC :: (MC.MemWidth (MC.ArchAddrWidth ppc))
+lookupTOC :: forall ppc m
+           . (MC.MemWidth (MC.ArchAddrWidth ppc), X.MonadThrow m, Typeable ppc)
           => TOC ppc
           -> MC.ArchSegmentOff ppc
-          -> Maybe (W.W (MC.ArchAddrWidth ppc))
-lookupTOC (TOC m) addr = M.lookup (MC.relativeSegmentAddr addr) m
+          -> m (W.W (MC.ArchAddrWidth ppc))
+lookupTOC (TOC m) addr =
+  case M.lookup (MC.relativeSegmentAddr addr) m of
+    Nothing ->
+      let x :: TOCException ppc
+          x = MissingTOCEntry addr
+      in X.throwM x
+    Just entry -> return entry
 
 -- | Return the addresses of all of the functions present in the TOC
 --