module Bindings.Bfd.Disasm.I386.Mnemonic where

import Bindings.Bfd.Disasm.I386.CondCode
import Bindings.Bfd.Disasm.I386.Order
import Bindings.Bfd.Disasm.I386.Precision
import Bindings.Bfd.Disasm.I386.XmmType


data Mnemonic = Add {
                     width1   :: Int
                }
              | AddCarry {
                     width1   :: Int
                }
              | AddScalar {
                     precision :: Precision
                }
              | BitwiseAnd {
                     width1   :: Int
                }
              | BitwiseExclOr  {
                     xmmType  :: XmmType
                }
              | BitwiseNot {
                     width1   :: Int
                }
              | BitwiseOr {
                     width1   :: Int
                }
              | Branch {
                     condCode :: CondCode
                }
              | Call {
                     width1   :: Int
                }
              | Compare {
                     width1   :: Int
                }
              | CompareExchange {
                     width1   :: Int
                }
              | CompareString {
                     width1   :: Int
                }
              | CompareUnordered {
                     precision :: Precision
                }
              | Convert {
                     width1   :: Int
                   , width2   :: Int
                   , isSplit  :: Bool
                }
              | ConvertXmm {
                     numElems       :: Int
                   , sourceXmmType  :: XmmType
                   , targetXmmType  :: XmmType
                   , isTruncate     :: Bool
                }
              | Cpuid
              | Decrement {
                     width1   :: Int
                }
              | Direction {
                     isSet :: Bool
                }
              | Divide {
                     width1   :: Int
                }
              | DivideInt {
                     width1   :: Int
                }
              | DivideScalar {
                     precision   :: Precision
                }
              | Exchange {
                     width1   :: Int
                }
              | ExchangeAdd {
                     width1   :: Int
                }
              | Increment {
                     width1   :: Int
                }
              | Jump {
                     mbWidth :: Maybe Int
                }
              | Leave {
                     width1   :: Int
                }
              | LoadEffAddr {
                     width1   :: Int
                }
              | Loop
              | Move {
                     width1            :: Int
                   , mbWidthSignExtend :: Maybe (Int, Bool)
                }
              | MoveAligned {
                     precision   :: Precision
                }
              | MoveCond {
                     width1   :: Int
                   , condCode :: CondCode
                }
              | MoveNonTemp {
                     xmmType2 :: Either Int XmmType
                }
              | MovePacked {
                     precision   :: Precision
                   , isHigh1     :: Bool
                   , isHigh2     :: Bool
                }
              | MoveScalar {
                     precision   :: Precision
                }
              | MoveString {
                     width1   :: Int
                }
              | MoveUnaligned {
                     precision   :: Precision
                }
              | Multiply {
                     width1   :: Int
                }
              | MultiplyInt {
                     width1   :: Int
                }
              | MultiplyScalar {
                     xmmType  :: XmmType
                }
              | Negate {
                     width1   :: Int
                }
              | NoOp
              | Pop {
                     width1   :: Int
                }
              | Push {
                     width1   :: Int
                }
              | Return {
                     width1   :: Int
                }
              | Rotate {
                     width1   :: Int
                   , isRight  :: Bool
                }
              | Set {
                     condCode :: CondCode
                }
              | Shift {
                     width1   :: Int
                   , isRight  :: Bool
                   , isArith  :: Bool
                }
              | StoreString {
                     width1   :: Int
                }
              | Subtract {
                     width1   :: Int
                }
              | SubtractBorrow {
                     width1   :: Int
                }
              | SubtractScalar {
                     precision   :: Precision
                }
              | Test {
                     width1   :: Int
                }
              | Unpack {
                     order       :: Order
                   , precision   :: Precision
                }
     deriving (Show)


toMnemonic
   :: String
   -> Mnemonic
toMnemonic s
   | s == "adcl" = AddCarry 4
   | s == "addb" = Add 1
   | s == "addl" = Add 4
   | s == "addq" = Add 8
   | s == "addsd" = AddScalar Double
   | s == "addss" = AddScalar Single
   | s == "addw" = Add 2
   | s == "andb" = BitwiseAnd 1
   | s == "andl" = BitwiseAnd 4
   | s == "andq" = BitwiseAnd 8
   | s == "andw" = BitwiseAnd 2
   | s == "callq" = Call 8
   | s == "cld" = Direction False
   | s == "cltd" = Convert 4 8 True
   | s == "cltq" = Convert 4 8 False
   | s == "cmovael" = MoveCond 4 AboveOrEqual
   | s == "cmovaeq" = MoveCond 8 AboveOrEqual
   | s == "cmoval" = MoveCond 4 Above
   | s == "cmovaq" = MoveCond 8 Above
   | s == "cmovbel" = MoveCond 4 BelowOrEqual
   | s == "cmovbeq" = MoveCond 8 BelowOrEqual
   | s == "cmovbl" = MoveCond 4 Below
   | s == "cmovbq" = MoveCond 8 Below
   | s == "cmovel" = MoveCond 4 Equal
   | s == "cmoveq" = MoveCond 8 Equal
   | s == "cmovgel" = MoveCond 4 GreaterOrEqual
   | s == "cmovgl" = MoveCond 4 Greater
   | s == "cmovlel" = MoveCond 4 LessOrEqual
   | s == "cmovll" = MoveCond 4 Less
   | s == "cmovnel" = MoveCond 4 NotEqual
   | s == "cmovneq" = MoveCond 8 NotEqual
   | s == "cmpb" = Compare 1
   | s == "cmpl" = Compare 4
   | s == "cmpsb" = CompareString 1
   | s == "cmpq" = Compare 8
   | s == "cmpw" = Compare 2
   | s == "cmpxchgl" = CompareExchange 4
   | s == "cmpxchgq" = CompareExchange 8
   | s == "cpuid" = Cpuid
   | s == "cvtpd2ps" = ConvertXmm 2 (FloatingPt Double) (FloatingPt Single) False
   | s == "cvtps2pd" = ConvertXmm 2 (FloatingPt Single) (FloatingPt Double) False
   | s == "cvtsd2ss" = ConvertXmm 1 (FloatingPt Double) (Int 0) False -- shouldn't this have a size postfix?  it doesn't...
   | s == "cvtsi2sdl" = ConvertXmm 1 (Int 4) (FloatingPt Double) False
   | s == "cvtsi2sdq" = ConvertXmm 1 (Int 8) (FloatingPt Double) False
   | s == "cvtsi2ssl" = ConvertXmm 1 (Int 4) (FloatingPt Single) False
   | s == "cvtsi2ssq" = ConvertXmm 1 (Int 8) (FloatingPt Single) False
   | s == "cvtss2sd" = ConvertXmm 1 (FloatingPt Single) (FloatingPt Double) False
   | s == "cvttsd2si" = ConvertXmm 1 (FloatingPt Double) (Int 0) True -- shouldn't this have a size postfix?  it doesn't...
   | s == "cvttss2siq" = ConvertXmm 1 (FloatingPt Single) (Int 8) True
   | s == "cwtl" = Convert 2 4 False
   | s == "decb" = Decrement 1
   | s == "decl" = Decrement 4
   | s == "decq" = Decrement 8
   | s == "divl" = Divide 4
   | s == "divq" = Divide 8
   | s == "divsd" = DivideScalar Double
   | s == "divss" = DivideScalar Single
   | s == "idivl" = DivideInt 4
   | s == "imull" = MultiplyInt 4
   | s == "imulq" = MultiplyInt 8
   | s == "incl" = Increment 4
   | s == "incq" = Increment 8
   | s == "ja" = Branch Above
   | s == "jae" = Branch AboveOrEqual
   | s == "jb" = Branch Below
   | s == "jbe" = Branch BelowOrEqual
   | s == "je" = Branch Equal
   | s == "jg" = Branch Greater
   | s == "jge" = Branch GreaterOrEqual
   | s == "jl" = Branch Less
   | s == "jle" = Branch LessOrEqual
   | s == "jne" = Branch NotEqual
   | s == "jns" = Branch NotSigned
   | s == "jmp" = Jump Nothing
   | s == "jmpq" = Jump $ Just 8
   | s == "jp" = Branch Parity
   | s == "js" = Branch Signed
   | s == "leal" = LoadEffAddr 4
   | s == "leaq" = LoadEffAddr 8
   | s == "leaveq" = Leave 8
   | s == "movabsq" = Move 8 Nothing
   | s == "movaps" = MoveAligned Single
   | s == "movb" = Move 1 Nothing
   | s == "movl" = Move 4 Nothing
   | s == "movlpd" = MovePacked Double False False
   | s == "movntps" = MoveNonTemp $ Right $ FloatingPt Single
   | s == "movq" = Move 8 Nothing
   | s == "movsbl" = Move 1 $ Just (4, True)
   | s == "movsbq" = Move 1 $ Just (8, True)
   | s == "movsd" = MoveString 4
   | s == "movslq" = Move 4 $ Just (8, True)
   | s == "movsq" = MoveString 8
   | s == "movss" = MoveScalar Single
   | s == "movswl" = Move 2 $ Just (4, True)
   | s == "movswq" = Move 2 $ Just (8, True)
   | s == "movups" = MoveUnaligned Single
   | s == "movw" = Move 2 Nothing
   | s == "movzbl" = Move 1 $ Just (4, False)
   | s == "movzwl" = Move 2 $ Just (4, False)
   | s == "mull" = Multiply 4
   | s == "mulq" = Multiply 8
   | s == "mulss" = MultiplyScalar $ FloatingPt Single
   | s == "negl" = Negate 4
   | s == "negq" = Negate 8
   | s == "nop" = NoOp
   | s == "nopl" = NoOp
   | s == "nopw" = NoOp
   | s == "notl" = BitwiseNot 4
   | s == "notq" = BitwiseNot 8
   | s == "orb" = BitwiseOr 1
   | s == "orl" = BitwiseOr 4
   | s == "orq" = BitwiseOr 8
   | s == "orw" = BitwiseOr 2
   | s == "popq" = Pop 8
   | s == "pushq" = Push 8
   | s == "roll" = Rotate 4 False
   | s == "retq" = Return 8
   | s == "sarl" = Shift 4 True True
   | s == "sarq" = Shift 8 True True
   | s == "sbbl" = SubtractBorrow 4
   | s == "sbbq" = SubtractBorrow 8
   | s == "seta" = Set Above
   | s == "setb" = Set Below
   | s == "setbe" = Set BelowOrEqual
   | s == "sete" = Set Equal
   | s == "setg" = Set Greater
   | s == "setl" = Set Less
   | s == "setle" = Set LessOrEqual
   | s == "setne" = Set NotEqual
   | s == "shll" = Shift 4 False False
   | s == "shlq" = Shift 8 False False
   | s == "shrb" = Shift 1 True False
   | s == "shrl" = Shift 4 True False
   | s == "shrq" = Shift 8 True False
   | s == "shrw" = Shift 2 True False
   | s == "stosq" = StoreString 8
   | s == "subb" = Subtract 1
   | s == "subl" = Subtract 4
   | s == "subq" = Subtract 8
   | s == "subss" = SubtractScalar Single
   | s == "testb" = Test 1
   | s == "testl" = Test 4
   | s == "testq" = Test 8
   | s == "testw" = Test 2
   | s == "ucomiss" = CompareUnordered Single
   | s == "unpcklpd" = Unpack Low Double
   | s == "unpcklps" = Unpack Low Single
   | s == "xaddl" = ExchangeAdd 4
   | s == "xchgl" = Exchange 4
   | s == "xchgq" = Exchange 8
   | s == "xchgw" = Exchange 2
   | s == "xorb" = BitwiseExclOr $ Int 1
   | s == "xorl" = BitwiseExclOr $ Int 4
   | s == "xorpd" = BitwiseExclOr $ FloatingPt Double
   | s == "xorps" = BitwiseExclOr $ FloatingPt Single
   | s == "xorq" = BitwiseExclOr $ Int 8
   | s == "xorw" = BitwiseExclOr $ Int 2
   | otherwise = error $ "toMnemonic: " ++ show s


isCall
   :: Mnemonic
   -> Bool
isCall (Call _) = True
isCall _        = False

isJump
   :: Mnemonic
   -> Bool
isJump (Jump _) = True
isJump _        = False

isBranch
   :: Mnemonic
   -> Bool
isBranch (Branch _) = True
isBranch (Loop    ) = True
isBranch _          = False

isReturn
   :: Mnemonic
   -> Bool
isReturn (Return _) = True
isReturn _          = False