{-# LANGUAGE DeriveGeneric #-}

module Data.X86.Instruction where

import Base

import Data.Size

import Data.Word
import Data.List
import Data.X86.Opcode
import Data.X86.Register
import Debug.Trace

import qualified Data.Serialize as Cereal hiding (get,put)
import Control.DeepSeq
import GHC.Generics (Generic)


data Instruction = Instruction {
      Instruction -> Word64
inAddress   :: Word64
    , Instruction -> [Prefix]
inPrefix    :: [Prefix]
    , Instruction -> Opcode
inOperation :: Opcode
    , Instruction -> Maybe Operand
inDest      :: Maybe Operand
    , Instruction -> [Operand]
inOperands  :: [Operand]
    , Instruction -> Int
inSize     :: Int
    } deriving (Instruction -> Instruction -> Bool
(Instruction -> Instruction -> Bool)
-> (Instruction -> Instruction -> Bool) -> Eq Instruction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Instruction -> Instruction -> Bool
== :: Instruction -> Instruction -> Bool
$c/= :: Instruction -> Instruction -> Bool
/= :: Instruction -> Instruction -> Bool
Eq, (forall x. Instruction -> Rep Instruction x)
-> (forall x. Rep Instruction x -> Instruction)
-> Generic Instruction
forall x. Rep Instruction x -> Instruction
forall x. Instruction -> Rep Instruction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Instruction -> Rep Instruction x
from :: forall x. Instruction -> Rep Instruction x
$cto :: forall x. Rep Instruction x -> Instruction
to :: forall x. Rep Instruction x -> Instruction
Generic,Eq Instruction
Eq Instruction =>
(Instruction -> Instruction -> Ordering)
-> (Instruction -> Instruction -> Bool)
-> (Instruction -> Instruction -> Bool)
-> (Instruction -> Instruction -> Bool)
-> (Instruction -> Instruction -> Bool)
-> (Instruction -> Instruction -> Instruction)
-> (Instruction -> Instruction -> Instruction)
-> Ord Instruction
Instruction -> Instruction -> Bool
Instruction -> Instruction -> Ordering
Instruction -> Instruction -> Instruction
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
$ccompare :: Instruction -> Instruction -> Ordering
compare :: Instruction -> Instruction -> Ordering
$c< :: Instruction -> Instruction -> Bool
< :: Instruction -> Instruction -> Bool
$c<= :: Instruction -> Instruction -> Bool
<= :: Instruction -> Instruction -> Bool
$c> :: Instruction -> Instruction -> Bool
> :: Instruction -> Instruction -> Bool
$c>= :: Instruction -> Instruction -> Bool
>= :: Instruction -> Instruction -> Bool
$cmax :: Instruction -> Instruction -> Instruction
max :: Instruction -> Instruction -> Instruction
$cmin :: Instruction -> Instruction -> Instruction
min :: Instruction -> Instruction -> Instruction
Ord)

data Prefix =
      PrefixO16
    | PrefixA32
    | PrefixRepNE
    | PrefixRep
    | PrefixLock
    | PrefixSeg SReg
    | PrefixRex Word8
    deriving (Int -> Prefix -> ShowS
[Prefix] -> ShowS
Prefix -> String
(Int -> Prefix -> ShowS)
-> (Prefix -> String) -> ([Prefix] -> ShowS) -> Show Prefix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Prefix -> ShowS
showsPrec :: Int -> Prefix -> ShowS
$cshow :: Prefix -> String
show :: Prefix -> String
$cshowList :: [Prefix] -> ShowS
showList :: [Prefix] -> ShowS
Show, Prefix -> Prefix -> Bool
(Prefix -> Prefix -> Bool)
-> (Prefix -> Prefix -> Bool) -> Eq Prefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Prefix -> Prefix -> Bool
== :: Prefix -> Prefix -> Bool
$c/= :: Prefix -> Prefix -> Bool
/= :: Prefix -> Prefix -> Bool
Eq, (forall x. Prefix -> Rep Prefix x)
-> (forall x. Rep Prefix x -> Prefix) -> Generic Prefix
forall x. Rep Prefix x -> Prefix
forall x. Prefix -> Rep Prefix x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Prefix -> Rep Prefix x
from :: forall x. Prefix -> Rep Prefix x
$cto :: forall x. Rep Prefix x -> Prefix
to :: forall x. Rep Prefix x -> Prefix
Generic, Eq Prefix
Eq Prefix =>
(Prefix -> Prefix -> Ordering)
-> (Prefix -> Prefix -> Bool)
-> (Prefix -> Prefix -> Bool)
-> (Prefix -> Prefix -> Bool)
-> (Prefix -> Prefix -> Bool)
-> (Prefix -> Prefix -> Prefix)
-> (Prefix -> Prefix -> Prefix)
-> Ord Prefix
Prefix -> Prefix -> Bool
Prefix -> Prefix -> Ordering
Prefix -> Prefix -> Prefix
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
$ccompare :: Prefix -> Prefix -> Ordering
compare :: Prefix -> Prefix -> Ordering
$c< :: Prefix -> Prefix -> Bool
< :: Prefix -> Prefix -> Bool
$c<= :: Prefix -> Prefix -> Bool
<= :: Prefix -> Prefix -> Bool
$c> :: Prefix -> Prefix -> Bool
> :: Prefix -> Prefix -> Bool
$c>= :: Prefix -> Prefix -> Bool
>= :: Prefix -> Prefix -> Bool
$cmax :: Prefix -> Prefix -> Prefix
max :: Prefix -> Prefix -> Prefix
$cmin :: Prefix -> Prefix -> Prefix
min :: Prefix -> Prefix -> Prefix
Ord)


data Operand =
        Op_Mem {
                Operand -> BitSize
mSize  :: BitSize
              , Operand -> BitSize
mASize :: BitSize
              , Operand -> Register
mReg   :: Register
              , Operand -> Register
mIdx   :: Register
              , Operand -> Word8
mScale :: Word8
              , Operand -> Int
mDisp  :: Int
              , Operand -> Maybe SReg
mSeg   :: Maybe SReg
              }
      | Op_Reg Register
      | Op_Imm Immediate
      | Op_Jmp Immediate
      | Op_Const Int
      | Op_Near Operand
      | Op_Far Operand
    deriving (Operand -> Operand -> Bool
(Operand -> Operand -> Bool)
-> (Operand -> Operand -> Bool) -> Eq Operand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Operand -> Operand -> Bool
== :: Operand -> Operand -> Bool
$c/= :: Operand -> Operand -> Bool
/= :: Operand -> Operand -> Bool
Eq, Eq Operand
Eq Operand =>
(Operand -> Operand -> Ordering)
-> (Operand -> Operand -> Bool)
-> (Operand -> Operand -> Bool)
-> (Operand -> Operand -> Bool)
-> (Operand -> Operand -> Bool)
-> (Operand -> Operand -> Operand)
-> (Operand -> Operand -> Operand)
-> Ord Operand
Operand -> Operand -> Bool
Operand -> Operand -> Ordering
Operand -> Operand -> Operand
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
$ccompare :: Operand -> Operand -> Ordering
compare :: Operand -> Operand -> Ordering
$c< :: Operand -> Operand -> Bool
< :: Operand -> Operand -> Bool
$c<= :: Operand -> Operand -> Bool
<= :: Operand -> Operand -> Bool
$c> :: Operand -> Operand -> Bool
> :: Operand -> Operand -> Bool
$c>= :: Operand -> Operand -> Bool
>= :: Operand -> Operand -> Bool
$cmax :: Operand -> Operand -> Operand
max :: Operand -> Operand -> Operand
$cmin :: Operand -> Operand -> Operand
min :: Operand -> Operand -> Operand
Ord, (forall x. Operand -> Rep Operand x)
-> (forall x. Rep Operand x -> Operand) -> Generic Operand
forall x. Rep Operand x -> Operand
forall x. Operand -> Rep Operand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Operand -> Rep Operand x
from :: forall x. Operand -> Rep Operand x
$cto :: forall x. Rep Operand x -> Operand
to :: forall x. Rep Operand x -> Operand
Generic)


data Immediate = Immediate {
        Immediate -> BitSize
iSize :: BitSize
      , Immediate -> Word64
iValue :: Word64
    } deriving (Immediate -> Immediate -> Bool
(Immediate -> Immediate -> Bool)
-> (Immediate -> Immediate -> Bool) -> Eq Immediate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Immediate -> Immediate -> Bool
== :: Immediate -> Immediate -> Bool
$c/= :: Immediate -> Immediate -> Bool
/= :: Immediate -> Immediate -> Bool
Eq, Eq Immediate
Eq Immediate =>
(Immediate -> Immediate -> Ordering)
-> (Immediate -> Immediate -> Bool)
-> (Immediate -> Immediate -> Bool)
-> (Immediate -> Immediate -> Bool)
-> (Immediate -> Immediate -> Bool)
-> (Immediate -> Immediate -> Immediate)
-> (Immediate -> Immediate -> Immediate)
-> Ord Immediate
Immediate -> Immediate -> Bool
Immediate -> Immediate -> Ordering
Immediate -> Immediate -> Immediate
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
$ccompare :: Immediate -> Immediate -> Ordering
compare :: Immediate -> Immediate -> Ordering
$c< :: Immediate -> Immediate -> Bool
< :: Immediate -> Immediate -> Bool
$c<= :: Immediate -> Immediate -> Bool
<= :: Immediate -> Immediate -> Bool
$c> :: Immediate -> Immediate -> Bool
> :: Immediate -> Immediate -> Bool
$c>= :: Immediate -> Immediate -> Bool
>= :: Immediate -> Immediate -> Bool
$cmax :: Immediate -> Immediate -> Immediate
max :: Immediate -> Immediate -> Immediate
$cmin :: Immediate -> Immediate -> Immediate
min :: Immediate -> Immediate -> Immediate
Ord, (forall x. Immediate -> Rep Immediate x)
-> (forall x. Rep Immediate x -> Immediate) -> Generic Immediate
forall x. Rep Immediate x -> Immediate
forall x. Immediate -> Rep Immediate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Immediate -> Rep Immediate x
from :: forall x. Immediate -> Rep Immediate x
$cto :: forall x. Rep Immediate x -> Immediate
to :: forall x. Rep Immediate x -> Immediate
Generic)

instance Show Immediate where
  show :: Immediate -> String
show (Immediate BitSize
si Word64
v) = String
"0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
v



instance Show Operand where
  show :: Operand -> String
show (Op_Reg Register
r)   = Register -> String
forall a. Show a => a -> String
show Register
r
  show (Op_Imm Immediate
imm) = Immediate -> String
forall a. Show a => a -> String
show Immediate
imm
  show (Op_Jmp Immediate
imm) = Immediate -> String
forall a. Show a => a -> String
show Immediate
imm
  show (Op_Const Int
c) = Int -> String
forall a. Show a => a -> String
show Int
c
  show (Op_Near Operand
op) = Operand -> String
forall a. Show a => a -> String
show Operand
op
  show (Op_Far Operand
op)  = Operand -> String
forall a. Show a => a -> String
show Operand
op

  show (Op_Mem (BitSize Int
si) BitSize
_ Register
reg Register
idx Word8
scale Int
displ Maybe SReg
seg) = Int -> String
forall {a}. (Eq a, Num a) => a -> String
show_size_directive Int
si String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe SReg -> String
forall {a}. Show a => Maybe a -> String
show_seg Maybe SReg
seg String -> ShowS
forall a. [a] -> [a] -> [a]
++ Register -> String
show_reg Register
reg String -> ShowS
forall a. [a] -> [a] -> [a]
++ Register -> Word8 -> String
forall {a}. Integral a => Register -> a -> String
show_idx_scale Register
idx Word8
scale String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall {a}. Integral a => a -> String
show_displ Int
displ String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
   where
    show_seg :: Maybe a -> String
show_seg Maybe a
Nothing  = String
""
    show_seg (Just a
r) = a -> String
forall a. Show a => a -> String
show a
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":"
    show_reg :: Register -> String
show_reg Register
RegNone = String
""
    show_reg Register
reg     = Register -> String
forall a. Show a => a -> String
show Register
reg
    show_idx_scale :: Register -> a -> String
show_idx_scale Register
RegNone a
0 = String
""
    show_idx_scale Register
RegNone a
1 = String
""
    show_idx_scale Register
_  a
0      = ShowS
forall a. HasCallStack => String -> a
error String
"todo"
    show_idx_scale Register
idx a
scale = String
" + " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Register -> String
forall a. Show a => a -> String
show Register
idx String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall {a}. Integral a => a -> String
showHex a
scale
    show_displ :: a -> String
show_displ a
displ = if a
displ a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then String
" - 0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall {a}. Integral a => a -> String
showHex (a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
0a -> a -> a
forall a. Num a => a -> a -> a
-a
displ)) else String
" + 0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall {a}. Integral a => a -> String
showHex a
displ 
    show_size_directive :: a -> String
show_size_directive a
128 = String
"XWORD PTR"
    show_size_directive a
80 = String
"TWORD PTR"
    show_size_directive a
64 = String
"QWORD PTR"
    show_size_directive a
32 = String
"DWORD PTR"
    show_size_directive a
16 = String
"WORD PTR"
    show_size_directive a
8 = String
"BYTE PTR"



instance Show Instruction where
  show :: Instruction -> String
show (Instruction Word64
a [Prefix]
ps Opcode
op Maybe Operand
dst [Operand]
srcs Int
si) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": "
    , (Prefix -> String) -> [Prefix] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Prefix -> String
show_prefix [Prefix]
ps
    , Opcode -> String
forall a. Show a => a -> String
show Opcode
op
    , String
" "
    , Maybe Operand -> String
forall {a}. Show a => Maybe a -> String
show_dst Maybe Operand
dst
    , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Operand -> String) -> [Operand] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Operand -> String
forall a. Show a => a -> String
show [Operand]
srcs)
    , String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
si String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")" ]
   where
    show_prefix :: Prefix -> String
show_prefix (PrefixRex Word8
_) = String
""
    show_prefix (PrefixSeg SReg
_) = String
""
    show_prefix (Prefix
PrefixO16)   = String
""
    show_prefix Prefix
p = Prefix -> String
forall a. Show a => a -> String
show Prefix
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
    show_dst :: Maybe a -> String
show_dst Maybe a
Nothing = String
""
    show_dst (Just a
dst) = a -> String
forall a. Show a => a -> String
show a
dst String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" <- "




operand_size :: Operand -> ByteSize
operand_size (Op_Reg Register
r)   = Register -> ByteSize
regSize Register
r
operand_size (Op_Mem (BitSize Int
128) BitSize
_ Register
_ Register
_ Word8
_ Int
_ Maybe SReg
_) = Int -> ByteSize
ByteSize Int
16
operand_size (Op_Mem (BitSize Int
80) BitSize
_ Register
_ Register
_ Word8
_ Int
_ Maybe SReg
_) = Int -> ByteSize
ByteSize Int
10
operand_size (Op_Mem (BitSize Int
64) BitSize
_ Register
_ Register
_ Word8
_ Int
_ Maybe SReg
_) = Int -> ByteSize
ByteSize Int
8
operand_size (Op_Mem (BitSize Int
32) BitSize
_ Register
_ Register
_ Word8
_ Int
_ Maybe SReg
_) = Int -> ByteSize
ByteSize Int
4
operand_size (Op_Mem (BitSize Int
16) BitSize
_ Register
_ Register
_ Word8
_ Int
_ Maybe SReg
_) = Int -> ByteSize
ByteSize Int
2
operand_size (Op_Mem (BitSize Int
8) BitSize
_ Register
_ Register
_ Word8
_ Int
_ Maybe SReg
_) = Int -> ByteSize
ByteSize Int
1
operand_size (Op_Const Int
_) = Int -> ByteSize
ByteSize Int
8
operand_size (Op_Imm (Immediate (BitSize Int
si) Word64
_)) = Int -> ByteSize
ByteSize (Int -> ByteSize) -> Int -> ByteSize
forall a b. (a -> b) -> a -> b
$ Int
si Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
operand_size Operand
op = String -> ByteSize
forall a. HasCallStack => String -> a
error (String -> ByteSize) -> String -> ByteSize
forall a b. (a -> b) -> a -> b
$ Operand -> String
forall a. Show a => a -> String
show Operand
op


mk_RSP_mem_operand :: ByteSize -> Operand
mk_RSP_mem_operand (ByteSize Int
si) = BitSize
-> BitSize
-> Register
-> Register
-> Word8
-> Int
-> Maybe SReg
-> Operand
Op_Mem (Int -> BitSize
BitSize (Int -> BitSize) -> Int -> BitSize
forall a b. (a -> b) -> a -> b
$ Int
siInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8) (Int -> BitSize
BitSize Int
64) (GPR -> Register
Reg64 GPR
RSP) Register
RegNone Word8
0 Int
0 Maybe SReg
forall a. Maybe a
Nothing

srcs :: Instruction -> [Operand]
srcs (Instruction Word64
_ [Prefix]
_ Opcode
_ Maybe Operand
_ [Operand]
srcs Int
_) = [Operand]
srcs


-- | Canonicalizes an instruction by making sure there is at most one output and inputs/outputs are syntactically clear.
-- | For example, the IMUL instruction comes in different flavors that hide the actual inputs and outputs to multiple registers
canonicalize :: Instruction -> [Instruction]
canonicalize :: Instruction -> [Instruction]
canonicalize (Instruction Word64
label [Prefix]
prefix Opcode
PUSH Maybe Operand
Nothing [Operand
op1] Int
annot) =
  let ByteSize Int
si' = Operand -> ByteSize
operand_size Operand
op1
      si :: Int
si = Int
8-- if si' == 1 then 8 else si' -- TODO TEST if operandsize /= 8 or 1
  in [ Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction
         Word64
label
         [Prefix]
prefix
         Opcode
SUB
         (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ GPR -> Register
Reg64 GPR
RSP)
         [Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ GPR -> Register
Reg64 GPR
RSP, Immediate -> Operand
Op_Imm (Immediate -> Operand) -> Immediate -> Operand
forall a b. (a -> b) -> a -> b
$ BitSize -> Word64 -> Immediate
Immediate (Int -> BitSize
BitSize Int
64) (Word64 -> Immediate) -> Word64 -> Immediate
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
si]
         Int
annot
     , Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction
         Word64
label
         [Prefix]
prefix
         Opcode
MOV
         (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ ByteSize -> Operand
mk_RSP_mem_operand (Int -> ByteSize
ByteSize Int
si))
         [Operand
op1]
         Int
annot]
-- POP
canonicalize (Instruction Word64
label [Prefix]
prefix Opcode
POP Maybe Operand
Nothing [Operand
op1] Int
annot) =
  let ByteSize Int
si' = Operand -> ByteSize
operand_size Operand
op1
      si :: Int
si = Int
8-- if si' == 1 then 8 else si'
  in [ Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction
         Word64
label
         [Prefix]
prefix
         Opcode
MOV
         (Operand -> Maybe Operand
forall a. a -> Maybe a
Just Operand
op1)
         [ByteSize -> Operand
mk_RSP_mem_operand (Int -> ByteSize
ByteSize Int
si)]
         Int
annot
     , Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction
         Word64
label
         [Prefix]
prefix
         Opcode
ADD
         (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ GPR -> Register
Reg64 GPR
RSP)
         [Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ GPR -> Register
Reg64 GPR
RSP, Immediate -> Operand
Op_Imm (Immediate -> Operand) -> Immediate -> Operand
forall a b. (a -> b) -> a -> b
$ BitSize -> Word64 -> Immediate
Immediate (Int -> BitSize
BitSize Int
64) (Word64 -> Immediate) -> Word64 -> Immediate
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
si]
         Int
annot]
-- LEAVE 
canonicalize (Instruction Word64
label [Prefix]
prefix Opcode
LEAVE Maybe Operand
Nothing [] Int
annot) =
  Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
MOV (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ GPR -> Register
Reg64 GPR
RSP) [Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ GPR -> Register
Reg64 GPR
RBP] Int
annot
  Instruction -> [Instruction] -> [Instruction]
forall a. a -> [a] -> [a]
:Instruction -> [Instruction]
canonicalize (Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
POP Maybe Operand
forall a. Maybe a
Nothing [Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ GPR -> Register
Reg64 GPR
RBP] Int
annot)
-- XCHG
canonicalize (Instruction Word64
label [Prefix]
prefix Opcode
XCHG Maybe Operand
Nothing [Operand
dst,Operand
src] Int
annot) =
  [
    Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
MOV (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg Register
RegTemp) [Operand
dst] Int
annot,
    Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
MOV (Operand -> Maybe Operand
forall a. a -> Maybe a
Just Operand
dst) [Operand
src] Int
annot,
    Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
MOV (Operand -> Maybe Operand
forall a. a -> Maybe a
Just Operand
src) [Register -> Operand
Op_Reg Register
RegTemp] Int
annot
  ]
-- XADD
canonicalize (Instruction Word64
label [Prefix]
prefix Opcode
XADD Maybe Operand
Nothing [Operand
dst,Operand
src] Int
annot) =
  [
    Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
ADD (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg Register
RegTemp) [Operand
dst,Operand
src] Int
annot,
    Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
MOV (Operand -> Maybe Operand
forall a. a -> Maybe a
Just Operand
src) [Operand
dst] Int
annot,
    Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
MOV (Operand -> Maybe Operand
forall a. a -> Maybe a
Just Operand
dst) [Register -> Operand
Op_Reg Register
RegTemp] Int
annot
  ]
-- CMPXCHG
canonicalize (Instruction Word64
label [Prefix]
prefix Opcode
CMPXCHG Maybe Operand
Nothing [Operand
dst,Operand
src] Int
annot) =
  [
    Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
CMPXCHG (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ GPR -> Register
Reg64 GPR
RAX) [Operand
dst,Operand
src] Int
annot,
    Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
CMPXCHG (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Operand
dst) [Operand
dst,Operand
src] Int
annot
  ]
-- XGETBV
canonicalize (Instruction Word64
label [Prefix]
prefix Opcode
XGETBV Maybe Operand
Nothing [] Int
annot) =
  [
    Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
XGETBV (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ GPR -> Register
Reg32 GPR
RDX) [] Int
annot,
    Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
XGETBV (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ GPR -> Register
Reg32 GPR
RAX) [] Int
annot
  ]
-- The remaining cases
canonicalize i :: Instruction
i@(Instruction Word64
label [Prefix]
prefix Opcode
mnemonic Maybe Operand
Nothing [Operand]
ops Int
annot)
  | Opcode
mnemonic Opcode -> [Opcode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Opcode
CBW, Opcode
CWDE, Opcode
CDQE] = Instruction -> [Instruction]
canonicalize_sextend1 Instruction
i
  | Opcode
mnemonic Opcode -> [Opcode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Opcode
CWD, Opcode
CDQ, Opcode
CQO] = Instruction -> [Instruction]
canonicalize_sextend2 Instruction
i
  | Opcode
mnemonic Opcode -> [Opcode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Opcode
MUL, Opcode
IMUL] = Instruction -> [Instruction]
canonicalize_mul Instruction
i
  | Opcode
mnemonic Opcode -> [Opcode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Opcode
DIV, Opcode
IDIV] = Instruction -> [Instruction]
canonicalize_div Instruction
i
  | Opcode
mnemonic Opcode -> [Opcode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Opcode
MOVS,Opcode
MOVSB,Opcode
MOVSW,Opcode
MOVSD,Opcode
MOVSQ] Bool -> Bool -> Bool
&& [Operand] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Operand]
ops Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = 
    [Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
mnemonic (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ [Operand] -> Operand
forall a. HasCallStack => [a] -> a
head [Operand]
ops) ([Operand] -> [Operand]
forall a. HasCallStack => [a] -> [a]
tail [Operand]
ops) Int
annot]

  | Opcode
mnemonic Opcode -> Opcode -> Bool
forall a. Eq a => a -> a -> Bool
== Opcode
MOVSB Bool -> Bool -> Bool
&& [Operand]
ops [Operand] -> [Operand] -> Bool
forall a. Eq a => a -> a -> Bool
== [] =
    [Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
mnemonic (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ BitSize
-> BitSize
-> Register
-> Register
-> Word8
-> Int
-> Maybe SReg
-> Operand
Op_Mem (Int -> BitSize
BitSize Int
8) (Int -> BitSize
BitSize Int
64) (GPR -> Register
Reg64 GPR
RDI) Register
RegNone Word8
0 Int
0 (SReg -> Maybe SReg
forall a. a -> Maybe a
Just SReg
ES)) [BitSize
-> BitSize
-> Register
-> Register
-> Word8
-> Int
-> Maybe SReg
-> Operand
Op_Mem (Int -> BitSize
BitSize Int
8) (Int -> BitSize
BitSize Int
64) (GPR -> Register
Reg64 GPR
RSI) Register
RegNone Word8
0 Int
0 (SReg -> Maybe SReg
forall a. a -> Maybe a
Just SReg
DS)] Int
annot]
  | Opcode
mnemonic Opcode -> Opcode -> Bool
forall a. Eq a => a -> a -> Bool
== Opcode
MOVSW Bool -> Bool -> Bool
&& [Operand]
ops [Operand] -> [Operand] -> Bool
forall a. Eq a => a -> a -> Bool
== [] =
    [Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
mnemonic (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ BitSize
-> BitSize
-> Register
-> Register
-> Word8
-> Int
-> Maybe SReg
-> Operand
Op_Mem (Int -> BitSize
BitSize Int
16) (Int -> BitSize
BitSize Int
64) (GPR -> Register
Reg64 GPR
RDI) Register
RegNone Word8
0 Int
0 (SReg -> Maybe SReg
forall a. a -> Maybe a
Just SReg
ES)) [BitSize
-> BitSize
-> Register
-> Register
-> Word8
-> Int
-> Maybe SReg
-> Operand
Op_Mem (Int -> BitSize
BitSize Int
16) (Int -> BitSize
BitSize Int
64) (GPR -> Register
Reg64 GPR
RSI) Register
RegNone Word8
0 Int
0 (SReg -> Maybe SReg
forall a. a -> Maybe a
Just SReg
DS)] Int
annot]
  | Opcode
mnemonic Opcode -> Opcode -> Bool
forall a. Eq a => a -> a -> Bool
== Opcode
MOVSD Bool -> Bool -> Bool
&& [Operand]
ops [Operand] -> [Operand] -> Bool
forall a. Eq a => a -> a -> Bool
== [] =
    [Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
mnemonic (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ BitSize
-> BitSize
-> Register
-> Register
-> Word8
-> Int
-> Maybe SReg
-> Operand
Op_Mem (Int -> BitSize
BitSize Int
32) (Int -> BitSize
BitSize Int
64) (GPR -> Register
Reg64 GPR
RDI) Register
RegNone Word8
0 Int
0 (SReg -> Maybe SReg
forall a. a -> Maybe a
Just SReg
ES)) [BitSize
-> BitSize
-> Register
-> Register
-> Word8
-> Int
-> Maybe SReg
-> Operand
Op_Mem (Int -> BitSize
BitSize Int
32) (Int -> BitSize
BitSize Int
64) (GPR -> Register
Reg64 GPR
RSI) Register
RegNone Word8
0 Int
0 (SReg -> Maybe SReg
forall a. a -> Maybe a
Just SReg
DS)] Int
annot]
  | Opcode
mnemonic Opcode -> Opcode -> Bool
forall a. Eq a => a -> a -> Bool
== Opcode
MOVSQ Bool -> Bool -> Bool
&& [Operand]
ops [Operand] -> [Operand] -> Bool
forall a. Eq a => a -> a -> Bool
== [] =
    [Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
mnemonic (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ BitSize
-> BitSize
-> Register
-> Register
-> Word8
-> Int
-> Maybe SReg
-> Operand
Op_Mem (Int -> BitSize
BitSize Int
64) (Int -> BitSize
BitSize Int
64) (GPR -> Register
Reg64 GPR
RDI) Register
RegNone Word8
0 Int
0 (SReg -> Maybe SReg
forall a. a -> Maybe a
Just SReg
ES)) [BitSize
-> BitSize
-> Register
-> Register
-> Word8
-> Int
-> Maybe SReg
-> Operand
Op_Mem (Int -> BitSize
BitSize Int
64) (Int -> BitSize
BitSize Int
64) (GPR -> Register
Reg64 GPR
RSI) Register
RegNone Word8
0 Int
0 (SReg -> Maybe SReg
forall a. a -> Maybe a
Just SReg
DS)] Int
annot]

  | Opcode
mnemonic Opcode -> Opcode -> Bool
forall a. Eq a => a -> a -> Bool
== Opcode
STOSB =
    [Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
mnemonic (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ BitSize
-> BitSize
-> Register
-> Register
-> Word8
-> Int
-> Maybe SReg
-> Operand
Op_Mem (Int -> BitSize
BitSize Int
8) (Int -> BitSize
BitSize Int
64) (GPR -> Register
Reg64 GPR
RDI) Register
RegNone Word8
0 Int
0 (SReg -> Maybe SReg
forall a. a -> Maybe a
Just SReg
ES)) [Register -> Operand
Op_Reg (GPR -> RegHalf -> Register
Reg8 GPR
RAX RegHalf
HalfL)] Int
annot]
  | Opcode
mnemonic Opcode -> Opcode -> Bool
forall a. Eq a => a -> a -> Bool
== Opcode
STOSW =
    [Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
mnemonic (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ BitSize
-> BitSize
-> Register
-> Register
-> Word8
-> Int
-> Maybe SReg
-> Operand
Op_Mem (Int -> BitSize
BitSize Int
16) (Int -> BitSize
BitSize Int
64) (GPR -> Register
Reg64 GPR
RDI) Register
RegNone Word8
0 Int
0 (SReg -> Maybe SReg
forall a. a -> Maybe a
Just SReg
ES)) [Register -> Operand
Op_Reg (GPR -> Register
Reg16 GPR
RAX)] Int
annot]
  | Opcode
mnemonic Opcode -> Opcode -> Bool
forall a. Eq a => a -> a -> Bool
== Opcode
STOSD =
    [Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
mnemonic (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ BitSize
-> BitSize
-> Register
-> Register
-> Word8
-> Int
-> Maybe SReg
-> Operand
Op_Mem (Int -> BitSize
BitSize Int
32) (Int -> BitSize
BitSize Int
64) (GPR -> Register
Reg64 GPR
RDI) Register
RegNone Word8
0 Int
0 (SReg -> Maybe SReg
forall a. a -> Maybe a
Just SReg
ES)) [Register -> Operand
Op_Reg (GPR -> Register
Reg32 GPR
RAX)] Int
annot]
  | Opcode
mnemonic Opcode -> Opcode -> Bool
forall a. Eq a => a -> a -> Bool
== Opcode
STOSQ =
    [Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
mnemonic (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ BitSize
-> BitSize
-> Register
-> Register
-> Word8
-> Int
-> Maybe SReg
-> Operand
Op_Mem (Int -> BitSize
BitSize Int
64) (Int -> BitSize
BitSize Int
64) (GPR -> Register
Reg64 GPR
RDI) Register
RegNone Word8
0 Int
0 (SReg -> Maybe SReg
forall a. a -> Maybe a
Just SReg
ES)) [Register -> Operand
Op_Reg (GPR -> Register
Reg64 GPR
RAX)] Int
annot]
  | Opcode -> Bool
mnemonic_reads_from_all_operands Opcode
mnemonic =
    [Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
mnemonic (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ [Operand] -> Operand
forall a. HasCallStack => [a] -> a
head [Operand]
ops) [Operand]
ops Int
annot]
  | Opcode -> Bool
mnemonic_reads_from_all_but_first_operands Opcode
mnemonic =
    [Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
mnemonic (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ [Operand] -> Operand
forall a. HasCallStack => [a] -> a
head [Operand]
ops) ([Operand] -> [Operand]
forall a. HasCallStack => [a] -> [a]
tail [Operand]
ops) Int
annot]
  | Opcode -> Bool
remove_destination Opcode
mnemonic = [Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
mnemonic Maybe Operand
forall a. Maybe a
Nothing [] Int
annot]
  | Opcode -> Bool
do_not_modify Opcode
mnemonic = [Instruction
i]
  | Bool
otherwise = String -> [Instruction]
forall a. HasCallStack => String -> a
error (String -> [Instruction]) -> String -> [Instruction]
forall a b. (a -> b) -> a -> b
$ String
"Cannot canonicalize instruction: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Instruction -> String
forall a. Show a => a -> String
show Instruction
i
canonicalize Instruction
_ = String -> [Instruction]
forall a. HasCallStack => String -> a
error String
"Unknown instruction"


-- CBW / CWDE / CDQE
canonicalize_sextend1 :: Instruction -> [Instruction]
canonicalize_sextend1 (Instruction Word64
label [Prefix]
prefix Opcode
mnemonic Maybe Operand
Nothing [] Int
annot) =
  let srcs :: [Register]
srcs = case Opcode
mnemonic of
        Opcode
CBW  -> [GPR -> Register
Reg16 GPR
RAX, GPR -> RegHalf -> Register
Reg8 GPR
RAX RegHalf
HalfL]
        Opcode
CWDE -> [GPR -> Register
Reg32 GPR
RAX, GPR -> Register
Reg16 GPR
RAX]
        Opcode
CDQE -> [GPR -> Register
Reg64 GPR
RAX, GPR -> Register
Reg32 GPR
RAX]
        Opcode
_    -> String -> [Register]
forall a. HasCallStack => String -> a
error String
"Invalid extend sources"
  in [ Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction
         Word64
label
         [Prefix]
prefix
         Opcode
mnemonic
         (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ [Register] -> Register
forall a. HasCallStack => [a] -> a
head [Register]
srcs)
         [Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ [Register]
srcs [Register] -> Int -> Register
forall a. HasCallStack => [a] -> Int -> a
!! Int
1]
         Int
annot]
canonicalize_sextend1 Instruction
_ = String -> [Instruction]
forall a. HasCallStack => String -> a
error String
"Invalid extend instruction"

-- CWD / CDQ / CQO
canonicalize_sextend2 :: Instruction -> [Instruction]
canonicalize_sextend2 (Instruction Word64
label [Prefix]
prefix Opcode
mnemonic Maybe Operand
Nothing [] Int
annot) =
  let srcs :: [Register]
srcs = case Opcode
mnemonic of
        Opcode
CWD -> [GPR -> Register
Reg16 GPR
RDX, GPR -> Register
Reg16 GPR
RAX]
        Opcode
CDQ -> [GPR -> Register
Reg32 GPR
RDX, GPR -> Register
Reg32 GPR
RAX]
        Opcode
CQO -> [GPR -> Register
Reg64 GPR
RDX, GPR -> Register
Reg64 GPR
RAX]
        Opcode
_   -> String -> [Register]
forall a. HasCallStack => String -> a
error String
"invalid extends source"
  in [ Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction
         Word64
label
         [Prefix]
prefix
         Opcode
mnemonic
         (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ [Register] -> Register
forall a. HasCallStack => [a] -> a
head [Register]
srcs)
         [Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ [Register]
srcs [Register] -> Int -> Register
forall a. HasCallStack => [a] -> Int -> a
!! Int
1]
         Int
annot ]
canonicalize_sextend2 Instruction
_ = String -> [Instruction]
forall a. HasCallStack => String -> a
error String
"Invalid extend instruction"

-- MUL /IMUL (1)
canonicalize_mul :: Instruction -> [Instruction]
canonicalize_mul (Instruction Word64
label [Prefix]
prefix Opcode
mnemonic Maybe Operand
Nothing [Operand
op1] Int
annot) =
  let srcs :: [Register]
srcs = case Operand -> ByteSize
operand_size Operand
op1 of
        ByteSize Int
8 -> [GPR -> Register
Reg64 GPR
RDX, GPR -> Register
Reg64 GPR
RAX]
        ByteSize Int
4 -> [GPR -> Register
Reg32 GPR
RDX, GPR -> Register
Reg32 GPR
RAX]
        ByteSize Int
2 -> [GPR -> Register
Reg16 GPR
RDX, GPR -> Register
Reg16 GPR
RAX]
        ByteSize Int
1 -> [GPR -> RegHalf -> Register
Reg8 GPR
RAX RegHalf
HalfH, GPR -> RegHalf -> Register
Reg8 GPR
RAX RegHalf
HalfL]
        ByteSize
_ -> String -> [Register]
forall a. HasCallStack => String -> a
error String
"Invalid operand size"
  in [ Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction
         Word64
label
         [Prefix]
prefix
         (Opcode -> Opcode
hipart Opcode
mnemonic)
         (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ [Register] -> Register
forall a. HasCallStack => [a] -> a
head [Register]
srcs)
         [Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ [Register]
srcs [Register] -> Int -> Register
forall a. HasCallStack => [a] -> Int -> a
!! Int
1, Operand
op1]
         Int
annot
     , Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction
         Word64
label
         [Prefix]
prefix
         (Opcode -> Opcode
lowpart Opcode
mnemonic)
         (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ [Register]
srcs [Register] -> Int -> Register
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
         [Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ [Register]
srcs [Register] -> Int -> Register
forall a. HasCallStack => [a] -> Int -> a
!! Int
1, Operand
op1]
         Int
annot]
-- MUL /IMUL (2)
canonicalize_mul (Instruction Word64
label [Prefix]
prefix Opcode
mnemonic Maybe Operand
Nothing [Operand
op1, Operand
op2] Int
annot) =
  [Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
mnemonic (Operand -> Maybe Operand
forall a. a -> Maybe a
Just Operand
op1) [Operand
op1, Operand
op2] Int
annot]
-- MUL /IMUL (3)
canonicalize_mul
  (Instruction Word64
label [Prefix]
prefix Opcode
mnemonic Maybe Operand
Nothing [Operand
op1, Operand
op2, Operand
op3] Int
annot) =
  [Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
mnemonic (Operand -> Maybe Operand
forall a. a -> Maybe a
Just Operand
op1) [Operand
op2, Operand
op3] Int
annot]
canonicalize_mul Instruction
_ = String -> [Instruction]
forall a. HasCallStack => String -> a
error String
"Invalid mul operation"

-- DIV /IDIV (1)
canonicalize_div :: Instruction -> [Instruction]
canonicalize_div (Instruction Word64
label [Prefix]
prefix Opcode
mnemonic Maybe Operand
Nothing [Operand
op1] Int
annot) =
  let srcs :: [Register]
srcs = case Operand -> ByteSize
operand_size Operand
op1 of
        ByteSize Int
8 -> [GPR -> Register
Reg64 GPR
RDX, GPR -> Register
Reg64 GPR
RAX]
        ByteSize Int
4 -> [GPR -> Register
Reg32 GPR
RDX, GPR -> Register
Reg32 GPR
RAX]
        ByteSize Int
2 -> [GPR -> Register
Reg16 GPR
RDX, GPR -> Register
Reg16 GPR
RAX]
        ByteSize Int
1 -> [GPR -> RegHalf -> Register
Reg8 GPR
RAX RegHalf
HalfH, GPR -> RegHalf -> Register
Reg8 GPR
RAX RegHalf
HalfL]
        ByteSize
_ -> String -> [Register]
forall a. HasCallStack => String -> a
error String
"Invalid operand size"
  in [ Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
MOV (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg Register
RegTemp) [Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ [Register] -> Register
forall a. HasCallStack => [a] -> a
head [Register]
srcs] Int
annot
     , Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction
         Word64
label
         [Prefix]
prefix
         (Opcode -> Opcode
hipart Opcode
mnemonic)
         (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ [Register] -> Register
forall a. HasCallStack => [a] -> a
head [Register]
srcs)
         [Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ [Register] -> Register
forall a. HasCallStack => [a] -> a
head [Register]
srcs, Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ [Register]
srcs [Register] -> Int -> Register
forall a. HasCallStack => [a] -> Int -> a
!! Int
1, Operand
op1]
         Int
annot
     , Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction
         Word64
label
         [Prefix]
prefix
         (Opcode -> Opcode
lowpart Opcode
mnemonic)
         (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ [Register]
srcs [Register] -> Int -> Register
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
         [Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ Register
RegTemp, Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ [Register]
srcs [Register] -> Int -> Register
forall a. HasCallStack => [a] -> Int -> a
!! Int
1, Operand
op1]
         Int
annot
     , Word64
-> [Prefix]
-> Opcode
-> Maybe Operand
-> [Operand]
-> Int
-> Instruction
Instruction Word64
label [Prefix]
prefix Opcode
MOV (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand -> Maybe Operand) -> Operand -> Maybe Operand
forall a b. (a -> b) -> a -> b
$ Register -> Operand
Op_Reg (Register -> Operand) -> Register -> Operand
forall a b. (a -> b) -> a -> b
$ [Register] -> Register
forall a. HasCallStack => [a] -> a
head [Register]
srcs) [Register -> Operand
Op_Reg Register
RegTemp] Int
annot ]
canonicalize_div Instruction
_ = String -> [Instruction]
forall a. HasCallStack => String -> a
error String
"Invalid div instruction"

-- Does the instruction read from all operands, including the first one?
mnemonic_reads_from_all_operands :: Opcode -> Bool
mnemonic_reads_from_all_operands Opcode
mnemonic = Opcode
mnemonic
  Opcode -> [Opcode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Opcode
ADD
         , Opcode
SUB
         , Opcode
NEG
         , Opcode
INC
         , Opcode
DEC
         , Opcode
ADC
         , Opcode
SBB
         , Opcode
ROL
         , Opcode
ROR
         , Opcode
SHL
         , Opcode
SHR
         , Opcode
SAL
         , Opcode
SAR
         , Opcode
SHLD
         , Opcode
SHRD
         , Opcode
XOR
         , Opcode
OR
         , Opcode
AND
         , Opcode
NOT
         , Opcode
BT
         , Opcode
BTC
         , Opcode
BTR
         , Opcode
BTS
         , Opcode
BSWAP
         , Opcode
XORPD
         , Opcode
XORPS
         , Opcode
SUBPS
         , Opcode
ANDPD
         , Opcode
ANDPS
         , Opcode
ANDNPS
         , Opcode
ORPS
         , Opcode
XORPS
         , Opcode
ANDNPD
         , Opcode
ORPD
         , Opcode
SUBPD
         , Opcode
ADDPD
         , Opcode
HADDPD
         , Opcode
MINSD
         , Opcode
MAXSD
         , Opcode
POR
         , Opcode
PAND
         , Opcode
PANDN
         , Opcode
PXOR
         , Opcode
VPOR
         , Opcode
VPAND
         , Opcode
VPANDN
         , Opcode
VPXOR
         , Opcode
PUNPCKLQDQ
         , Opcode
PUNPCKLBW
         , Opcode
PUNPCKLDQ
         , Opcode
PCMPGTD
         , Opcode
PCMPEQB
         , Opcode
PCMPEQD
         , Opcode
PCMPGTB
         , Opcode
PCMPGTD
         , Opcode
PADDD
         , Opcode
PADDB
         , Opcode
PADDQ
         , Opcode
PSUBD
         , Opcode
PSUBB
         , Opcode
PSUBQ
         , Opcode
PMULLD
         , Opcode
PMINSD
         , Opcode
PMAXSD
         , Opcode
PMINUD
         , Opcode
PMAXUD
         , Opcode
PMAXUQ
         , Opcode
PMAXUQ
         , Opcode
PMULUDQ
         , Opcode
PSRLD
         , Opcode
PSRLW
         , Opcode
PSRLDQ
         , Opcode
PSLLDQ
         , Opcode
PSLLD
         , Opcode
PSLLQ
         , Opcode
PSRLQ
         , Opcode
PSUBUSB
         , Opcode
PSUBUSW
         , Opcode
PINSRB
         , Opcode
PINSRQ
         , Opcode
PINSRD
         , Opcode
PEXTRB
         , Opcode
PEXTRD
         , Opcode
PEXTRQ
         , Opcode
PBLENDW
         , Opcode
PCLMULQDQ
         , Opcode
PACKSSDW
         , Opcode
PACKSSWB
         , Opcode
PHADDD 
         , Opcode
SUBSS
         , Opcode
ADDSS
         , Opcode
DIVSS
         , Opcode
MULSS
         , Opcode
ROUNDSS
         , Opcode
MAXSS
         , Opcode
MINSS
         , Opcode
SUBSD
         , Opcode
ADDSD
         , Opcode
DIVSD
         , Opcode
MULSD
         , Opcode
ROUNDSD
         , Opcode
UNPCKLPD
         , Opcode
CMOVO
         , Opcode
CMOVNO
         , Opcode
CMOVS
         , Opcode
CMOVNS
         , Opcode
CMOVE
         , Opcode
CMOVZ
         , Opcode
CMOVNE
         , Opcode
CMOVNZ
         , Opcode
CMOVB
         , Opcode
CMOVNAE
         , Opcode
CMOVC
         , Opcode
CMOVNB
         , Opcode
CMOVAE
         , Opcode
CMOVNC
         , Opcode
CMOVBE
         , Opcode
CMOVNA
         , Opcode
CMOVA
         , Opcode
CMOVNBE
         , Opcode
CMOVL
         , Opcode
CMOVNGE
         , Opcode
CMOVG
         , Opcode
CMOVGE
         , Opcode
CMOVNL
         , Opcode
CMOVLE
         , Opcode
CMOVNG
         , Opcode
CMOVNLE
         , Opcode
CMOVP
         , Opcode
CMOVPE
         , Opcode
CMOVNP
         , Opcode
CMOVPO

      ]

-- Does the instruction read from all operands, except for the first one?
mnemonic_reads_from_all_but_first_operands :: Opcode -> Bool
mnemonic_reads_from_all_but_first_operands Opcode
mnemonic = Opcode
mnemonic
  Opcode -> [Opcode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Opcode
LEA
         , Opcode
MOV
         , Opcode
MOVZX
         , Opcode
MOVSX
         , Opcode
MOVSXD
         , Opcode
MOVAPS
         , Opcode
MOVAPD
         , Opcode
MOVABS
         , Opcode
MOVUPD
         , Opcode
MOVUPS
         , Opcode
MOVDQU
         , Opcode
MOVDQA
         , Opcode
MOVD
         , Opcode
MOVQ
         , Opcode
MOVLPD
         , Opcode
MOVLPS
         , Opcode
MOVSD
         , Opcode
MOVSS
         , Opcode
MOVHPD
         , Opcode
MOVHPS
         , Opcode
VMOVD
         , Opcode
VMOVAPD
         , Opcode
VMOVAPS
         , Opcode
SETO
         , Opcode
SETNO
         , Opcode
SETS
         , Opcode
SETNS
         , Opcode
SETE
         , Opcode
SETZ
         , Opcode
SETNE
         , Opcode
SETNZ
         , Opcode
SETB
         , Opcode
SETNAE
         , Opcode
SETC
         , Opcode
SETNB
         , Opcode
SETAE
         , Opcode
SETNC
         , Opcode
SETBE
         , Opcode
SETNA
         , Opcode
SETA
         , Opcode
SETNBE
         , Opcode
SETL
         , Opcode
SETNGE
         , Opcode
SETGE
         , Opcode
SETNL
         , Opcode
SETLE
         , Opcode
SETNG
         , Opcode
SETG
         , Opcode
SETNLE
         , Opcode
SETP
         , Opcode
SETPE
         , Opcode
SETNP
         , Opcode
SETPO
         , Opcode
BSR
         , Opcode
BSF
         , Opcode
CVTSS2SD
         , Opcode
CVTSI2SS
         , Opcode
CVTSI2SD
         , Opcode
CVTSD2SS
         , Opcode
CVTTSS2SI
         , Opcode
CVTTSD2SI
         , Opcode
CVTTPD2DQ
         , Opcode
CVTDQ2PD
         , Opcode
MOVMSKPD
         , Opcode
MOVMSKPS
         , Opcode
PMOVSXDQ
         , Opcode
PMOVZXDQ
         , Opcode
PMOVSXBD
         , Opcode
PMOVZXBD
         , Opcode
UNPCKLPS
         , Opcode
BLENDVPD
         , Opcode
BLENDVPS
         , Opcode
EXTRACTPS
         , Opcode
VINSERTF128
         , Opcode
VEXTRACTI128
         , Opcode
VEXTRACTF128
         , Opcode
VPERM2F128
         , Opcode
VPERM2I128
         , Opcode
VPALIGNR
         , Opcode
PALIGNR
         , Opcode
SHUFPS
         , Opcode
PSHUFB
         , Opcode
PSHUFD
         , Opcode
VPSHUFB
         , Opcode
VPSHUFD
         , Opcode
PSHUFLW
         , Opcode
FST, Opcode
FSTP, Opcode
FIST, Opcode
FISTP, Opcode
FISTTP
         , Opcode
FSTCW, Opcode
FNSTCW
         , Opcode
SQRTSD
         , Opcode
SQRTSS
        ]

-- Does the instruction not make state change?
-- For example, NOP or ENDBR64
remove_destination :: Opcode -> Bool
remove_destination :: Opcode -> Bool
remove_destination Opcode
mnemonic =
  Opcode
mnemonic
  Opcode -> [Opcode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Opcode
NOP
         , Opcode
ENDBR64
         , Opcode
UD2
         , Opcode
WAIT
         , Opcode
MFENCE
         , Opcode
CLFLUSH
         , Opcode
COMISD, Opcode
UCOMISD
         -- ST registers are not considered state
         , Opcode
FILD, Opcode
FLD, Opcode
FXCH
         , Opcode
FADD, Opcode
FADDP, Opcode
FIADD
         , Opcode
FSUB, Opcode
FSUBP, Opcode
FISUB
         , Opcode
FSUBR, Opcode
FSUBRP, Opcode
FISUBR
         , Opcode
FMUL, Opcode
FMULP, Opcode
FIMUL
         , Opcode
FDIV, Opcode
FDIVP, Opcode
FIDIV
         , Opcode
FDIVR, Opcode
FDIVRP, Opcode
FIDIVR
         , Opcode
FCOMI, Opcode
FCOMIP, Opcode
FUCOMI, Opcode
FUCOMIP, Opcode
FCOMPI
         , Opcode
FLDCW, Opcode
FCHS, Opcode
FLDZ, Opcode
FLD1, Opcode
FLDPI
         , Opcode
FCMOVB, Opcode
FCMOVE, Opcode
FCMOVBE, Opcode
FCMOVU, Opcode
FCMOVNB, Opcode
FCMOVNE, Opcode
FCMOVNBE, Opcode
FCMOVNU
         , Opcode
SCAS, Opcode
SCASB, Opcode
SCASD
         , Opcode
EMMS
         , Opcode
CLD
     ]

-- Does the instruction need no modification?
-- For example, instructions without destination (CMP, TEST) or function calls and returns.
do_not_modify :: Opcode -> Bool
do_not_modify :: Opcode -> Bool
do_not_modify Opcode
mnemonic = Opcode -> Bool
isCall Opcode
mnemonic
  Bool -> Bool -> Bool
|| Opcode -> Bool
isJump Opcode
mnemonic
  Bool -> Bool -> Bool
|| Opcode -> Bool
isCondJump Opcode
mnemonic
  Bool -> Bool -> Bool
|| Opcode -> Bool
isRet Opcode
mnemonic
  Bool -> Bool -> Bool
|| Opcode -> Bool
isHalt Opcode
mnemonic
  Bool -> Bool -> Bool
|| Opcode
mnemonic
  Opcode -> [Opcode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Opcode
CMP
         , Opcode
TEST
         , Opcode
CMPS
         , Opcode
CMPSB
         , Opcode
CMPSW
         , Opcode
CMPSD
         , Opcode
PTEST
         , Opcode
UCOMISS
         , Opcode
COMISS
         , Opcode
UCOMISD
         , Opcode
CMPSS
         , Opcode
CMPLTSD
         , Opcode
CMPLTSS
         , Opcode
CMPEQSD
         , Opcode
CMPNEQSD
         , Opcode
CMPEQSD
         , Opcode
CMPLTSD
         , Opcode
CMPNLESD
         , Opcode
CMPNLESS
         , Opcode
CMPNEQSD
         , Opcode
CMPNLESD
         , Opcode
OUT
         ]
-- TODO:
-- BLENDVP, BLENDVPS read from XMM0 sometimes as well?
-- VANDPS: depends on number of operands (3 or 2)
-- SYSRET

lowpart :: Opcode -> Opcode
lowpart Opcode
IMUL = Opcode
IMUL_LO
lowpart Opcode
MUL  = Opcode
MUL_LO
lowpart Opcode
IDIV = Opcode
IDIV_LO
lowpart Opcode
DIV  = Opcode
DIV_LO
hipart :: Opcode -> Opcode
hipart Opcode
IMUL  = Opcode
IMUL_HI
hipart Opcode
MUL   = Opcode
MUL_HI
hipart Opcode
IDIV  = Opcode
IDIV_HI
hipart Opcode
DIV   = Opcode
DIV_HI





instance Cereal.Serialize Immediate
instance Cereal.Serialize Operand
instance Cereal.Serialize Prefix
instance Cereal.Serialize Instruction

instance NFData Immediate
instance NFData Prefix
instance NFData Operand
instance NFData Instruction