{-# LANGUAGE DeriveGeneric, DefaultSignatures, StrictData, StandaloneDeriving, BangPatterns #-}
module Data.SValue where
import Data.SymbolicExpression
import Base
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import Data.Word
import Data.List
import GHC.Generics
import qualified Data.Serialize as Cereal
import Data.Bits (testBit)
import qualified Data.Set.NonEmpty as NES
import qualified Data.Foldable as F
import Control.DeepSeq
data PtrOffset = PtrOffset Word64 | UnknownOffset
deriving (PtrOffset -> PtrOffset -> Bool
(PtrOffset -> PtrOffset -> Bool)
-> (PtrOffset -> PtrOffset -> Bool) -> Eq PtrOffset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PtrOffset -> PtrOffset -> Bool
$c/= :: PtrOffset -> PtrOffset -> Bool
== :: PtrOffset -> PtrOffset -> Bool
$c== :: PtrOffset -> PtrOffset -> Bool
Eq,Eq PtrOffset
Eq PtrOffset
-> (PtrOffset -> PtrOffset -> Ordering)
-> (PtrOffset -> PtrOffset -> Bool)
-> (PtrOffset -> PtrOffset -> Bool)
-> (PtrOffset -> PtrOffset -> Bool)
-> (PtrOffset -> PtrOffset -> Bool)
-> (PtrOffset -> PtrOffset -> PtrOffset)
-> (PtrOffset -> PtrOffset -> PtrOffset)
-> Ord PtrOffset
PtrOffset -> PtrOffset -> Bool
PtrOffset -> PtrOffset -> Ordering
PtrOffset -> PtrOffset -> PtrOffset
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PtrOffset -> PtrOffset -> PtrOffset
$cmin :: PtrOffset -> PtrOffset -> PtrOffset
max :: PtrOffset -> PtrOffset -> PtrOffset
$cmax :: PtrOffset -> PtrOffset -> PtrOffset
>= :: PtrOffset -> PtrOffset -> Bool
$c>= :: PtrOffset -> PtrOffset -> Bool
> :: PtrOffset -> PtrOffset -> Bool
$c> :: PtrOffset -> PtrOffset -> Bool
<= :: PtrOffset -> PtrOffset -> Bool
$c<= :: PtrOffset -> PtrOffset -> Bool
< :: PtrOffset -> PtrOffset -> Bool
$c< :: PtrOffset -> PtrOffset -> Bool
compare :: PtrOffset -> PtrOffset -> Ordering
$ccompare :: PtrOffset -> PtrOffset -> Ordering
$cp1Ord :: Eq PtrOffset
Ord,(forall x. PtrOffset -> Rep PtrOffset x)
-> (forall x. Rep PtrOffset x -> PtrOffset) -> Generic PtrOffset
forall x. Rep PtrOffset x -> PtrOffset
forall x. PtrOffset -> Rep PtrOffset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PtrOffset x -> PtrOffset
$cfrom :: forall x. PtrOffset -> Rep PtrOffset x
Generic)
data SPointer =
Base_StackPointer String PtrOffset
| Base_Immediate Word64 PtrOffset
| Base_Malloc (Maybe Word64) (Maybe String) PtrOffset
| Base_FunctionPtr Word64 String PtrOffset
| Base_ReturnAddr String
| Base_TLS PtrOffset
| Base_StatePart StatePart PtrOffset
| Base_FunctionReturn String PtrOffset
deriving (SPointer -> SPointer -> Bool
(SPointer -> SPointer -> Bool)
-> (SPointer -> SPointer -> Bool) -> Eq SPointer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SPointer -> SPointer -> Bool
$c/= :: SPointer -> SPointer -> Bool
== :: SPointer -> SPointer -> Bool
$c== :: SPointer -> SPointer -> Bool
Eq,Eq SPointer
Eq SPointer
-> (SPointer -> SPointer -> Ordering)
-> (SPointer -> SPointer -> Bool)
-> (SPointer -> SPointer -> Bool)
-> (SPointer -> SPointer -> Bool)
-> (SPointer -> SPointer -> Bool)
-> (SPointer -> SPointer -> SPointer)
-> (SPointer -> SPointer -> SPointer)
-> Ord SPointer
SPointer -> SPointer -> Bool
SPointer -> SPointer -> Ordering
SPointer -> SPointer -> SPointer
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SPointer -> SPointer -> SPointer
$cmin :: SPointer -> SPointer -> SPointer
max :: SPointer -> SPointer -> SPointer
$cmax :: SPointer -> SPointer -> SPointer
>= :: SPointer -> SPointer -> Bool
$c>= :: SPointer -> SPointer -> Bool
> :: SPointer -> SPointer -> Bool
$c> :: SPointer -> SPointer -> Bool
<= :: SPointer -> SPointer -> Bool
$c<= :: SPointer -> SPointer -> Bool
< :: SPointer -> SPointer -> Bool
$c< :: SPointer -> SPointer -> Bool
compare :: SPointer -> SPointer -> Ordering
$ccompare :: SPointer -> SPointer -> Ordering
$cp1Ord :: Eq SPointer
Ord,(forall x. SPointer -> Rep SPointer x)
-> (forall x. Rep SPointer x -> SPointer) -> Generic SPointer
forall x. Rep SPointer x -> SPointer
forall x. SPointer -> Rep SPointer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SPointer x -> SPointer
$cfrom :: forall x. SPointer -> Rep SPointer x
Generic)
data SAddend =
SAddend_StackPointer String
| SAddend_Immediate Word64
| SAddend_Malloc (Maybe Word64) (Maybe String)
| SAddend_FunctionPtr Word64 String
| SAddend_ReturnAddr String
| SAddend_TLS
| SAddend_StatePart StatePart
| SAddend_FunctionReturn String
deriving ((forall x. SAddend -> Rep SAddend x)
-> (forall x. Rep SAddend x -> SAddend) -> Generic SAddend
forall x. Rep SAddend x -> SAddend
forall x. SAddend -> Rep SAddend x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SAddend x -> SAddend
$cfrom :: forall x. SAddend -> Rep SAddend x
Generic,SAddend -> SAddend -> Bool
(SAddend -> SAddend -> Bool)
-> (SAddend -> SAddend -> Bool) -> Eq SAddend
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SAddend -> SAddend -> Bool
$c/= :: SAddend -> SAddend -> Bool
== :: SAddend -> SAddend -> Bool
$c== :: SAddend -> SAddend -> Bool
Eq,Eq SAddend
Eq SAddend
-> (SAddend -> SAddend -> Ordering)
-> (SAddend -> SAddend -> Bool)
-> (SAddend -> SAddend -> Bool)
-> (SAddend -> SAddend -> Bool)
-> (SAddend -> SAddend -> Bool)
-> (SAddend -> SAddend -> SAddend)
-> (SAddend -> SAddend -> SAddend)
-> Ord SAddend
SAddend -> SAddend -> Bool
SAddend -> SAddend -> Ordering
SAddend -> SAddend -> SAddend
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SAddend -> SAddend -> SAddend
$cmin :: SAddend -> SAddend -> SAddend
max :: SAddend -> SAddend -> SAddend
$cmax :: SAddend -> SAddend -> SAddend
>= :: SAddend -> SAddend -> Bool
$c>= :: SAddend -> SAddend -> Bool
> :: SAddend -> SAddend -> Bool
$c> :: SAddend -> SAddend -> Bool
<= :: SAddend -> SAddend -> Bool
$c<= :: SAddend -> SAddend -> Bool
< :: SAddend -> SAddend -> Bool
$c< :: SAddend -> SAddend -> Bool
compare :: SAddend -> SAddend -> Ordering
$ccompare :: SAddend -> SAddend -> Ordering
$cp1Ord :: Eq SAddend
Ord)
data SValue = SConcrete (NES.NESet SimpleExpr) | SAddends (NES.NESet (NES.NESet SAddend)) | Top
deriving ((forall x. SValue -> Rep SValue x)
-> (forall x. Rep SValue x -> SValue) -> Generic SValue
forall x. Rep SValue x -> SValue
forall x. SValue -> Rep SValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SValue x -> SValue
$cfrom :: forall x. SValue -> Rep SValue x
Generic,SValue -> SValue -> Bool
(SValue -> SValue -> Bool)
-> (SValue -> SValue -> Bool) -> Eq SValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SValue -> SValue -> Bool
$c/= :: SValue -> SValue -> Bool
== :: SValue -> SValue -> Bool
$c== :: SValue -> SValue -> Bool
Eq,Eq SValue
Eq SValue
-> (SValue -> SValue -> Ordering)
-> (SValue -> SValue -> Bool)
-> (SValue -> SValue -> Bool)
-> (SValue -> SValue -> Bool)
-> (SValue -> SValue -> Bool)
-> (SValue -> SValue -> SValue)
-> (SValue -> SValue -> SValue)
-> Ord SValue
SValue -> SValue -> Bool
SValue -> SValue -> Ordering
SValue -> SValue -> SValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SValue -> SValue -> SValue
$cmin :: SValue -> SValue -> SValue
max :: SValue -> SValue -> SValue
$cmax :: SValue -> SValue -> SValue
>= :: SValue -> SValue -> Bool
$c>= :: SValue -> SValue -> Bool
> :: SValue -> SValue -> Bool
$c> :: SValue -> SValue -> Bool
<= :: SValue -> SValue -> Bool
$c<= :: SValue -> SValue -> Bool
< :: SValue -> SValue -> Bool
$c< :: SValue -> SValue -> Bool
compare :: SValue -> SValue -> Ordering
$ccompare :: SValue -> SValue -> Ordering
$cp1Ord :: Eq SValue
Ord)
instance Cereal.Serialize PtrOffset
instance NFData PtrOffset
instance Cereal.Serialize SPointer
instance NFData SPointer
instance Cereal.Serialize SAddend
instance NFData SAddend
instance Cereal.Serialize SValue
instance NFData SValue
instance Show PtrOffset where
show :: PtrOffset -> String
show (PtrOffset Word64
i)
| Word64
i Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 = String
""
| Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
i Int
63 = String
" - 0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex (Word64
0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
i)
| Bool
otherwise = String
" + 0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
i
show PtrOffset
_ = String
" + Top"
instance Show SPointer where
show :: SPointer -> String
show (Base_StackPointer String
f PtrOffset
offset) = String
"RSP_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ PtrOffset -> String
forall a. Show a => a -> String
show PtrOffset
offset
show (Base_Immediate Word64
i PtrOffset
offset) = String
"0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ PtrOffset -> String
forall a. Show a => a -> String
show PtrOffset
offset
show (Base_Malloc Maybe Word64
id Maybe String
h PtrOffset
offset) = (SimpleExpr -> String
forall a. Show a => a -> String
show (SimpleExpr -> String) -> SimpleExpr -> String
forall a b. (a -> b) -> a -> b
$ Maybe Word64 -> Maybe String -> SimpleExpr
SE_Malloc Maybe Word64
id Maybe String
h) String -> ShowS
forall a. [a] -> [a] -> [a]
++ PtrOffset -> String
forall a. Show a => a -> String
show PtrOffset
offset
show (Base_FunctionPtr Word64
_ String
f PtrOffset
offset) = String
"&" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f
show (Base_ReturnAddr String
f) = String
"ReturnAddress_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f
show (Base_StatePart StatePart
sp PtrOffset
offset) = StatePart -> String
forall a. Show a => a -> String
show StatePart
sp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_0" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PtrOffset -> String
forall a. Show a => a -> String
show PtrOffset
offset
show (Base_TLS PtrOffset
offset) = String
"&TLS" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PtrOffset -> String
forall a. Show a => a -> String
show PtrOffset
offset
show (Base_FunctionReturn String
f PtrOffset
offset) = String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"()" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PtrOffset -> String
forall a. Show a => a -> String
show PtrOffset
offset
instance Show SAddend where
show :: SAddend -> String
show (SAddend_StackPointer String
f) = String
"RSP_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f
show (SAddend_Immediate Word64
i) = String
"P0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
i
show (SAddend_Malloc Maybe Word64
id Maybe String
h) = String
"P"String -> ShowS
forall a. [a] -> [a] -> [a]
++(SimpleExpr -> String
forall a. Show a => a -> String
show (SimpleExpr -> String) -> SimpleExpr -> String
forall a b. (a -> b) -> a -> b
$ Maybe Word64 -> Maybe String -> SimpleExpr
SE_Malloc Maybe Word64
id Maybe String
h)
show (SAddend_FunctionPtr Word64
_ String
f) = String
"&" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f
show (SAddend_ReturnAddr String
f) = String
"ReturnAddress_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f
show (SAddend_StatePart StatePart
sp) = StatePart -> String
forall a. Show a => a -> String
show StatePart
sp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_0"
show (SAddend
SAddend_TLS) = String
"&TLS"
show (SAddend_FunctionReturn String
f) = String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"()"
instance Show SValue where
show :: SValue -> String
show (SConcrete NESet SimpleExpr
es) = [String] -> String
show_set ((SimpleExpr -> String) -> [SimpleExpr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SimpleExpr -> String
forall a. Show a => a -> String
show ([SimpleExpr] -> [String]) -> [SimpleExpr] -> [String]
forall a b. (a -> b) -> a -> b
$ NESet SimpleExpr -> [SimpleExpr]
forall a. NESet a -> [a]
neSetToList NESet SimpleExpr
es)
show (SAddends NESet (NESet SAddend)
adds) = [String] -> String
show_set ((NESet SAddend -> String) -> [NESet SAddend] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map NESet SAddend -> String
forall a. Show a => NESet a -> String
show_addend ([NESet SAddend] -> [String]) -> [NESet SAddend] -> [String]
forall a b. (a -> b) -> a -> b
$ NESet (NESet SAddend) -> [NESet SAddend]
forall a. NESet a -> [a]
neSetToList NESet (NESet SAddend)
adds)
where
show_addend :: NESet a -> String
show_addend NESet a
adds = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"+" ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show ([a] -> [String]) -> [a] -> [String]
forall a b. (a -> b) -> a -> b
$ NESet a -> [a]
forall a. NESet a -> [a]
neSetToList NESet a
adds) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"+..."
show SValue
Top = String
"top"
show_set :: [String] -> String
show_set [String
str] = String
str
show_set [String]
strs = String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
strs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
isImmediateBase :: SAddend -> Bool
isImmediateBase (SAddend_Immediate Word64
_) = Bool
True
isImmediateBase SAddend
_ = Bool
False
isConcrete :: SValue -> Bool
isConcrete (SConcrete NESet SimpleExpr
es) = Bool
True
isConcrete SValue
_ = Bool
False
has_unknown_offset :: SPointer -> Bool
has_unknown_offset (Base_StackPointer String
f PtrOffset
UnknownOffset) = Bool
True
has_unknown_offset (Base_Immediate Word64
i PtrOffset
UnknownOffset) = Bool
False
has_unknown_offset (Base_Malloc Maybe Word64
id Maybe String
h PtrOffset
UnknownOffset) = Bool
True
has_unknown_offset (Base_FunctionPtr Word64
_ String
_ PtrOffset
UnknownOffset) = Bool
True
has_unknown_offset (Base_ReturnAddr String
f) = Bool
False
has_unknown_offset (Base_TLS PtrOffset
UnknownOffset) = Bool
True
has_unknown_offset (Base_StatePart StatePart
sp PtrOffset
UnknownOffset) = Bool
True
has_unknown_offset (Base_FunctionReturn String
f PtrOffset
UnknownOffset) = Bool
True
has_unknown_offset SPointer
_ = Bool
False
liftOffsetMod :: (Word64 -> Word64) -> PtrOffset -> PtrOffset
liftOffsetMod Word64 -> Word64
m PtrOffset
UnknownOffset = PtrOffset
UnknownOffset
liftOffsetMod Word64 -> Word64
m (PtrOffset Word64
i) = Word64 -> PtrOffset
PtrOffset (Word64 -> PtrOffset) -> Word64 -> PtrOffset
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64
m Word64
i
mod_offset :: (Word64 -> Word64) -> SPointer -> SPointer
mod_offset Word64 -> Word64
m (Base_StackPointer String
f PtrOffset
offset) = String -> PtrOffset -> SPointer
Base_StackPointer String
f (PtrOffset -> SPointer) -> PtrOffset -> SPointer
forall a b. (a -> b) -> a -> b
$ (Word64 -> Word64) -> PtrOffset -> PtrOffset
liftOffsetMod Word64 -> Word64
m (PtrOffset -> PtrOffset) -> PtrOffset -> PtrOffset
forall a b. (a -> b) -> a -> b
$ PtrOffset
offset
mod_offset Word64 -> Word64
m (Base_Malloc Maybe Word64
id Maybe String
h PtrOffset
offset) = Maybe Word64 -> Maybe String -> PtrOffset -> SPointer
Base_Malloc Maybe Word64
id Maybe String
h (PtrOffset -> SPointer) -> PtrOffset -> SPointer
forall a b. (a -> b) -> a -> b
$ (Word64 -> Word64) -> PtrOffset -> PtrOffset
liftOffsetMod Word64 -> Word64
m (PtrOffset -> PtrOffset) -> PtrOffset -> PtrOffset
forall a b. (a -> b) -> a -> b
$ PtrOffset
offset
mod_offset Word64 -> Word64
m (Base_FunctionPtr Word64
a String
f PtrOffset
offset) = Word64 -> String -> PtrOffset -> SPointer
Base_FunctionPtr Word64
a String
f (PtrOffset -> SPointer) -> PtrOffset -> SPointer
forall a b. (a -> b) -> a -> b
$ (Word64 -> Word64) -> PtrOffset -> PtrOffset
liftOffsetMod Word64 -> Word64
m (PtrOffset -> PtrOffset) -> PtrOffset -> PtrOffset
forall a b. (a -> b) -> a -> b
$ PtrOffset
offset
mod_offset Word64 -> Word64
m (Base_TLS PtrOffset
offset) = PtrOffset -> SPointer
Base_TLS (PtrOffset -> SPointer) -> PtrOffset -> SPointer
forall a b. (a -> b) -> a -> b
$ (Word64 -> Word64) -> PtrOffset -> PtrOffset
liftOffsetMod Word64 -> Word64
m (PtrOffset -> PtrOffset) -> PtrOffset -> PtrOffset
forall a b. (a -> b) -> a -> b
$ PtrOffset
offset
mod_offset Word64 -> Word64
m (Base_StatePart StatePart
sp PtrOffset
offset) = StatePart -> PtrOffset -> SPointer
Base_StatePart StatePart
sp (PtrOffset -> SPointer) -> PtrOffset -> SPointer
forall a b. (a -> b) -> a -> b
$ (Word64 -> Word64) -> PtrOffset -> PtrOffset
liftOffsetMod Word64 -> Word64
m (PtrOffset -> PtrOffset) -> PtrOffset -> PtrOffset
forall a b. (a -> b) -> a -> b
$ PtrOffset
offset
mod_offset Word64 -> Word64
m (Base_FunctionReturn String
f PtrOffset
offset) = String -> PtrOffset -> SPointer
Base_FunctionReturn String
f (PtrOffset -> SPointer) -> PtrOffset -> SPointer
forall a b. (a -> b) -> a -> b
$ (Word64 -> Word64) -> PtrOffset -> PtrOffset
liftOffsetMod Word64 -> Word64
m (PtrOffset -> PtrOffset) -> PtrOffset -> PtrOffset
forall a b. (a -> b) -> a -> b
$ PtrOffset
offset
mod_offset Word64 -> Word64
m SPointer
b = String -> SPointer
forall a. HasCallStack => String -> a
error (String -> SPointer) -> String -> SPointer
forall a b. (a -> b) -> a -> b
$ String
"Modding offset of: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SPointer -> String
forall a. Show a => a -> String
show SPointer
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show (Word64 -> Word64
m Word64
42)