{-|
This defines the data structures for storing information learned from
code discovery.  The 'DiscoveryState' is the main data structure
representing this information.
-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Macaw.Discovery.State
  ( -- * DiscoveryState
    DiscoveryState
  , AddrSymMap
  , exploredFunctions
  , ppDiscoveryStateBlocks
  , emptyDiscoveryState
  , memory
  , symbolNames
  , archInfo
  , GlobalDataInfo(..)
  , globalDataMap
  , funInfo
  , UnexploredFunctionMap
  , unexploredFunctions
  , Info.NoReturnFunStatus(..)
  , trustedFunctionEntryPoints
  , exploreFnPred
    -- * DiscoveryFunInfo
  , DiscoveryFunInfo(..)
  , discoveredFunName
  , parsedBlocks
    -- ** Parsed block
  , Parsed.ParsedBlock(..)
    -- ** Block terminal statements
  , Parsed.ParsedTermStmt(..)
  , Parsed.parsedTermSucc
    -- ** JumpTableLayout
  , Parsed.JumpTableLayout(..)
  , Parsed.Extension(..)
  , Parsed.jtlBackingAddr
  , Parsed.jtlBackingSize
    -- * BoundedMemArray
  , Parsed.BoundedMemArray(..)
  , Parsed.arByteCount
  , Parsed.isReadOnlyBoundedMemArray
    -- * Reasons for exploring
  , FunctionExploreReason(..)
  , ppFunReason
  , Parsed.BlockExploreReason(..)
    -- * DiscoveryState utilities
  , RegConstraint
  )  where

import           Control.Lens
import qualified Data.ByteString.Char8 as BSC
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Parameterized.Classes
import           Data.Parameterized.Some
import           Numeric (showHex)
import           Prettyprinter as PP

import           Data.Macaw.Architecture.Info as Info
import           Data.Macaw.CFG
import qualified Data.Macaw.Discovery.ParsedContents as Parsed
import           Data.Macaw.Types

------------------------------------------------------------------------
-- AddrSymMap

-- | Maps code addresses to the associated symbol name if any.
type AddrSymMap w = Map.Map (MemSegmentOff w) BSC.ByteString

------------------------------------------------------------------------
-- BlockExploreReason

-- | This describes why we started exploring a given function.
data FunctionExploreReason w
     -- | Exploring because code at the given block writes it to memory.
  = PossibleWriteEntry !(MemSegmentOff w)
    -- | Exploring because address terminates with a call that jumps here.
  | CallTarget !(MemSegmentOff w)
    -- | Identified as an entry point from initial information
  | InitAddr
    -- | A code pointer that was stored at the given address.
  | CodePointerInMem !(MemSegmentOff w)
    -- | The user requested that we analyze this address as a function.
  | UserRequest
  deriving (FunctionExploreReason w -> FunctionExploreReason w -> Bool
(FunctionExploreReason w -> FunctionExploreReason w -> Bool)
-> (FunctionExploreReason w -> FunctionExploreReason w -> Bool)
-> Eq (FunctionExploreReason w)
forall (w :: Nat).
FunctionExploreReason w -> FunctionExploreReason w -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (w :: Nat).
FunctionExploreReason w -> FunctionExploreReason w -> Bool
== :: FunctionExploreReason w -> FunctionExploreReason w -> Bool
$c/= :: forall (w :: Nat).
FunctionExploreReason w -> FunctionExploreReason w -> Bool
/= :: FunctionExploreReason w -> FunctionExploreReason w -> Bool
Eq, Int -> FunctionExploreReason w -> ShowS
[FunctionExploreReason w] -> ShowS
FunctionExploreReason w -> String
(Int -> FunctionExploreReason w -> ShowS)
-> (FunctionExploreReason w -> String)
-> ([FunctionExploreReason w] -> ShowS)
-> Show (FunctionExploreReason w)
forall (w :: Nat).
MemWidth w =>
Int -> FunctionExploreReason w -> ShowS
forall (w :: Nat). MemWidth w => [FunctionExploreReason w] -> ShowS
forall (w :: Nat). MemWidth w => FunctionExploreReason w -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (w :: Nat).
MemWidth w =>
Int -> FunctionExploreReason w -> ShowS
showsPrec :: Int -> FunctionExploreReason w -> ShowS
$cshow :: forall (w :: Nat). MemWidth w => FunctionExploreReason w -> String
show :: FunctionExploreReason w -> String
$cshowList :: forall (w :: Nat). MemWidth w => [FunctionExploreReason w] -> ShowS
showList :: [FunctionExploreReason w] -> ShowS
Show)

-- | Print exploration reason.
ppFunReason :: FunctionExploreReason w -> String
ppFunReason :: forall (w :: Nat). FunctionExploreReason w -> String
ppFunReason FunctionExploreReason w
rsn =
  case FunctionExploreReason w
rsn of
    FunctionExploreReason w
InitAddr -> String
""
    FunctionExploreReason w
UserRequest -> String
""
    PossibleWriteEntry MemSegmentOff w
a -> String
" (written at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> ShowS
forall a. Integral a => a -> ShowS
showHex (MemWord w -> Word64
forall (w :: Nat). MemWord w -> Word64
memWordValue (MemAddr w -> MemWord w
forall (w :: Nat). MemAddr w -> MemWord w
addrOffset (MemSegmentOff w -> MemAddr w
forall (w :: Nat). MemSegmentOff w -> MemAddr w
segoffAddr MemSegmentOff w
a))) String
")"
    CallTarget MemSegmentOff w
a -> String
" (called at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> ShowS
forall a. Integral a => a -> ShowS
showHex (MemWord w -> Word64
forall (w :: Nat). MemWord w -> Word64
memWordValue (MemAddr w -> MemWord w
forall (w :: Nat). MemAddr w -> MemWord w
addrOffset (MemSegmentOff w -> MemAddr w
forall (w :: Nat). MemSegmentOff w -> MemAddr w
segoffAddr MemSegmentOff w
a))) String
")"
    CodePointerInMem MemSegmentOff w
a -> String
" (in initial memory at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> ShowS
forall a. Integral a => a -> ShowS
showHex (MemWord w -> Word64
forall (w :: Nat). MemWord w -> Word64
memWordValue (MemAddr w -> MemWord w
forall (w :: Nat). MemAddr w -> MemWord w
addrOffset (MemSegmentOff w -> MemAddr w
forall (w :: Nat). MemSegmentOff w -> MemAddr w
segoffAddr MemSegmentOff w
a))) String
")"

------------------------------------------------------------------------
-- GlobalDataInfo

-- | Information about a region of memory.
data GlobalDataInfo w
  -- | A jump table that appears to end just before the given address.
  = JumpTable !(Maybe w)
  -- | A value that appears in the program text.
  | ReferencedValue

instance (Integral w, Show w) => Show (GlobalDataInfo w) where
  show :: GlobalDataInfo w -> String
show (JumpTable Maybe w
Nothing) = String
"unbound jump table"
  show (JumpTable (Just w
w)) | w
w w -> w -> Bool
forall a. Ord a => a -> a -> Bool
>= w
0 = String
"jump table end " String -> ShowS
forall a. [a] -> [a] -> [a]
++ w -> ShowS
forall a. Integral a => a -> ShowS
showHex w
w String
""
                            | Bool
otherwise = ShowS
forall a. HasCallStack => String -> a
error String
"jump table with negative offset given"
  show GlobalDataInfo w
ReferencedValue = String
"global addr"


------------------------------------------------------------------------
-- DiscoveryFunInfo

-- | Information discovered about a particular function
data DiscoveryFunInfo arch ids
   = DiscoveryFunInfo { forall arch ids.
DiscoveryFunInfo arch ids
-> FunctionExploreReason (ArchAddrWidth arch)
discoveredFunReason :: !(FunctionExploreReason (ArchAddrWidth arch))
                      , forall arch ids. DiscoveryFunInfo arch ids -> ArchSegmentOff arch
discoveredFunAddr :: !(ArchSegmentOff arch)
                        -- ^ Address of function entry block.
                      , forall arch ids. DiscoveryFunInfo arch ids -> Maybe ByteString
discoveredFunSymbol :: !(Maybe BSC.ByteString)
                        -- ^ A symbol associated with the definition.
                      , forall arch ids.
DiscoveryFunInfo arch ids
-> Map (ArchSegmentOff arch) (ParsedBlock arch ids)
_parsedBlocks :: !(Map (ArchSegmentOff arch) (Parsed.ParsedBlock arch ids))
                        -- ^ Maps the start addresses of function blocks to their contents
                      , forall arch ids.
DiscoveryFunInfo arch ids
-> [(ArchSegmentOff arch, [ArchSegmentOff arch])]
discoveredClassifyFailureResolutions :: [(ArchSegmentOff arch, [ArchSegmentOff arch])]
                        -- ^ A side mapping that records jump targets for
                        -- 'ClassifyFailure' block terminators that have been
                        -- gleaned from an external source.  When interpreting
                        -- the function, this map can be used to complete the
                        -- control flow of functions with 'ClassifyFailure's.
                      }

-- | Returns the "name" associated with a function.
--
-- This is either the symbol or the address.
discoveredFunName :: MemWidth (ArchAddrWidth arch)
                  => DiscoveryFunInfo arch ids
                  -> BSC.ByteString
discoveredFunName :: forall arch ids.
MemWidth (ArchAddrWidth arch) =>
DiscoveryFunInfo arch ids -> ByteString
discoveredFunName DiscoveryFunInfo arch ids
finfo =
  case DiscoveryFunInfo arch ids -> Maybe ByteString
forall arch ids. DiscoveryFunInfo arch ids -> Maybe ByteString
discoveredFunSymbol DiscoveryFunInfo arch ids
finfo of
    Just ByteString
nm -> ByteString
nm
    Maybe ByteString
Nothing -> String -> ByteString
BSC.pack (MemSegmentOff (ArchAddrWidth arch) -> String
forall a. Show a => a -> String
show (DiscoveryFunInfo arch ids -> MemSegmentOff (ArchAddrWidth arch)
forall arch ids. DiscoveryFunInfo arch ids -> ArchSegmentOff arch
discoveredFunAddr DiscoveryFunInfo arch ids
finfo))

parsedBlocks :: Simple Lens (DiscoveryFunInfo arch ids) (Map (ArchSegmentOff arch) (Parsed.ParsedBlock arch ids))
parsedBlocks :: forall arch ids (f :: Type -> Type).
Functor f =>
(Map (ArchSegmentOff arch) (ParsedBlock arch ids)
 -> f (Map (ArchSegmentOff arch) (ParsedBlock arch ids)))
-> DiscoveryFunInfo arch ids -> f (DiscoveryFunInfo arch ids)
parsedBlocks = (DiscoveryFunInfo arch ids
 -> Map
      (MemSegmentOff (RegAddrWidth (ArchReg arch)))
      (ParsedBlock arch ids))
-> (DiscoveryFunInfo arch ids
    -> Map
         (MemSegmentOff (RegAddrWidth (ArchReg arch)))
         (ParsedBlock arch ids)
    -> DiscoveryFunInfo arch ids)
-> Lens
     (DiscoveryFunInfo arch ids)
     (DiscoveryFunInfo arch ids)
     (Map
        (MemSegmentOff (RegAddrWidth (ArchReg arch)))
        (ParsedBlock arch ids))
     (Map
        (MemSegmentOff (RegAddrWidth (ArchReg arch)))
        (ParsedBlock arch ids))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DiscoveryFunInfo arch ids
-> Map
     (MemSegmentOff (RegAddrWidth (ArchReg arch)))
     (ParsedBlock arch ids)
forall arch ids.
DiscoveryFunInfo arch ids
-> Map (ArchSegmentOff arch) (ParsedBlock arch ids)
_parsedBlocks (\DiscoveryFunInfo arch ids
s Map
  (MemSegmentOff (RegAddrWidth (ArchReg arch)))
  (ParsedBlock arch ids)
v -> DiscoveryFunInfo arch ids
s { _parsedBlocks = v })

instance ArchConstraints arch => Pretty (DiscoveryFunInfo arch ids) where
  pretty :: forall ann. DiscoveryFunInfo arch ids -> Doc ann
pretty DiscoveryFunInfo arch ids
info =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat
    [ Doc ann
"function" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
nm
    , [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat (ParsedBlock arch ids -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ParsedBlock arch ids -> Doc ann
pretty (ParsedBlock arch ids -> Doc ann)
-> [ParsedBlock arch ids] -> [Doc ann]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Map
  (MemSegmentOff (RegAddrWidth (ArchReg arch)))
  (ParsedBlock arch ids)
-> [ParsedBlock arch ids]
forall k a. Map k a -> [a]
Map.elems (DiscoveryFunInfo arch ids
infoDiscoveryFunInfo arch ids
-> Getting
     (Map
        (MemSegmentOff (RegAddrWidth (ArchReg arch)))
        (ParsedBlock arch ids))
     (DiscoveryFunInfo arch ids)
     (Map
        (MemSegmentOff (RegAddrWidth (ArchReg arch)))
        (ParsedBlock arch ids))
-> Map
     (MemSegmentOff (RegAddrWidth (ArchReg arch)))
     (ParsedBlock arch ids)
forall s a. s -> Getting a s a -> a
^.Getting
  (Map
     (MemSegmentOff (RegAddrWidth (ArchReg arch)))
     (ParsedBlock arch ids))
  (DiscoveryFunInfo arch ids)
  (Map
     (MemSegmentOff (RegAddrWidth (ArchReg arch)))
     (ParsedBlock arch ids))
forall arch ids (f :: Type -> Type).
Functor f =>
(Map (ArchSegmentOff arch) (ParsedBlock arch ids)
 -> f (Map (ArchSegmentOff arch) (ParsedBlock arch ids)))
-> DiscoveryFunInfo arch ids -> f (DiscoveryFunInfo arch ids)
parsedBlocks)) ]
    where
        addr :: Doc ann
addr = MemSegmentOff (RegAddrWidth (ArchReg arch)) -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow (DiscoveryFunInfo arch ids
-> MemSegmentOff (RegAddrWidth (ArchReg arch))
forall arch ids. DiscoveryFunInfo arch ids -> ArchSegmentOff arch
discoveredFunAddr DiscoveryFunInfo arch ids
info)
        nm :: Doc ann
nm = case DiscoveryFunInfo arch ids -> Maybe ByteString
forall arch ids. DiscoveryFunInfo arch ids -> Maybe ByteString
discoveredFunSymbol DiscoveryFunInfo arch ids
info of
               Just ByteString
sym -> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
BSC.unpack ByteString
sym) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"@" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
addr
               Maybe ByteString
Nothing -> Doc ann
addr


------------------------------------------------------------------------
-- DiscoveryState

type UnexploredFunctionMap arch =
  Map (ArchSegmentOff arch) (FunctionExploreReason (ArchAddrWidth arch))

-- | Information discovered about the program
data DiscoveryState arch
   = DiscoveryState { forall arch. DiscoveryState arch -> Memory (ArchAddrWidth arch)
memory              :: !(Memory (ArchAddrWidth arch))
                      -- ^ The initial memory when disassembly started.
                    , forall arch. DiscoveryState arch -> AddrSymMap (ArchAddrWidth arch)
symbolNames          :: !(AddrSymMap (ArchAddrWidth arch))
                      -- ^ Map addresses to known symbol names
                    , forall arch. DiscoveryState arch -> ArchitectureInfo arch
archInfo             :: !(ArchitectureInfo arch)
                      -- ^ Architecture-specific information needed for discovery.
                    , forall arch.
DiscoveryState arch
-> Map (ArchMemAddr arch) (GlobalDataInfo (ArchMemAddr arch))
_globalDataMap       :: !(Map (ArchMemAddr arch)
                                                (GlobalDataInfo (ArchMemAddr arch)))
                      -- ^ Maps each address that appears to be global data to information
                      -- inferred about it.
                    , forall arch.
DiscoveryState arch
-> Map (ArchSegmentOff arch) (Some (DiscoveryFunInfo arch))
_funInfo             :: !(Map (ArchSegmentOff arch) (Some (DiscoveryFunInfo arch)))
                      -- ^ Map from function addresses to discovered information about function
                    , forall arch. DiscoveryState arch -> UnexploredFunctionMap arch
_unexploredFunctions
                      :: !(UnexploredFunctionMap arch)
                      -- ^ This maps addresses that have been marked as
                      -- functions, but not yet analyzed to the reason
                      -- they are analyzed.
                      --
                      -- The keys in this map and `_funInfo` should be mutually disjoint.
                    , forall arch.
DiscoveryState arch -> Map (ArchSegmentOff arch) NoReturnFunStatus
_trustedFunctionEntryPoints :: !(Map (ArchSegmentOff arch) Info.NoReturnFunStatus)
                      -- ^ This is the set of addresses that we treat
                      -- as definitely belonging to function entry
                      -- points.
                      --
                      -- The discovery process will not allow
                      -- intra-procedural jumps to these addresses.
                      -- Jumps to these addresses must either be calls
                      -- or tail calls.
                      --
                      -- To ensure translation is invariant on the
                      -- order in which functions are visited, this
                      -- set should be initialized upfront, and not
                      -- changed.
                    , forall arch. DiscoveryState arch -> ArchSegmentOff arch -> Bool
_exploreFnPred :: !(ArchSegmentOff arch -> Bool)
                      -- ^ This predicate decides whether to explore a
                      -- function at the given address or not.
                    }

-- | Return list of all functions discovered so far.
exploredFunctions :: DiscoveryState arch -> [Some (DiscoveryFunInfo arch)]
exploredFunctions :: forall arch. DiscoveryState arch -> [Some (DiscoveryFunInfo arch)]
exploredFunctions DiscoveryState arch
i = Map
  (MemSegmentOff (RegAddrWidth (ArchReg arch)))
  (Some (DiscoveryFunInfo arch))
-> [Some (DiscoveryFunInfo arch)]
forall k a. Map k a -> [a]
Map.elems (Map
   (MemSegmentOff (RegAddrWidth (ArchReg arch)))
   (Some (DiscoveryFunInfo arch))
 -> [Some (DiscoveryFunInfo arch)])
-> Map
     (MemSegmentOff (RegAddrWidth (ArchReg arch)))
     (Some (DiscoveryFunInfo arch))
-> [Some (DiscoveryFunInfo arch)]
forall a b. (a -> b) -> a -> b
$ DiscoveryState arch
iDiscoveryState arch
-> Getting
     (Map
        (MemSegmentOff (RegAddrWidth (ArchReg arch)))
        (Some (DiscoveryFunInfo arch)))
     (DiscoveryState arch)
     (Map
        (MemSegmentOff (RegAddrWidth (ArchReg arch)))
        (Some (DiscoveryFunInfo arch)))
-> Map
     (MemSegmentOff (RegAddrWidth (ArchReg arch)))
     (Some (DiscoveryFunInfo arch))
forall s a. s -> Getting a s a -> a
^.Getting
  (Map
     (MemSegmentOff (RegAddrWidth (ArchReg arch)))
     (Some (DiscoveryFunInfo arch)))
  (DiscoveryState arch)
  (Map
     (MemSegmentOff (RegAddrWidth (ArchReg arch)))
     (Some (DiscoveryFunInfo arch)))
forall arch (f :: Type -> Type).
Functor f =>
(Map (ArchSegmentOff arch) (Some (DiscoveryFunInfo arch))
 -> f (Map (ArchSegmentOff arch) (Some (DiscoveryFunInfo arch))))
-> DiscoveryState arch -> f (DiscoveryState arch)
funInfo

withDiscoveryArchConstraints :: DiscoveryState arch
                             -> (ArchConstraints arch => a)
                             -> a
withDiscoveryArchConstraints :: forall arch a.
DiscoveryState arch -> (ArchConstraints arch => a) -> a
withDiscoveryArchConstraints DiscoveryState arch
dinfo = ArchitectureInfo arch -> forall a. (ArchConstraints arch => a) -> a
forall arch.
ArchitectureInfo arch -> forall a. (ArchConstraints arch => a) -> a
withArchConstraints (DiscoveryState arch -> ArchitectureInfo arch
forall arch. DiscoveryState arch -> ArchitectureInfo arch
archInfo DiscoveryState arch
dinfo)

ppDiscoveryStateBlocks :: DiscoveryState arch -> Doc ann
ppDiscoveryStateBlocks :: forall arch ann. DiscoveryState arch -> Doc ann
ppDiscoveryStateBlocks DiscoveryState arch
info = DiscoveryState arch -> (ArchConstraints arch => Doc ann) -> Doc ann
forall arch a.
DiscoveryState arch -> (ArchConstraints arch => a) -> a
withDiscoveryArchConstraints DiscoveryState arch
info ((ArchConstraints arch => Doc ann) -> Doc ann)
-> (ArchConstraints arch => Doc ann) -> Doc ann
forall a b. (a -> b) -> a -> b
$
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Some (DiscoveryFunInfo arch) -> Doc ann
forall arch ann.
ArchConstraints arch =>
Some (DiscoveryFunInfo arch) -> Doc ann
f (Some (DiscoveryFunInfo arch) -> Doc ann)
-> [Some (DiscoveryFunInfo arch)] -> [Doc ann]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Map
  (MemSegmentOff (RegAddrWidth (ArchReg arch)))
  (Some (DiscoveryFunInfo arch))
-> [Some (DiscoveryFunInfo arch)]
forall k a. Map k a -> [a]
Map.elems (DiscoveryState arch
infoDiscoveryState arch
-> Getting
     (Map
        (MemSegmentOff (RegAddrWidth (ArchReg arch)))
        (Some (DiscoveryFunInfo arch)))
     (DiscoveryState arch)
     (Map
        (MemSegmentOff (RegAddrWidth (ArchReg arch)))
        (Some (DiscoveryFunInfo arch)))
-> Map
     (MemSegmentOff (RegAddrWidth (ArchReg arch)))
     (Some (DiscoveryFunInfo arch))
forall s a. s -> Getting a s a -> a
^.Getting
  (Map
     (MemSegmentOff (RegAddrWidth (ArchReg arch)))
     (Some (DiscoveryFunInfo arch)))
  (DiscoveryState arch)
  (Map
     (MemSegmentOff (RegAddrWidth (ArchReg arch)))
     (Some (DiscoveryFunInfo arch)))
forall arch (f :: Type -> Type).
Functor f =>
(Map (ArchSegmentOff arch) (Some (DiscoveryFunInfo arch))
 -> f (Map (ArchSegmentOff arch) (Some (DiscoveryFunInfo arch))))
-> DiscoveryState arch -> f (DiscoveryState arch)
funInfo)
  where f :: ArchConstraints arch => Some (DiscoveryFunInfo arch) -> Doc ann
        f :: forall arch ann.
ArchConstraints arch =>
Some (DiscoveryFunInfo arch) -> Doc ann
f (Some DiscoveryFunInfo arch x
v) = DiscoveryFunInfo arch x -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. DiscoveryFunInfo arch x -> Doc ann
pretty DiscoveryFunInfo arch x
v

-- | Create empty discovery information.
emptyDiscoveryState :: Memory (ArchAddrWidth arch)
                       -- ^ State of memory
                    -> AddrSymMap (ArchAddrWidth arch)
                       -- ^ Map from addresses to their symbol name (if any)
                    -> ArchitectureInfo arch
                       -- ^ architecture/OS specific information
                    -> DiscoveryState arch
emptyDiscoveryState :: forall arch.
Memory (ArchAddrWidth arch)
-> AddrSymMap (ArchAddrWidth arch)
-> ArchitectureInfo arch
-> DiscoveryState arch
emptyDiscoveryState Memory (RegAddrWidth (ArchReg arch))
mem AddrSymMap (RegAddrWidth (ArchReg arch))
addrSymMap ArchitectureInfo arch
info =
  DiscoveryState
  { memory :: Memory (RegAddrWidth (ArchReg arch))
memory               = Memory (RegAddrWidth (ArchReg arch))
mem
  , symbolNames :: AddrSymMap (RegAddrWidth (ArchReg arch))
symbolNames          = AddrSymMap (RegAddrWidth (ArchReg arch))
addrSymMap
  , archInfo :: ArchitectureInfo arch
archInfo             = ArchitectureInfo arch
info
  , _globalDataMap :: Map (ArchMemAddr arch) (GlobalDataInfo (ArchMemAddr arch))
_globalDataMap       = Map (ArchMemAddr arch) (GlobalDataInfo (ArchMemAddr arch))
forall k a. Map k a
Map.empty
  , _funInfo :: Map
  (MemSegmentOff (RegAddrWidth (ArchReg arch)))
  (Some (DiscoveryFunInfo arch))
_funInfo             = Map
  (MemSegmentOff (RegAddrWidth (ArchReg arch)))
  (Some (DiscoveryFunInfo arch))
forall k a. Map k a
Map.empty
  , _unexploredFunctions :: UnexploredFunctionMap arch
_unexploredFunctions = UnexploredFunctionMap arch
forall k a. Map k a
Map.empty
  , _trustedFunctionEntryPoints :: Map (MemSegmentOff (RegAddrWidth (ArchReg arch))) NoReturnFunStatus
_trustedFunctionEntryPoints = NoReturnFunStatus
Info.MayReturnFun NoReturnFunStatus
-> AddrSymMap (RegAddrWidth (ArchReg arch))
-> Map
     (MemSegmentOff (RegAddrWidth (ArchReg arch))) NoReturnFunStatus
forall a b.
a
-> Map (MemSegmentOff (RegAddrWidth (ArchReg arch))) b
-> Map (MemSegmentOff (RegAddrWidth (ArchReg arch))) a
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ AddrSymMap (RegAddrWidth (ArchReg arch))
addrSymMap
  , _exploreFnPred :: MemSegmentOff (RegAddrWidth (ArchReg arch)) -> Bool
_exploreFnPred       = Bool -> MemSegmentOff (RegAddrWidth (ArchReg arch)) -> Bool
forall a b. a -> b -> a
const Bool
True
  }

-- | Map each jump table start to the address just after the end.
globalDataMap :: Lens' (DiscoveryState arch)
                      (Map (ArchMemAddr arch) (GlobalDataInfo (ArchMemAddr arch)))
globalDataMap :: forall arch (f :: Type -> Type).
Functor f =>
(Map (ArchMemAddr arch) (GlobalDataInfo (ArchMemAddr arch))
 -> f (Map (ArchMemAddr arch) (GlobalDataInfo (ArchMemAddr arch))))
-> DiscoveryState arch -> f (DiscoveryState arch)
globalDataMap = (DiscoveryState arch
 -> Map
      (MemAddr (RegAddrWidth (ArchReg arch)))
      (GlobalDataInfo (MemAddr (RegAddrWidth (ArchReg arch)))))
-> (DiscoveryState arch
    -> Map
         (MemAddr (RegAddrWidth (ArchReg arch)))
         (GlobalDataInfo (MemAddr (RegAddrWidth (ArchReg arch))))
    -> DiscoveryState arch)
-> Lens
     (DiscoveryState arch)
     (DiscoveryState arch)
     (Map
        (MemAddr (RegAddrWidth (ArchReg arch)))
        (GlobalDataInfo (MemAddr (RegAddrWidth (ArchReg arch)))))
     (Map
        (MemAddr (RegAddrWidth (ArchReg arch)))
        (GlobalDataInfo (MemAddr (RegAddrWidth (ArchReg arch)))))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DiscoveryState arch
-> Map
     (MemAddr (RegAddrWidth (ArchReg arch)))
     (GlobalDataInfo (MemAddr (RegAddrWidth (ArchReg arch))))
forall arch.
DiscoveryState arch
-> Map (ArchMemAddr arch) (GlobalDataInfo (ArchMemAddr arch))
_globalDataMap (\DiscoveryState arch
s Map
  (MemAddr (RegAddrWidth (ArchReg arch)))
  (GlobalDataInfo (MemAddr (RegAddrWidth (ArchReg arch))))
v -> DiscoveryState arch
s { _globalDataMap = v })

-- | List of functions to explore next.
unexploredFunctions
  :: Simple Lens (DiscoveryState arch) (UnexploredFunctionMap arch)
unexploredFunctions :: forall arch (f :: Type -> Type).
Functor f =>
(UnexploredFunctionMap arch -> f (UnexploredFunctionMap arch))
-> DiscoveryState arch -> f (DiscoveryState arch)
unexploredFunctions = (DiscoveryState arch
 -> Map
      (MemSegmentOff (RegAddrWidth (ArchReg arch)))
      (FunctionExploreReason (RegAddrWidth (ArchReg arch))))
-> (DiscoveryState arch
    -> Map
         (MemSegmentOff (RegAddrWidth (ArchReg arch)))
         (FunctionExploreReason (RegAddrWidth (ArchReg arch)))
    -> DiscoveryState arch)
-> Lens
     (DiscoveryState arch)
     (DiscoveryState arch)
     (Map
        (MemSegmentOff (RegAddrWidth (ArchReg arch)))
        (FunctionExploreReason (RegAddrWidth (ArchReg arch))))
     (Map
        (MemSegmentOff (RegAddrWidth (ArchReg arch)))
        (FunctionExploreReason (RegAddrWidth (ArchReg arch))))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DiscoveryState arch
-> Map
     (MemSegmentOff (RegAddrWidth (ArchReg arch)))
     (FunctionExploreReason (RegAddrWidth (ArchReg arch)))
forall arch. DiscoveryState arch -> UnexploredFunctionMap arch
_unexploredFunctions (\DiscoveryState arch
s Map
  (MemSegmentOff (RegAddrWidth (ArchReg arch)))
  (FunctionExploreReason (RegAddrWidth (ArchReg arch)))
v -> DiscoveryState arch
s { _unexploredFunctions = v })

-- | Get information for specific functions
funInfo :: Simple Lens (DiscoveryState arch) (Map (ArchSegmentOff arch) (Some (DiscoveryFunInfo arch)))
funInfo :: forall arch (f :: Type -> Type).
Functor f =>
(Map (ArchSegmentOff arch) (Some (DiscoveryFunInfo arch))
 -> f (Map (ArchSegmentOff arch) (Some (DiscoveryFunInfo arch))))
-> DiscoveryState arch -> f (DiscoveryState arch)
funInfo = (DiscoveryState arch
 -> Map
      (MemSegmentOff (RegAddrWidth (ArchReg arch)))
      (Some (DiscoveryFunInfo arch)))
-> (DiscoveryState arch
    -> Map
         (MemSegmentOff (RegAddrWidth (ArchReg arch)))
         (Some (DiscoveryFunInfo arch))
    -> DiscoveryState arch)
-> Lens
     (DiscoveryState arch)
     (DiscoveryState arch)
     (Map
        (MemSegmentOff (RegAddrWidth (ArchReg arch)))
        (Some (DiscoveryFunInfo arch)))
     (Map
        (MemSegmentOff (RegAddrWidth (ArchReg arch)))
        (Some (DiscoveryFunInfo arch)))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DiscoveryState arch
-> Map
     (MemSegmentOff (RegAddrWidth (ArchReg arch)))
     (Some (DiscoveryFunInfo arch))
forall arch.
DiscoveryState arch
-> Map (ArchSegmentOff arch) (Some (DiscoveryFunInfo arch))
_funInfo (\DiscoveryState arch
s Map
  (MemSegmentOff (RegAddrWidth (ArchReg arch)))
  (Some (DiscoveryFunInfo arch))
v -> DiscoveryState arch
s { _funInfo = v })

-- | Retrieves functions that are trusted entry points.
trustedFunctionEntryPoints
  :: Simple Lens (DiscoveryState arch) (Map (ArchSegmentOff arch) Info.NoReturnFunStatus)
trustedFunctionEntryPoints :: forall arch (f :: Type -> Type).
Functor f =>
(Map (ArchSegmentOff arch) NoReturnFunStatus
 -> f (Map (ArchSegmentOff arch) NoReturnFunStatus))
-> DiscoveryState arch -> f (DiscoveryState arch)
trustedFunctionEntryPoints =
  (DiscoveryState arch
 -> Map
      (MemSegmentOff (RegAddrWidth (ArchReg arch))) NoReturnFunStatus)
-> (DiscoveryState arch
    -> Map
         (MemSegmentOff (RegAddrWidth (ArchReg arch))) NoReturnFunStatus
    -> DiscoveryState arch)
-> Lens
     (DiscoveryState arch)
     (DiscoveryState arch)
     (Map
        (MemSegmentOff (RegAddrWidth (ArchReg arch))) NoReturnFunStatus)
     (Map
        (MemSegmentOff (RegAddrWidth (ArchReg arch))) NoReturnFunStatus)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DiscoveryState arch
-> Map
     (MemSegmentOff (RegAddrWidth (ArchReg arch))) NoReturnFunStatus
forall arch.
DiscoveryState arch -> Map (ArchSegmentOff arch) NoReturnFunStatus
_trustedFunctionEntryPoints (\DiscoveryState arch
s Map (MemSegmentOff (RegAddrWidth (ArchReg arch))) NoReturnFunStatus
v -> DiscoveryState arch
s { _trustedFunctionEntryPoints = v })

exploreFnPred :: Simple Lens (DiscoveryState arch) (ArchSegmentOff arch -> Bool)
exploreFnPred :: forall arch (f :: Type -> Type).
Functor f =>
((ArchSegmentOff arch -> Bool) -> f (ArchSegmentOff arch -> Bool))
-> DiscoveryState arch -> f (DiscoveryState arch)
exploreFnPred = (DiscoveryState arch
 -> MemSegmentOff (RegAddrWidth (ArchReg arch)) -> Bool)
-> (DiscoveryState arch
    -> (MemSegmentOff (RegAddrWidth (ArchReg arch)) -> Bool)
    -> DiscoveryState arch)
-> Lens
     (DiscoveryState arch)
     (DiscoveryState arch)
     (MemSegmentOff (RegAddrWidth (ArchReg arch)) -> Bool)
     (MemSegmentOff (RegAddrWidth (ArchReg arch)) -> Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DiscoveryState arch
-> MemSegmentOff (RegAddrWidth (ArchReg arch)) -> Bool
forall arch. DiscoveryState arch -> ArchSegmentOff arch -> Bool
_exploreFnPred (\DiscoveryState arch
s MemSegmentOff (RegAddrWidth (ArchReg arch)) -> Bool
v -> DiscoveryState arch
s { _exploreFnPred = v })

------------------------------------------------------------------------
-- DiscoveryState utilities

-- | Constraint on architecture register values needed by code exploration.
type RegConstraint r = (OrdF r, HasRepr r TypeRepr, RegisterInfo r, ShowF r)