{-# OPTIONS_HADDOCK hide #-}

-- Parser that can be used to read the output of objdump applied to X86 binaries
--
-- UBUNTU:
--    objdump -M intel -M hex --no-show-raw-insn -d #DIR#/#BINARY#
-- Tested with GNU objdump (GNU Binutils for Ubuntu) 2.26.1
--
-- MACOS:
--    objdump -no-show-raw-insn -disassemble -x86-asm-syntax=intel -print-imm-hex #DIR#/#BINARY#
--  Tested with Apple LLVM version 11.0.3 (clang-1103.0.32.59)
--
-- Example input:
--
-- 100002f85:	mov	rax, qword ptr [rip + 0x1a5084] ## literal pool symbol address: ___stack_chk_guard
-- 100002f9a:	jne	0x100003001
-- 100002fb1:	call	0x1001455d8

module Parser.ParserX86Instruction where

import Text.Parsec.Token
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Number
import Text.Parsec.Expr
import Data.Char
import Debug.Trace
import Data.Maybe
import Data.List
import Data.Word (Word64)
import Data.Bits (shiftL)
import qualified Data.IntMap as IM
import Debug.Trace
import Data.Functor ((<&>))
import System.Directory (doesFileExist)
import X86.Register (Register(..))
import X86.Opcode (Opcode(..))
import X86.Prefix (Prefix(..))
import Generic.Operand (GenericOperand(..))
import Generic.Address (GenericAddress(..),AddressWord64(..))
import Generic.Instruction ( GenericInstruction(Instruction) ) 

isWhiteSpace :: Char -> Bool
isWhiteSpace :: Char -> Bool
isWhiteSpace Char
c
  | Word
uc Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0x377 = Word
uc Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
32 Bool -> Bool -> Bool
|| Word
uc Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
9
  | Bool
otherwise = Char -> Bool
isSpace Char
c
  where
    uc :: Word
uc = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c) :: Word



whitespace :: ParsecT [Char] u Identity Char
whitespace  = (Char -> Bool) -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isWhiteSpace ParsecT [Char] u Identity Char
-> [Char] -> ParsecT [Char] u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"space"
whitespaces :: ParsecT [Char] u Identity ()
whitespaces = ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Char] u Identity Char
forall u. ParsecT [Char] u Identity Char
whitespace  ParsecT [Char] u Identity ()
-> [Char] -> ParsecT [Char] u Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"white space"





jumps_and_calls_are_relative :: Bool
jumps_and_calls_are_relative = Bool
False -- TODO make configurable



hexToWord64 :: [Char] -> Word64
hexToWord64 :: [Char] -> Word64
hexToWord64 = Int -> [Char] -> Word64
forall p. (Num p, Bits p) => Int -> [Char] -> p
hexToWord64' Int
0 ([Char] -> Word64) -> ([Char] -> [Char]) -> [Char] -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse
 where
  hexToWord64' :: Int -> [Char] -> p
hexToWord64' Int
_ [] = p
0
  hexToWord64' Int
n (Char
c:[Char]
cs) = p -> Int -> p
forall a. Bits a => a -> Int -> a
shiftL (Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
c)) Int
n p -> p -> p
forall a. Num a => a -> a -> a
+ Int -> [Char] -> p
hexToWord64' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) [Char]
cs

{--
-- Opcodes / mnemonics
parseMnemonic :: [Char] -> Opcode
parseMnemonic s = 
  case readsPrec 5 $ map toUpper s of
    [(m,s')] -> m
    _ -> InvalidOpcode
--}
mnemonic :: GenParser Char st Opcode
mnemonic = GenParser Char st Opcode -> GenParser Char st Opcode
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
  [Char]
m <- ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum
  let m' :: Opcode
m' = [Char] -> Opcode
read_opcode ([Char] -> Opcode) -> [Char] -> Opcode
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
m
  case Opcode
m' of
    Opcode
InvalidOpcode -> [Char] -> GenParser Char st Opcode
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Invalid mnemonic: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
m)
    Opcode
_ -> Opcode -> GenParser Char st Opcode
forall (m :: * -> *) a. Monad m => a -> m a
return (Opcode -> GenParser Char st Opcode)
-> Opcode -> GenParser Char st Opcode
forall a b. (a -> b) -> a -> b
$ Opcode
m'
  )

-- Registers
{--
parseRegister :: [Char] -> Register
parseRegister s = 
  if take 3 s `elem` ["ST(", "st("] then
    case readsPrec 5 $ map toUpper $ [ c | c <- s, c `notElem` ['(',')']] of
      [(m,s')] -> m
      _ -> InvalidRegister
  else if map toUpper s == "ST" then
    ST0
  else
    case readsPrec 5 $ map toUpper s of
      [(m,s')] -> m
      _ -> InvalidRegister
--}
isRegisterChar :: Char -> Bool
isRegisterChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"_lh()"

register :: GenParser Char st Register
register =
  GenParser Char st Register -> GenParser Char st Register
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
    [Char]
m <- ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isRegisterChar)
    let m' :: Register
m' = [Char] -> Register
read_regname ([Char] -> Register) -> [Char] -> Register
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
m
    case Register
m' of
      Register
InvalidRegister -> [Char] -> GenParser Char st Register
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Invalid register: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
m)
      Register
_ -> Register -> GenParser Char st Register
forall (m :: * -> *) a. Monad m => a -> m a
return (Register -> GenParser Char st Register)
-> Register -> GenParser Char st Register
forall a b. (a -> b) -> a -> b
$ Register
m'
  )


--Prefixes
parsePrefix :: [Char] -> Prefix
parsePrefix :: [Char] -> Prefix
parsePrefix [Char]
"REPE" = Prefix
REPZ
parsePrefix [Char]
"repe" = Prefix
REPZ
parsePrefix [Char]
s =
  case Int -> ReadS Prefix
forall a. Read a => Int -> ReadS a
readsPrec Int
5 ReadS Prefix -> ReadS Prefix
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
s of
    [(Prefix
m,[Char]
s')] -> Prefix
m
    [(Prefix, [Char])]
_ -> Prefix
InvalidPrefix

prefix :: GenParser Char st Prefix
prefix =
  GenParser Char st Prefix -> GenParser Char st Prefix
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
    [Char]
m <- ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum
    let m' :: Prefix
m' = [Char] -> Prefix
parsePrefix [Char]
m
    case Prefix
m' of
      Prefix
InvalidPrefix -> [Char] -> GenParser Char st Prefix
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Invalid prefix: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
m)
      Prefix
_ -> Prefix -> GenParser Char st Prefix
forall (m :: * -> *) a. Monad m => a -> m a
return (Prefix -> GenParser Char st Prefix)
-> Prefix -> GenParser Char st Prefix
forall a b. (a -> b) -> a -> b
$ Prefix
m'
  )


-- Addresses
-- An unresolved address is parsed by op_address.
-- It first must be either a size directive ("qword ptr ..."), dereference ("[...]"), or a register offset "cs:[...]"
-- Then, it can be an expression with address_term as terms at the leaves.
-- Address terms are immediates or registers. Address operands are '+', '-' or '*'.
address_term :: ParsecT [Char] u Identity (GenericAddress Register)
address_term =
 (GenParser Char u Register
forall st. GenParser Char st Register
register GenParser Char u Register
-> (Register -> GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Register -> GenericAddress Register
forall storage. storage -> GenericAddress storage
AddressStorage)
 ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
 (CharParser u Word64
forall i st. Integral i => CharParser st i
int CharParser u Word64
-> (Word64 -> GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>  Word64 -> GenericAddress Register
forall storage. Word64 -> GenericAddress storage
AddressImm)

size_directive :: ParsecT [Char] u Identity Int
size_directive =
      (ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"ymmword ptr" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
32))
  ParsecT [Char] u Identity Int
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"xmmword ptr" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
16))
  ParsecT [Char] u Identity Int
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"tbyte ptr" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
10)
  ParsecT [Char] u Identity Int
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"xword ptr" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
10)
  ParsecT [Char] u Identity Int
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"qword ptr" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
8)
  ParsecT [Char] u Identity Int
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"dword ptr" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
4)
  ParsecT [Char] u Identity Int
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"word ptr" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2)
  ParsecT [Char] u Identity Int
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"byte ptr" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1)
  ParsecT [Char] u Identity Int
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"YMMWORD PTR" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
32))
  ParsecT [Char] u Identity Int
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"XMMWORD PTR" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
16))
  ParsecT [Char] u Identity Int
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"TBYTE PTR" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
10)
  ParsecT [Char] u Identity Int
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"XWORD PTR" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
10)
  ParsecT [Char] u Identity Int
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"QWORD PTR" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
8)
  ParsecT [Char] u Identity Int
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"DWORD PTR" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
4)
  ParsecT [Char] u Identity Int
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"WORD PTR" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2)
  ParsecT [Char] u Identity Int
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"BYTE PTR" ParsecT [Char] u Identity [Char]
-> ParsecT [Char] u Identity Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT [Char] u Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1)

addr_expr0 :: ParsecT [Char] u Identity (GenericAddress Register)
addr_expr0 =
  (ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
    Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    GenericAddress Register
a <- ParsecT [Char] u Identity (GenericAddress Register)
addr_expr0
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
    GenericAddress Register
-> ParsecT [Char] u Identity (GenericAddress Register)
forall (m :: * -> *) a. Monad m => a -> m a
return GenericAddress Register
a
  ))
  ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  (ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
    GenericAddress Register
a0 <- ParsecT [Char] u Identity (GenericAddress Register)
addr_expr1
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    Char
symbol <- Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'  ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    GenericAddress Register
a1 <- ParsecT [Char] u Identity (GenericAddress Register)
addr_expr0
    case Char
symbol of
      Char
'+' -> GenericAddress Register
-> ParsecT [Char] u Identity (GenericAddress Register)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericAddress Register
 -> ParsecT [Char] u Identity (GenericAddress Register))
-> GenericAddress Register
-> ParsecT [Char] u Identity (GenericAddress Register)
forall a b. (a -> b) -> a -> b
$ GenericAddress Register
-> GenericAddress Register -> GenericAddress Register
forall storage.
GenericAddress storage
-> GenericAddress storage -> GenericAddress storage
AddressPlus GenericAddress Register
a0 GenericAddress Register
a1
      Char
':' -> GenericAddress Register
-> ParsecT [Char] u Identity (GenericAddress Register)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericAddress Register
 -> ParsecT [Char] u Identity (GenericAddress Register))
-> GenericAddress Register
-> ParsecT [Char] u Identity (GenericAddress Register)
forall a b. (a -> b) -> a -> b
$ GenericAddress Register
-> GenericAddress Register -> GenericAddress Register
forall storage.
GenericAddress storage
-> GenericAddress storage -> GenericAddress storage
AddressPlus GenericAddress Register
a0 GenericAddress Register
a1
      Char
'-' -> GenericAddress Register
-> ParsecT [Char] u Identity (GenericAddress Register)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericAddress Register
 -> ParsecT [Char] u Identity (GenericAddress Register))
-> GenericAddress Register
-> ParsecT [Char] u Identity (GenericAddress Register)
forall a b. (a -> b) -> a -> b
$ GenericAddress Register
-> GenericAddress Register -> GenericAddress Register
forall storage.
GenericAddress storage
-> GenericAddress storage -> GenericAddress storage
AddressMinus GenericAddress Register
a0 GenericAddress Register
a1
  ))
  ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  ParsecT [Char] u Identity (GenericAddress Register)
addr_expr1
  ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  ParsecT [Char] u Identity (GenericAddress Register)
forall u. ParsecT [Char] u Identity (GenericAddress Register)
address_term

addr_expr1 :: ParsecT [Char] u Identity (GenericAddress Register)
addr_expr1 =
  (ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
    Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    GenericAddress Register
a <- ParsecT [Char] u Identity (GenericAddress Register)
addr_expr0
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
    GenericAddress Register
-> ParsecT [Char] u Identity (GenericAddress Register)
forall (m :: * -> *) a. Monad m => a -> m a
return GenericAddress Register
a
  ))
  ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  (ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
    GenericAddress Register
a0 <- ParsecT [Char] u Identity (GenericAddress Register)
forall u. ParsecT [Char] u Identity (GenericAddress Register)
address_term
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    Char
symbol <- Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*'
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    GenericAddress Register
a1 <- ParsecT [Char] u Identity (GenericAddress Register)
addr_expr1
    GenericAddress Register
-> ParsecT [Char] u Identity (GenericAddress Register)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericAddress Register
 -> ParsecT [Char] u Identity (GenericAddress Register))
-> GenericAddress Register
-> ParsecT [Char] u Identity (GenericAddress Register)
forall a b. (a -> b) -> a -> b
$ GenericAddress Register
-> GenericAddress Register -> GenericAddress Register
forall storage.
GenericAddress storage
-> GenericAddress storage -> GenericAddress storage
AddressTimes GenericAddress Register
a0 GenericAddress Register
a1
  ))
  ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  ParsecT [Char] u Identity (GenericAddress Register)
forall u. ParsecT [Char] u Identity (GenericAddress Register)
address_term

address_expr_inner :: ParsecT [Char] u Identity (GenericAddress Register)
address_expr_inner =
  {--(try (do
    s <- size_directive
    whitespaces
    a <- address_expr_inner
    return $ SizeDir s a
  ))
  <|> --}
  (ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
    Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    GenericAddress Register
a <- ParsecT [Char] u Identity (GenericAddress Register)
address_expr_inner
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
    GenericAddress Register
-> ParsecT [Char] u Identity (GenericAddress Register)
forall (m :: * -> *) a. Monad m => a -> m a
return GenericAddress Register
a
  ))
  ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
-> ParsecT [Char] u Identity (GenericAddress Register)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] u Identity (GenericAddress Register)
forall u. ParsecT [Char] u Identity (GenericAddress Register)
addr_expr0

op_address :: ParsecT [Char] u Identity (GenericOperand Register)
op_address =
  (ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (GenericOperand Register)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    Int
s <- ParsecT [Char] u Identity Int
forall u. ParsecT [Char] u Identity Int
size_directive
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    EffectiveAddress GenericAddress Register
a <- ParsecT [Char] u Identity (GenericOperand Register)
op_address
    GenericOperand Register
-> ParsecT [Char] u Identity (GenericOperand Register)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericOperand Register
 -> ParsecT [Char] u Identity (GenericOperand Register))
-> GenericOperand Register
-> ParsecT [Char] u Identity (GenericOperand Register)
forall a b. (a -> b) -> a -> b
$ GenericAddress Register -> Int -> GenericOperand Register
forall storage.
GenericAddress storage -> Int -> GenericOperand storage
Memory GenericAddress Register
a Int
s
  ))
  ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (GenericOperand Register)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (GenericOperand Register)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    GenericAddress Register
a <- ParsecT [Char] u Identity (GenericAddress Register)
forall u. ParsecT [Char] u Identity (GenericAddress Register)
address_expr_inner
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
    GenericOperand Register
-> ParsecT [Char] u Identity (GenericOperand Register)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericOperand Register
 -> ParsecT [Char] u Identity (GenericOperand Register))
-> GenericOperand Register
-> ParsecT [Char] u Identity (GenericOperand Register)
forall a b. (a -> b) -> a -> b
$ GenericAddress Register -> GenericOperand Register
forall storage. GenericAddress storage -> GenericOperand storage
EffectiveAddress GenericAddress Register
a
  ))
  ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (GenericOperand Register)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (GenericOperand Register)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    Register
r <- GenParser Char u Register
forall st. GenParser Char st Register
register
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    GenericAddress Register
a <- ParsecT [Char] u Identity (GenericAddress Register)
forall u. ParsecT [Char] u Identity (GenericAddress Register)
address_expr_inner
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    GenericOperand Register
-> ParsecT [Char] u Identity (GenericOperand Register)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericOperand Register
 -> ParsecT [Char] u Identity (GenericOperand Register))
-> GenericOperand Register
-> ParsecT [Char] u Identity (GenericOperand Register)
forall a b. (a -> b) -> a -> b
$ GenericAddress Register -> GenericOperand Register
forall storage. GenericAddress storage -> GenericOperand storage
EffectiveAddress (GenericAddress Register -> GenericOperand Register)
-> GenericAddress Register -> GenericOperand Register
forall a b. (a -> b) -> a -> b
$ GenericAddress Register
-> GenericAddress Register -> GenericAddress Register
forall storage.
GenericAddress storage
-> GenericAddress storage -> GenericAddress storage
AddressPlus (Register -> GenericAddress Register
forall storage. storage -> GenericAddress storage
AddressStorage Register
r) GenericAddress Register
a
  ))

-- Operands
op_reg :: ParsecT [Char] st Identity (GenericOperand Register)
op_reg = do
  GenParser Char st Register
forall st. GenParser Char st Register
register GenParser Char st Register
-> (Register -> GenericOperand Register)
-> ParsecT [Char] st Identity (GenericOperand Register)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Register -> GenericOperand Register
forall storage. storage -> GenericOperand storage
Storage

op_immediate :: GenParser Char st (GenericOperand storage)
op_immediate = GenParser Char st (GenericOperand storage)
-> GenParser Char st (GenericOperand storage)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
  [Char]
sign <- [Char]
-> ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"+" ([Char] -> ParsecT [Char] st Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"-")
  Word64
i <- CharParser st Word64
forall i st. Integral i => CharParser st i
hexnum
  GenericOperand storage
-> GenParser Char st (GenericOperand storage)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericOperand storage
 -> GenParser Char st (GenericOperand storage))
-> GenericOperand storage
-> GenParser Char st (GenericOperand storage)
forall a b. (a -> b) -> a -> b
$ Word64 -> GenericOperand storage
forall storage. Word64 -> GenericOperand storage
Immediate (if [Char]
sign [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"-" then Word64
0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
i else Word64
i)
 )

op_immediate_0x :: GenParser Char st (GenericOperand storage)
op_immediate_0x = GenParser Char st (GenericOperand storage)
-> GenParser Char st (GenericOperand storage)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
  [Char]
sign <- [Char]
-> ParsecT [Char] st Identity [Char]
-> ParsecT [Char] st Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"+" ([Char] -> ParsecT [Char] st Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"-")
  [Char] -> ParsecT [Char] st Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"0x"
  Word64
i <- CharParser st Word64
forall i st. Integral i => CharParser st i
hexnum
  GenericOperand storage
-> GenParser Char st (GenericOperand storage)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericOperand storage
 -> GenParser Char st (GenericOperand storage))
-> GenericOperand storage
-> GenParser Char st (GenericOperand storage)
forall a b. (a -> b) -> a -> b
$ Word64 -> GenericOperand storage
forall storage. Word64 -> GenericOperand storage
Immediate (if [Char]
sign [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"-" then Word64
0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
i else Word64
i)
 )

operand :: ParsecT [Char] u Identity (GenericOperand Register)
operand =
      ParsecT [Char] u Identity (GenericOperand Register)
forall st storage. GenParser Char st (GenericOperand storage)
op_immediate_0x
  ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (GenericOperand Register)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] u Identity (GenericOperand Register)
forall u. ParsecT [Char] u Identity (GenericOperand Register)
op_address
  ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (GenericOperand Register)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] u Identity (GenericOperand Register)
forall u. ParsecT [Char] u Identity (GenericOperand Register)
op_reg
  ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (GenericOperand Register)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] u Identity (GenericOperand Register)
forall st storage. GenParser Char st (GenericOperand storage)
op_immediate -- must be last to try

second_operand :: ParsecT [Char] u Identity (GenericOperand Register)
second_operand = do
  Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','
  ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
  GenericOperand Register
op2 <- ParsecT [Char] u Identity (GenericOperand Register)
forall u. ParsecT [Char] u Identity (GenericOperand Register)
operand
  GenericOperand Register
-> ParsecT [Char] u Identity (GenericOperand Register)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericOperand Register
 -> ParsecT [Char] u Identity (GenericOperand Register))
-> GenericOperand Register
-> ParsecT [Char] u Identity (GenericOperand Register)
forall a b. (a -> b) -> a -> b
$ GenericOperand Register
op2


-- Annotations, e.g., <malloc@plt + 10>
{--
annotation = do
  char '<'
  cs <- many (noneOf "@>\n+")
  many (noneOf ">\n")
  char '>'
  return cs

-- Comments
comment = do
  char '#'
  skipMany (noneOf "\n")
---}


hexnum_with_0x :: ParsecT [Char] u Identity Integer
hexnum_with_0x = do
  [Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"0x"
  ParsecT [Char] u Identity Integer
forall i st. Integral i => CharParser st i
hexnum

-- Instructions
instruction :: ParsecT
  [Char]
  u
  Identity
  (GenericInstruction
     AddressWord64 Register Prefix Opcode annotation)
instruction = do
  ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
  Word64
addr <- CharParser u Word64
forall i st. Integral i => CharParser st i
hexnum
  ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
  [Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
":"
  ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
  Maybe Prefix
p <- ParsecT [Char] u Identity Prefix
-> ParsecT [Char] u Identity (Maybe Prefix)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT [Char] u Identity Prefix
forall st. GenParser Char st Prefix
prefix
  ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
  Opcode
m <- GenParser Char u Opcode
forall st. GenParser Char st Opcode
mnemonic
  ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
  Maybe (GenericOperand Register)
op1 <- ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (Maybe (GenericOperand Register))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT [Char] u Identity (GenericOperand Register)
forall u. ParsecT [Char] u Identity (GenericOperand Register)
operand
  ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
  Maybe (GenericOperand Register)
op2 <- ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (Maybe (GenericOperand Register))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT [Char] u Identity (GenericOperand Register)
forall u. ParsecT [Char] u Identity (GenericOperand Register)
second_operand
  ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
  Maybe (GenericOperand Register)
op3 <- ParsecT [Char] u Identity (GenericOperand Register)
-> ParsecT [Char] u Identity (Maybe (GenericOperand Register))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT [Char] u Identity (GenericOperand Register)
forall u. ParsecT [Char] u Identity (GenericOperand Register)
second_operand
  ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ([Char] -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n")
  {--
  whitespaces
  annot <- optionMaybe annotation
  whitespaces
  skipMany comment
  whitespaces--}
  ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Char] u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  GenericInstruction AddressWord64 Register Prefix Opcode annotation
-> ParsecT
     [Char]
     u
     Identity
     (GenericInstruction
        AddressWord64 Register Prefix Opcode annotation)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericInstruction AddressWord64 Register Prefix Opcode annotation
 -> ParsecT
      [Char]
      u
      Identity
      (GenericInstruction
         AddressWord64 Register Prefix Opcode annotation))
-> GenericInstruction
     AddressWord64 Register Prefix Opcode annotation
-> ParsecT
     [Char]
     u
     Identity
     (GenericInstruction
        AddressWord64 Register Prefix Opcode annotation)
forall a b. (a -> b) -> a -> b
$ AddressWord64
-> Maybe Prefix
-> Opcode
-> Maybe (GenericOperand Register)
-> [GenericOperand Register]
-> Maybe annotation
-> GenericInstruction
     AddressWord64 Register Prefix Opcode annotation
forall label storage prefix opcode annotation.
label
-> Maybe prefix
-> opcode
-> Maybe (GenericOperand storage)
-> [GenericOperand storage]
-> Maybe annotation
-> GenericInstruction label storage prefix opcode annotation
Instruction (Word64 -> AddressWord64
AddressWord64 Word64
addr) Maybe Prefix
p Opcode
m Maybe (GenericOperand Register)
forall a. Maybe a
Nothing ([Maybe (GenericOperand Register)] -> [GenericOperand Register]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (GenericOperand Register)
op1,Maybe (GenericOperand Register)
op2,Maybe (GenericOperand Register)
op3]) Maybe annotation
forall a. Maybe a
Nothing





read_opcode :: [Char] -> Opcode
read_opcode [Char]
"AAA" = Opcode
AAA
read_opcode [Char]
"AAD" = Opcode
AAD
read_opcode [Char]
"AAM" = Opcode
AAM
read_opcode [Char]
"AAS" = Opcode
AAS
read_opcode [Char]
"ADC" = Opcode
ADC
read_opcode [Char]
"ADD" = Opcode
ADD
read_opcode [Char]
"ADDPD" = Opcode
ADDPD
read_opcode [Char]
"ADDPS" = Opcode
ADDPS
read_opcode [Char]
"ADDSD" = Opcode
ADDSD
read_opcode [Char]
"ADDSS" = Opcode
ADDSS
read_opcode [Char]
"ADDSUBPD" = Opcode
ADDSUBPD
read_opcode [Char]
"ADDUBPS" = Opcode
ADDUBPS
read_opcode [Char]
"AND" = Opcode
AND
read_opcode [Char]
"ANDNPD" = Opcode
ANDNPD
read_opcode [Char]
"ANDNPS" = Opcode
ANDNPS
read_opcode [Char]
"ANDPD" = Opcode
ANDPD
read_opcode [Char]
"ANDPS" = Opcode
ANDPS
read_opcode [Char]
"ARPL" = Opcode
ARPL
read_opcode [Char]
"BLENDVPD" = Opcode
BLENDVPD
read_opcode [Char]
"BLENDVPS" = Opcode
BLENDVPS
read_opcode [Char]
"BOUND" = Opcode
BOUND
read_opcode [Char]
"BSF" = Opcode
BSF
read_opcode [Char]
"BSR" = Opcode
BSR
read_opcode [Char]
"BT" = Opcode
BT
read_opcode [Char]
"BTC" = Opcode
BTC
read_opcode [Char]
"BTR" = Opcode
BTR
read_opcode [Char]
"BTS" = Opcode
BTS
read_opcode [Char]
"CALL" = Opcode
CALL
read_opcode [Char]
"CALLF" = Opcode
CALLF
read_opcode [Char]
"CBW" = Opcode
CBW
read_opcode [Char]
"CDQ" = Opcode
CDQ
read_opcode [Char]
"CDQE" = Opcode
CDQE
read_opcode [Char]
"CLC" = Opcode
CLC
read_opcode [Char]
"CLD" = Opcode
CLD
read_opcode [Char]
"CLFLUSH" = Opcode
CLFLUSH
read_opcode [Char]
"CLI" = Opcode
CLI
read_opcode [Char]
"CLTS" = Opcode
CLTS
read_opcode [Char]
"CMC" = Opcode
CMC
read_opcode [Char]
"CMOVA" = Opcode
CMOVA
read_opcode [Char]
"CMOVAE" = Opcode
CMOVAE
read_opcode [Char]
"CMOVB" = Opcode
CMOVB
read_opcode [Char]
"CMOVBE" = Opcode
CMOVBE
read_opcode [Char]
"CMOVC" = Opcode
CMOVC
read_opcode [Char]
"CMOVE" = Opcode
CMOVE
read_opcode [Char]
"CMOVG" = Opcode
CMOVG
read_opcode [Char]
"CMOVGE" = Opcode
CMOVGE
read_opcode [Char]
"CMOVL" = Opcode
CMOVL
read_opcode [Char]
"CMOVLE" = Opcode
CMOVLE
read_opcode [Char]
"CMOVNA" = Opcode
CMOVNA
read_opcode [Char]
"CMOVNAE" = Opcode
CMOVNAE
read_opcode [Char]
"CMOVNB" = Opcode
CMOVNB
read_opcode [Char]
"CMOVNBE" = Opcode
CMOVNBE
read_opcode [Char]
"CMOVNC" = Opcode
CMOVNC
read_opcode [Char]
"CMOVNE" = Opcode
CMOVNE
read_opcode [Char]
"CMOVNG" = Opcode
CMOVNG
read_opcode [Char]
"CMOVNGE" = Opcode
CMOVNGE
read_opcode [Char]
"CMOVNL" = Opcode
CMOVNL
read_opcode [Char]
"CMOVNLE" = Opcode
CMOVNLE
read_opcode [Char]
"CMOVNO" = Opcode
CMOVNO
read_opcode [Char]
"CMOVNP" = Opcode
CMOVNP
read_opcode [Char]
"CMOVNS" = Opcode
CMOVNS
read_opcode [Char]
"CMOVNZ" = Opcode
CMOVNZ
read_opcode [Char]
"CMOVO" = Opcode
CMOVO
read_opcode [Char]
"CMOVP" = Opcode
CMOVP
read_opcode [Char]
"CMOVPE" = Opcode
CMOVPE
read_opcode [Char]
"CMOVPO" = Opcode
CMOVPO
read_opcode [Char]
"CMOVS" = Opcode
CMOVS
read_opcode [Char]
"CMOVZ" = Opcode
CMOVZ
read_opcode [Char]
"CMP" = Opcode
CMP
read_opcode [Char]
"CMPEQSD" = Opcode
CMPEQSD
read_opcode [Char]
"CMPNEQSD" = Opcode
CMPNEQSD
read_opcode [Char]
"CMPNLESD" = Opcode
CMPNLESD
read_opcode [Char]
"CMPLTSD" = Opcode
CMPLTSD
read_opcode [Char]
"CMPS" = Opcode
CMPS
read_opcode [Char]
"CMPSB" = Opcode
CMPSB
read_opcode [Char]
"CMPSD" = Opcode
CMPSD
read_opcode [Char]
"CMPSW" = Opcode
CMPSW
read_opcode [Char]
"CMPXCHG" = Opcode
CMPXCHG
read_opcode [Char]
"CMPXCHG16B" = Opcode
CMPXCHG16B
read_opcode [Char]
"CMPXCHG8B" = Opcode
CMPXCHG8B
read_opcode [Char]
"COMISD" = Opcode
COMISD
read_opcode [Char]
"COMISS" = Opcode
COMISS
read_opcode [Char]
"CPUID" = Opcode
CPUID
read_opcode [Char]
"CQO" = Opcode
CQO
read_opcode [Char]
"CVTDQ2PD" = Opcode
CVTDQ2PD
read_opcode [Char]
"CVTSD2SS" = Opcode
CVTSD2SS
read_opcode [Char]
"CVTSI2SD" = Opcode
CVTSI2SD
read_opcode [Char]
"CVTSI2SS" = Opcode
CVTSI2SS
read_opcode [Char]
"CVTSS2SD" = Opcode
CVTSS2SD
read_opcode [Char]
"CVTTSD2SI" = Opcode
CVTTSD2SI
read_opcode [Char]
"CVTTSS2SI" = Opcode
CVTTSS2SI
read_opcode [Char]
"CVTTPD2DQ" = Opcode
CVTTPD2DQ
read_opcode [Char]
"CWD" = Opcode
CWD
read_opcode [Char]
"CWDE" = Opcode
CWDE
read_opcode [Char]
"DAA" = Opcode
DAA
read_opcode [Char]
"DAS" = Opcode
DAS
read_opcode [Char]
"DEC" = Opcode
DEC
read_opcode [Char]
"DIV" = Opcode
DIV
read_opcode [Char]
"DIVPD" = Opcode
DIVPD
read_opcode [Char]
"DIVPS" = Opcode
DIVPS
read_opcode [Char]
"DIVSD" = Opcode
DIVSD
read_opcode [Char]
"DIVSS" = Opcode
DIVSS
read_opcode [Char]
"EMMS" = Opcode
EMMS
read_opcode [Char]
"ENDBR64" = Opcode
ENDBR64
read_opcode [Char]
"ENTER" = Opcode
ENTER
read_opcode [Char]
"EXTRACTPS" = Opcode
EXTRACTPS
read_opcode [Char]
"FABS" = Opcode
FABS
read_opcode [Char]
"FADD" = Opcode
FADD
read_opcode [Char]
"FADDP" = Opcode
FADDP
read_opcode [Char]
"FBLD" = Opcode
FBLD
read_opcode [Char]
"FBSTP" = Opcode
FBSTP
read_opcode [Char]
"FCHS" = Opcode
FCHS
read_opcode [Char]
"FCLEX" = Opcode
FCLEX
read_opcode [Char]
"FCMOVB" = Opcode
FCMOVB
read_opcode [Char]
"FCMOVBE" = Opcode
FCMOVBE
read_opcode [Char]
"FCMOVE" = Opcode
FCMOVE
read_opcode [Char]
"FCMOVNB" = Opcode
FCMOVNB
read_opcode [Char]
"FCMOVNBE" = Opcode
FCMOVNBE
read_opcode [Char]
"FCMOVNE" = Opcode
FCMOVNE
read_opcode [Char]
"FCMOVNU" = Opcode
FCMOVNU
read_opcode [Char]
"FCMOVU" = Opcode
FCMOVU
read_opcode [Char]
"FCOM" = Opcode
FCOM
read_opcode [Char]
"FCOMI" = Opcode
FCOMI
read_opcode [Char]
"FCOMIP" = Opcode
FCOMIP
read_opcode [Char]
"FCOMP" = Opcode
FCOMP
read_opcode [Char]
"FCOMPI" = Opcode
FCOMPI
read_opcode [Char]
"FCOMPP" = Opcode
FCOMPP
read_opcode [Char]
"FCOS" = Opcode
FCOS
read_opcode [Char]
"FDIV" = Opcode
FDIV
read_opcode [Char]
"FDIVP" = Opcode
FDIVP
read_opcode [Char]
"FDIVR" = Opcode
FDIVR
read_opcode [Char]
"FDIVRP" = Opcode
FDIVRP
read_opcode [Char]
"FFREE" = Opcode
FFREE
read_opcode [Char]
"FRNDINT" = Opcode
FRNDINT
read_opcode [Char]
"FIADD" = Opcode
FIADD
read_opcode [Char]
"FICOM" = Opcode
FICOM
read_opcode [Char]
"FICOMP" = Opcode
FICOMP
read_opcode [Char]
"FIDIV" = Opcode
FIDIV
read_opcode [Char]
"FIDIVR" = Opcode
FIDIVR
read_opcode [Char]
"FILD" = Opcode
FILD
read_opcode [Char]
"FIMUL" = Opcode
FIMUL
read_opcode [Char]
"FINIT" = Opcode
FINIT
read_opcode [Char]
"FIST" = Opcode
FIST
read_opcode [Char]
"FISTP" = Opcode
FISTP
read_opcode [Char]
"FISTPP" = Opcode
FISTPP
read_opcode [Char]
"FISTTP" = Opcode
FISTTP
read_opcode [Char]
"FISUB" = Opcode
FISUB
read_opcode [Char]
"FISUBR" = Opcode
FISUBR
read_opcode [Char]
"FLD" = Opcode
FLD
read_opcode [Char]
"FLD1" = Opcode
FLD1
read_opcode [Char]
"FLDCW" = Opcode
FLDCW
read_opcode [Char]
"FLDENV" = Opcode
FLDENV
read_opcode [Char]
"FLDL2E" = Opcode
FLDL2E
read_opcode [Char]
"FLDL2T" = Opcode
FLDL2T
read_opcode [Char]
"FLDLG2" = Opcode
FLDLG2
read_opcode [Char]
"FLDLN2" = Opcode
FLDLN2
read_opcode [Char]
"FLDPI" = Opcode
FLDPI
read_opcode [Char]
"FLDZ" = Opcode
FLDZ
read_opcode [Char]
"FMUL" = Opcode
FMUL
read_opcode [Char]
"FMULP" = Opcode
FMULP
read_opcode [Char]
"FNOP" = Opcode
FNOP
read_opcode [Char]
"FNINIT" = Opcode
FNINIT
read_opcode [Char]
"FNSTCW" = Opcode
FNSTCW
read_opcode [Char]
"FPREM1" = Opcode
FPREM1
read_opcode [Char]
"FRSTOR" = Opcode
FRSTOR
read_opcode [Char]
"FSAVE" = Opcode
FSAVE
read_opcode [Char]
"FSIN" = Opcode
FSIN
read_opcode [Char]
"FSINCOS" = Opcode
FSINCOS
read_opcode [Char]
"FSCALE" = Opcode
FSCALE
read_opcode [Char]
"FSQRT" = Opcode
FSQRT
read_opcode [Char]
"FST" = Opcode
FST
read_opcode [Char]
"FSTCW" = Opcode
FSTCW
read_opcode [Char]
"FSTENV" = Opcode
FSTENV
read_opcode [Char]
"FSTP" = Opcode
FSTP
read_opcode [Char]
"FSTSW" = Opcode
FSTSW
read_opcode [Char]
"FSUB" = Opcode
FSUB
read_opcode [Char]
"FSUBP" = Opcode
FSUBP
read_opcode [Char]
"FSUBR" = Opcode
FSUBR
read_opcode [Char]
"FSUBRP" = Opcode
FSUBRP
read_opcode [Char]
"FTST" = Opcode
FTST
read_opcode [Char]
"FUCOM" = Opcode
FUCOM
read_opcode [Char]
"FUCOMI" = Opcode
FUCOMI
read_opcode [Char]
"FUCOMIP" = Opcode
FUCOMIP
read_opcode [Char]
"FUCOMP" = Opcode
FUCOMP
read_opcode [Char]
"FUCOMPI" = Opcode
FUCOMPI
read_opcode [Char]
"FUCOMPP" = Opcode
FUCOMPP
read_opcode [Char]
"FXAM" = Opcode
FXAM
read_opcode [Char]
"FXCH" = Opcode
FXCH
read_opcode [Char]
"FXRSTOR" = Opcode
FXRSTOR
read_opcode [Char]
"FXSAVE" = Opcode
FXSAVE
read_opcode [Char]
"FXTRACT" = Opcode
FXTRACT
read_opcode [Char]
"HADDPD" = Opcode
HADDPD
read_opcode [Char]
"HADDPS" = Opcode
HADDPS
read_opcode [Char]
"HLT" = Opcode
HLT
read_opcode [Char]
"HSUBPD" = Opcode
HSUBPD
read_opcode [Char]
"HSUBPS" = Opcode
HSUBPS
read_opcode [Char]
"IDIV" = Opcode
IDIV
read_opcode [Char]
"IMUL" = Opcode
IMUL
read_opcode [Char]
"BSWAP" = Opcode
BSWAP
read_opcode [Char]
"IN" = Opcode
IN
read_opcode [Char]
"INC" = Opcode
INC
read_opcode [Char]
"INS" = Opcode
INS
read_opcode [Char]
"INSD" = Opcode
INSD
read_opcode [Char]
"INT" = Opcode
INT
read_opcode [Char]
"INT3" = Opcode
INT3
read_opcode [Char]
"INTO" = Opcode
INTO
read_opcode [Char]
"INVD" = Opcode
INVD
read_opcode [Char]
"INVLPG" = Opcode
INVLPG
read_opcode [Char]
"INVPCID" = Opcode
INVPCID
read_opcode [Char]
"IRET" = Opcode
IRET
read_opcode [Char]
"IRETD" = Opcode
IRETD
read_opcode [Char]
"IRETQ" = Opcode
IRETQ
read_opcode [Char]
"JA" = Opcode
JA
read_opcode [Char]
"JAE" = Opcode
JAE
read_opcode [Char]
"JB" = Opcode
JB
read_opcode [Char]
"JBE" = Opcode
JBE
read_opcode [Char]
"JC" = Opcode
JC
read_opcode [Char]
"JCXZ" = Opcode
JCXZ
read_opcode [Char]
"JE" = Opcode
JE
read_opcode [Char]
"JECXZ" = Opcode
JECXZ
read_opcode [Char]
"JG" = Opcode
JG
read_opcode [Char]
"JGE" = Opcode
JGE
read_opcode [Char]
"JL" = Opcode
JL
read_opcode [Char]
"JLE" = Opcode
JLE
read_opcode [Char]
"JMP" = Opcode
JMP
read_opcode [Char]
"JMPF" = Opcode
JMPF
read_opcode [Char]
"JMPN" = Opcode
JMPN
read_opcode [Char]
"JNAE" = Opcode
JNAE
read_opcode [Char]
"JNA" = Opcode
JNA
read_opcode [Char]
"JNB" = Opcode
JNB
read_opcode [Char]
"JNBE" = Opcode
JNBE
read_opcode [Char]
"JNC" = Opcode
JNC
read_opcode [Char]
"JNG" = Opcode
JNG
read_opcode [Char]
"JNE" = Opcode
JNE
read_opcode [Char]
"JNGE" = Opcode
JNGE
read_opcode [Char]
"JNLE" = Opcode
JNLE
read_opcode [Char]
"JNL" = Opcode
JNL
read_opcode [Char]
"JNO" = Opcode
JNO
read_opcode [Char]
"JNP" = Opcode
JNP
read_opcode [Char]
"JNS" = Opcode
JNS
read_opcode [Char]
"JNZ" = Opcode
JNZ
read_opcode [Char]
"JO" = Opcode
JO
read_opcode [Char]
"JP" = Opcode
JP
read_opcode [Char]
"JPE" = Opcode
JPE
read_opcode [Char]
"JPO" = Opcode
JPO
read_opcode [Char]
"JRCXZ" = Opcode
JRCXZ
read_opcode [Char]
"JS" = Opcode
JS
read_opcode [Char]
"JZ" = Opcode
JZ
read_opcode [Char]
"LAHF" = Opcode
LAHF
read_opcode [Char]
"LAR" = Opcode
LAR
read_opcode [Char]
"LDDQU" = Opcode
LDDQU
read_opcode [Char]
"LDMXCSR" = Opcode
LDMXCSR
read_opcode [Char]
"LDS" = Opcode
LDS
read_opcode [Char]
"LEA" = Opcode
LEA
read_opcode [Char]
"LEAVE" = Opcode
LEAVE
read_opcode [Char]
"LES" = Opcode
LES
read_opcode [Char]
"LFENCE" = Opcode
LFENCE
read_opcode [Char]
"LFS" = Opcode
LFS
read_opcode [Char]
"LGDT" = Opcode
LGDT
read_opcode [Char]
"LGS" = Opcode
LGS
read_opcode [Char]
"LIDT" = Opcode
LIDT
read_opcode [Char]
"LLDT" = Opcode
LLDT
read_opcode [Char]
"LMSW" = Opcode
LMSW
read_opcode [Char]
"LODS" = Opcode
LODS
read_opcode [Char]
"LODSB" = Opcode
LODSB
read_opcode [Char]
"LODSD" = Opcode
LODSD
read_opcode [Char]
"LODSW" = Opcode
LODSW
read_opcode [Char]
"LOOP" = Opcode
LOOP
read_opcode [Char]
"LOOPE" = Opcode
LOOPE
read_opcode [Char]
"LOOPNE" = Opcode
LOOPNE
read_opcode [Char]
"LSL" = Opcode
LSL
read_opcode [Char]
"LSS" = Opcode
LSS
read_opcode [Char]
"LTR" = Opcode
LTR
read_opcode [Char]
"MASKMOVQ" = Opcode
MASKMOVQ
read_opcode [Char]
"MAXPD" = Opcode
MAXPD
read_opcode [Char]
"MAXPS" = Opcode
MAXPS
read_opcode [Char]
"MAXSD" = Opcode
MAXSD
read_opcode [Char]
"MAXSS" = Opcode
MAXSS
read_opcode [Char]
"MFENCE" = Opcode
MFENCE
read_opcode [Char]
"MINPD" = Opcode
MINPD
read_opcode [Char]
"MINPS" = Opcode
MINPS
read_opcode [Char]
"MINSD" = Opcode
MINSD
read_opcode [Char]
"MINSS" = Opcode
MINSS
read_opcode [Char]
"MONITOR" = Opcode
MONITOR
read_opcode [Char]
"MOV" = Opcode
MOV
read_opcode [Char]
"MOVABS" = Opcode
MOVABS
read_opcode [Char]
"MOVAPD" = Opcode
MOVAPD
read_opcode [Char]
"MOVAPS" = Opcode
MOVAPS
read_opcode [Char]
"MOVD" = Opcode
MOVD
read_opcode [Char]
"MOVDDUP" = Opcode
MOVDDUP
read_opcode [Char]
"MOVDQA" = Opcode
MOVDQA
read_opcode [Char]
"MOVDQU" = Opcode
MOVDQU
read_opcode [Char]
"MOVHLPS" = Opcode
MOVHLPS
read_opcode [Char]
"MOVHPD" = Opcode
MOVHPD
read_opcode [Char]
"MOVHPS" = Opcode
MOVHPS
read_opcode [Char]
"MOVLHPS" = Opcode
MOVLHPS
read_opcode [Char]
"MOVLPD" = Opcode
MOVLPD
read_opcode [Char]
"MOVLPS" = Opcode
MOVLPS
read_opcode [Char]
"MOVLSDUP" = Opcode
MOVLSDUP
read_opcode [Char]
"MOVMSKPD" = Opcode
MOVMSKPD
read_opcode [Char]
"MOVMSKPS" = Opcode
MOVMSKPS
read_opcode [Char]
"MOVNTDQ" = Opcode
MOVNTDQ
read_opcode [Char]
"MOVNTPD" = Opcode
MOVNTPD
read_opcode [Char]
"MOVNTPS" = Opcode
MOVNTPS
read_opcode [Char]
"MOVNTQ" = Opcode
MOVNTQ
read_opcode [Char]
"MOVQ" = Opcode
MOVQ
read_opcode [Char]
"MOVS" = Opcode
MOVS
read_opcode [Char]
"MOVSB" = Opcode
MOVSB
read_opcode [Char]
"MOVSD" = Opcode
MOVSD
read_opcode [Char]
"MOVSLDUP" = Opcode
MOVSLDUP
read_opcode [Char]
"MOVSS" = Opcode
MOVSS
read_opcode [Char]
"MOVSQ" = Opcode
MOVSQ
read_opcode [Char]
"MOVSX" = Opcode
MOVSX
read_opcode [Char]
"MOVSXB" = Opcode
MOVSXB
read_opcode [Char]
"MOVSXD" = Opcode
MOVSXD
read_opcode [Char]
"MOVSXW" = Opcode
MOVSXW
read_opcode [Char]
"MOVUPD" = Opcode
MOVUPD
read_opcode [Char]
"MOVUPS" = Opcode
MOVUPS
read_opcode [Char]
"MOVZX" = Opcode
MOVZX
read_opcode [Char]
"MOVZXB" = Opcode
MOVZXB
read_opcode [Char]
"MOVZXW" = Opcode
MOVZXW
read_opcode [Char]
"MUL" = Opcode
MUL
read_opcode [Char]
"MULPD" = Opcode
MULPD
read_opcode [Char]
"MULPS" = Opcode
MULPS
read_opcode [Char]
"MULSD" = Opcode
MULSD
read_opcode [Char]
"MULSS" = Opcode
MULSS
read_opcode [Char]
"MWAIT" = Opcode
MWAIT
read_opcode [Char]
"NEG" = Opcode
NEG
read_opcode [Char]
"NOP" = Opcode
NOP
read_opcode [Char]
"NOT" = Opcode
NOT
read_opcode [Char]
"OR" = Opcode
OR
read_opcode [Char]
"ORPD" = Opcode
ORPD
read_opcode [Char]
"ORPS" = Opcode
ORPS
read_opcode [Char]
"OUT" = Opcode
OUT
read_opcode [Char]
"OUTS" = Opcode
OUTS
read_opcode [Char]
"PALIGNR" = Opcode
PALIGNR
read_opcode [Char]
"PACKSSDW" = Opcode
PACKSSDW
read_opcode [Char]
"PACKSSWB" = Opcode
PACKSSWB
read_opcode [Char]
"PADDB" = Opcode
PADDB
read_opcode [Char]
"PADDD" = Opcode
PADDD
read_opcode [Char]
"PADDQ" = Opcode
PADDQ
read_opcode [Char]
"PADDSB" = Opcode
PADDSB
read_opcode [Char]
"PADDSW" = Opcode
PADDSW
read_opcode [Char]
"PADDUSB" = Opcode
PADDUSB
read_opcode [Char]
"PADDUSW" = Opcode
PADDUSW
read_opcode [Char]
"PADDW" = Opcode
PADDW
read_opcode [Char]
"PAND" = Opcode
PAND
read_opcode [Char]
"PANDN" = Opcode
PANDN
read_opcode [Char]
"PAUSE" = Opcode
PAUSE
read_opcode [Char]
"PAVGB" = Opcode
PAVGB
read_opcode [Char]
"PAVGW" = Opcode
PAVGW
read_opcode [Char]
"PBLENDW" = Opcode
PBLENDW
read_opcode [Char]
"PCLMULQDQ" = Opcode
PCLMULQDQ
read_opcode [Char]
"PCMPEQB" = Opcode
PCMPEQB
read_opcode [Char]
"PCMPEQD" = Opcode
PCMPEQD
read_opcode [Char]
"PCMPGTB" = Opcode
PCMPGTB
read_opcode [Char]
"PCMPGTD" = Opcode
PCMPGTD
read_opcode [Char]
"PEXTRB" = Opcode
PEXTRB
read_opcode [Char]
"PEXTRD" = Opcode
PEXTRD
read_opcode [Char]
"PEXTRQ" = Opcode
PEXTRQ
read_opcode [Char]
"PHADDD" = Opcode
PHADDD
read_opcode [Char]
"PINSRB" = Opcode
PINSRB
read_opcode [Char]
"PINSRD" = Opcode
PINSRD
read_opcode [Char]
"PINSRQ" = Opcode
PINSRQ
read_opcode [Char]
"PMADDWD" = Opcode
PMADDWD
read_opcode [Char]
"PMAXSD" = Opcode
PMAXSD
read_opcode [Char]
"PMAXSW" = Opcode
PMAXSW
read_opcode [Char]
"PMAXUB" = Opcode
PMAXUB
read_opcode [Char]
"PMAXUD" = Opcode
PMAXUD
read_opcode [Char]
"PMAXUQ" = Opcode
PMAXUQ
read_opcode [Char]
"PMINSD" = Opcode
PMINSD
read_opcode [Char]
"PMINSW" = Opcode
PMINSW
read_opcode [Char]
"PMINUB" = Opcode
PMINUB
read_opcode [Char]
"PMINUD" = Opcode
PMINUD
read_opcode [Char]
"PMOVMSKB" = Opcode
PMOVMSKB
read_opcode [Char]
"PMOVSXDQ" = Opcode
PMOVSXDQ
read_opcode [Char]
"PMOVZXDQ" = Opcode
PMOVZXDQ
read_opcode [Char]
"PMOVSXBD" = Opcode
PMOVSXBD
read_opcode [Char]
"PMOVZXBD" = Opcode
PMOVZXBD
read_opcode [Char]
"PMULLD" = Opcode
PMULLD
read_opcode [Char]
"PMULLQ" = Opcode
PMULLQ
read_opcode [Char]
"PMULHUW" = Opcode
PMULHUW
read_opcode [Char]
"PMULHW" = Opcode
PMULHW
read_opcode [Char]
"PMULLW" = Opcode
PMULLW
read_opcode [Char]
"PMULUDQ" = Opcode
PMULUDQ
read_opcode [Char]
"POP" = Opcode
POP
read_opcode [Char]
"POPA" = Opcode
POPA
read_opcode [Char]
"POPAD" = Opcode
POPAD
read_opcode [Char]
"POPF" = Opcode
POPF
read_opcode [Char]
"POPFD" = Opcode
POPFD
read_opcode [Char]
"POPFQ" = Opcode
POPFQ
read_opcode [Char]
"POR" = Opcode
POR
read_opcode [Char]
"PREFETCHNTA" = Opcode
PREFETCHNTA
read_opcode [Char]
"PREFETCHT0" = Opcode
PREFETCHT0
read_opcode [Char]
"PREFETCHT1" = Opcode
PREFETCHT1
read_opcode [Char]
"PREFETCHT2" = Opcode
PREFETCHT2
read_opcode [Char]
"PSADBW" = Opcode
PSADBW
read_opcode [Char]
"PSHUFB" = Opcode
PSHUFB
read_opcode [Char]
"PSHUFD" = Opcode
PSHUFD
read_opcode [Char]
"PSHUFLW" = Opcode
PSHUFLW
read_opcode [Char]
"PSLLD" = Opcode
PSLLD
read_opcode [Char]
"PSLLDQ" = Opcode
PSLLDQ
read_opcode [Char]
"PSLLQ" = Opcode
PSLLQ
read_opcode [Char]
"PSLLW" = Opcode
PSLLW
read_opcode [Char]
"PSRAD" = Opcode
PSRAD
read_opcode [Char]
"PSRAW" = Opcode
PSRAW
read_opcode [Char]
"PSRLD" = Opcode
PSRLD
read_opcode [Char]
"PSRLDQ" = Opcode
PSRLDQ
read_opcode [Char]
"PSRLQ" = Opcode
PSRLQ
read_opcode [Char]
"PSRLW" = Opcode
PSRLW
read_opcode [Char]
"PSUBB" = Opcode
PSUBB
read_opcode [Char]
"PSUBD" = Opcode
PSUBD
read_opcode [Char]
"PSUBQ" = Opcode
PSUBQ
read_opcode [Char]
"PSUBSB" = Opcode
PSUBSB
read_opcode [Char]
"PSUBSQ" = Opcode
PSUBSQ
read_opcode [Char]
"PSUBUSB" = Opcode
PSUBUSB
read_opcode [Char]
"PSUBUSW" = Opcode
PSUBUSW
read_opcode [Char]
"PSUBW" = Opcode
PSUBW
read_opcode [Char]
"PTEST" = Opcode
PTEST
read_opcode [Char]
"PUNPCKLBW" = Opcode
PUNPCKLBW
read_opcode [Char]
"PUNPCKLWD" = Opcode
PUNPCKLWD
read_opcode [Char]
"PUNPCKLDQ" = Opcode
PUNPCKLDQ
read_opcode [Char]
"PUNPCKLQDQ" = Opcode
PUNPCKLQDQ
read_opcode [Char]
"PUSH" = Opcode
PUSH
read_opcode [Char]
"PUSHA" = Opcode
PUSHA
read_opcode [Char]
"PUSHAD" = Opcode
PUSHAD
read_opcode [Char]
"PUSHF" = Opcode
PUSHF
read_opcode [Char]
"PUSHFD" = Opcode
PUSHFD
read_opcode [Char]
"PUSHFQ" = Opcode
PUSHFQ
read_opcode [Char]
"PXOR" = Opcode
PXOR
read_opcode [Char]
"RCL" = Opcode
RCL
read_opcode [Char]
"RCPPS" = Opcode
RCPPS
read_opcode [Char]
"RCPSS" = Opcode
RCPSS
read_opcode [Char]
"RCR" = Opcode
RCR
read_opcode [Char]
"RDMSR" = Opcode
RDMSR
read_opcode [Char]
"RDPMC" = Opcode
RDPMC
read_opcode [Char]
"RDTSC" = Opcode
RDTSC
read_opcode [Char]
"RET" = Opcode
RET
read_opcode [Char]
"RETF" = Opcode
RETF
read_opcode [Char]
"RETN" = Opcode
RETN
read_opcode [Char]
"ROL" = Opcode
ROL
read_opcode [Char]
"ROR" = Opcode
ROR
read_opcode [Char]
"ROUNDSD" = Opcode
ROUNDSD
read_opcode [Char]
"ROUNDSS" = Opcode
ROUNDSS
read_opcode [Char]
"RSM" = Opcode
RSM
read_opcode [Char]
"RSQRTPS" = Opcode
RSQRTPS
read_opcode [Char]
"RSQRTSS" = Opcode
RSQRTSS
read_opcode [Char]
"SAHF" = Opcode
SAHF
read_opcode [Char]
"SAL" = Opcode
SAL
read_opcode [Char]
"SAR" = Opcode
SAR
read_opcode [Char]
"SBB" = Opcode
SBB
read_opcode [Char]
"SCAS" = Opcode
SCAS
read_opcode [Char]
"SCASB" = Opcode
SCASB
read_opcode [Char]
"SCASD" = Opcode
SCASD
read_opcode [Char]
"SETA" = Opcode
SETA
read_opcode [Char]
"SETAE" = Opcode
SETAE
read_opcode [Char]
"SETB" = Opcode
SETB
read_opcode [Char]
"SETBE" = Opcode
SETBE
read_opcode [Char]
"SETC" = Opcode
SETC
read_opcode [Char]
"SETE" = Opcode
SETE
read_opcode [Char]
"SETG" = Opcode
SETG
read_opcode [Char]
"SETGE" = Opcode
SETGE
read_opcode [Char]
"SETL" = Opcode
SETL
read_opcode [Char]
"SETLE" = Opcode
SETLE
read_opcode [Char]
"SETNA" = Opcode
SETNA
read_opcode [Char]
"SETNAE" = Opcode
SETNAE
read_opcode [Char]
"SETNB" = Opcode
SETNB
read_opcode [Char]
"SETNBE" = Opcode
SETNBE
read_opcode [Char]
"SETNC" = Opcode
SETNC
read_opcode [Char]
"SETNE" = Opcode
SETNE
read_opcode [Char]
"SETNG" = Opcode
SETNG
read_opcode [Char]
"SETNGE" = Opcode
SETNGE
read_opcode [Char]
"SETNL" = Opcode
SETNL
read_opcode [Char]
"SETNLE" = Opcode
SETNLE
read_opcode [Char]
"SETNO" = Opcode
SETNO
read_opcode [Char]
"SETNP" = Opcode
SETNP
read_opcode [Char]
"SETNS" = Opcode
SETNS
read_opcode [Char]
"SETNZ" = Opcode
SETNZ
read_opcode [Char]
"SETO" = Opcode
SETO
read_opcode [Char]
"SETP" = Opcode
SETP
read_opcode [Char]
"SETPE" = Opcode
SETPE
read_opcode [Char]
"SETPO" = Opcode
SETPO
read_opcode [Char]
"SETS" = Opcode
SETS
read_opcode [Char]
"SETZ" = Opcode
SETZ
read_opcode [Char]
"SFENCE" = Opcode
SFENCE
read_opcode [Char]
"SGDT" = Opcode
SGDT
read_opcode [Char]
"SHL" = Opcode
SHL
read_opcode [Char]
"SHLD" = Opcode
SHLD
read_opcode [Char]
"SHR" = Opcode
SHR
read_opcode [Char]
"SHRD" = Opcode
SHRD
read_opcode [Char]
"SHUFPS" = Opcode
SHUFPS
read_opcode [Char]
"SIDT" = Opcode
SIDT
read_opcode [Char]
"SLDT" = Opcode
SLDT
read_opcode [Char]
"SMSW" = Opcode
SMSW
read_opcode [Char]
"SQRTPD" = Opcode
SQRTPD
read_opcode [Char]
"SQRTPS" = Opcode
SQRTPS
read_opcode [Char]
"SQRTSD" = Opcode
SQRTSD
read_opcode [Char]
"SQRTSS" = Opcode
SQRTSS
read_opcode [Char]
"STC" = Opcode
STC
read_opcode [Char]
"STD" = Opcode
STD
read_opcode [Char]
"STI" = Opcode
STI
read_opcode [Char]
"STMXCSR" = Opcode
STMXCSR
read_opcode [Char]
"STOS" = Opcode
STOS
read_opcode [Char]
"STOSB" = Opcode
STOSB
read_opcode [Char]
"STOSD" = Opcode
STOSD
read_opcode [Char]
"STOSQ" = Opcode
STOSQ
read_opcode [Char]
"STR" = Opcode
STR
read_opcode [Char]
"SUB" = Opcode
SUB
read_opcode [Char]
"SUBPD" = Opcode
SUBPD
read_opcode [Char]
"SUBPS" = Opcode
SUBPS
read_opcode [Char]
"SUBSD" = Opcode
SUBSD
read_opcode [Char]
"SUBSS" = Opcode
SUBSS
read_opcode [Char]
"SWAPGS" = Opcode
SWAPGS
read_opcode [Char]
"SYSCALL" = Opcode
SYSCALL
read_opcode [Char]
"SYSENTER" = Opcode
SYSENTER
read_opcode [Char]
"SYSEXIT" = Opcode
SYSEXIT
read_opcode [Char]
"SYSRET" = Opcode
SYSRET
read_opcode [Char]
"TEST" = Opcode
TEST
read_opcode [Char]
"UCOMISD" = Opcode
UCOMISD
read_opcode [Char]
"UCOMISS" = Opcode
UCOMISS
read_opcode [Char]
"UD2" = Opcode
UD2
read_opcode [Char]
"UNPCKHPD" = Opcode
UNPCKHPD
read_opcode [Char]
"UNPCKHPS" = Opcode
UNPCKHPS
read_opcode [Char]
"UNPCKLPD" = Opcode
UNPCKLPD
read_opcode [Char]
"UNPCKLPS" = Opcode
UNPCKLPS
read_opcode [Char]
"VANDPD" = Opcode
VANDPD
read_opcode [Char]
"VANDPS" = Opcode
VANDPS
read_opcode [Char]
"VADDPD" = Opcode
VADDPD
read_opcode [Char]
"VADDPS" = Opcode
VADDPS
read_opcode [Char]
"VBLENDPS" = Opcode
VBLENDPS
read_opcode [Char]
"VERR" = Opcode
VERR
read_opcode [Char]
"VERW" = Opcode
VERW
read_opcode [Char]
"VEXTRACTI128" = Opcode
VEXTRACTI128
read_opcode [Char]
"VEXTRACTF128" = Opcode
VEXTRACTF128
read_opcode [Char]
"VINSERTF128" = Opcode
VINSERTF128
read_opcode [Char]
"VMCALL" = Opcode
VMCALL
read_opcode [Char]
"VMCLEAR" = Opcode
VMCLEAR
read_opcode [Char]
"VMLAUNCH" = Opcode
VMLAUNCH
read_opcode [Char]
"VMOVAPD" = Opcode
VMOVAPD
read_opcode [Char]
"VMOVAPS" = Opcode
VMOVAPS
read_opcode [Char]
"VMOVHPS" = Opcode
VMOVHPS
read_opcode [Char]
"VMOVD" = Opcode
VMOVD
read_opcode [Char]
"VMOVDQA" = Opcode
VMOVDQA
read_opcode [Char]
"VMOVDQU" = Opcode
VMOVDQU
read_opcode [Char]
"VMOVLHPS" = Opcode
VMOVLHPS
read_opcode [Char]
"VMPTRLD" = Opcode
VMPTRLD
read_opcode [Char]
"VMPTRST" = Opcode
VMPTRST
read_opcode [Char]
"VMREAD" = Opcode
VMREAD
read_opcode [Char]
"VMRESUME" = Opcode
VMRESUME
read_opcode [Char]
"VMWRITE" = Opcode
VMWRITE
read_opcode [Char]
"VMULPD" = Opcode
VMULPD
read_opcode [Char]
"VMULPS" = Opcode
VMULPS
read_opcode [Char]
"VMXOFF" = Opcode
VMXOFF
read_opcode [Char]
"VMXON" = Opcode
VMXON
read_opcode [Char]
"VPALIGNR" = Opcode
VPALIGNR
read_opcode [Char]
"VPAND" = Opcode
VPAND
read_opcode [Char]
"VPANDN" = Opcode
VPANDN
read_opcode [Char]
"VPCMPEQB" = Opcode
VPCMPEQB
read_opcode [Char]
"VPCMPEQW" = Opcode
VPCMPEQW
read_opcode [Char]
"VPERM2F128" = Opcode
VPERM2F128
read_opcode [Char]
"VPERM2I128" = Opcode
VPERM2I128
read_opcode [Char]
"VPERMILPS" = Opcode
VPERMILPS
read_opcode [Char]
"VPOR" = Opcode
VPOR
read_opcode [Char]
"VPSHUFB" = Opcode
VPSHUFB
read_opcode [Char]
"VPSHUFD" = Opcode
VPSHUFD
read_opcode [Char]
"VPSLLW" = Opcode
VPSLLW
read_opcode [Char]
"VSHUFPS" = Opcode
VSHUFPS
read_opcode [Char]
"VSHUFPD" = Opcode
VSHUFPD
read_opcode [Char]
"VPXOR" = Opcode
VPXOR
read_opcode [Char]
"VPUNPCKLWD" = Opcode
VPUNPCKLWD
read_opcode [Char]
"VPUNPCKHWD" = Opcode
VPUNPCKHWD
read_opcode [Char]
"VSUBPD" = Opcode
VSUBPD
read_opcode [Char]
"VSUBPS" = Opcode
VSUBPS
read_opcode [Char]
"VUNPCKHPS" = Opcode
VUNPCKHPS
read_opcode [Char]
"VUNPCKLPS" = Opcode
VUNPCKLPS
read_opcode [Char]
"VXORPD" = Opcode
VXORPD
read_opcode [Char]
"VXORPS" = Opcode
VXORPS
read_opcode [Char]
"VZEROUPPER" = Opcode
VZEROUPPER
read_opcode [Char]
"WAIT" = Opcode
WAIT
read_opcode [Char]
"WBINVD" = Opcode
WBINVD
read_opcode [Char]
"WRFSBASE" = Opcode
WRFSBASE
read_opcode [Char]
"WRGSBASE" = Opcode
WRGSBASE
read_opcode [Char]
"WRMSR" = Opcode
WRMSR
read_opcode [Char]
"XADD" = Opcode
XADD
read_opcode [Char]
"XCHG" = Opcode
XCHG
read_opcode [Char]
"XGETBV" = Opcode
XGETBV
read_opcode [Char]
"XLAT" = Opcode
XLAT
read_opcode [Char]
"XLATB" = Opcode
XLATB
read_opcode [Char]
"XSETBV" = Opcode
XSETBV
read_opcode [Char]
"XSAVEOPT" = Opcode
XSAVEOPT
read_opcode [Char]
"XRSTOR" = Opcode
XRSTOR
read_opcode [Char]
"XOR" = Opcode
XOR
read_opcode [Char]
"XORPD" = Opcode
XORPD
read_opcode [Char]
"XORPS" = Opcode
XORPS
read_opcode [Char]
_ = Opcode
InvalidOpcode


read_regname :: [Char] -> Register
read_regname [Char]
"RIP" = Register
RIP
read_regname [Char]
"EIP" = Register
EIP
read_regname [Char]
"RAX" = Register
RAX
read_regname [Char]
"EAX" = Register
EAX
read_regname [Char]
"AX" = Register
AX
read_regname [Char]
"AH" = Register
AH
read_regname [Char]
"AL" = Register
AL
read_regname [Char]
"RBX" = Register
RBX
read_regname [Char]
"EBX" = Register
EBX
read_regname [Char]
"BX" = Register
BX
read_regname [Char]
"BH" = Register
BH
read_regname [Char]
"BL" = Register
BL
read_regname [Char]
"RCX" = Register
RCX
read_regname [Char]
"ECX" = Register
ECX
read_regname [Char]
"CX" = Register
CX
read_regname [Char]
"CH" = Register
CH
read_regname [Char]
"CL" = Register
CL
read_regname [Char]
"RDX" = Register
RDX
read_regname [Char]
"EDX" = Register
EDX
read_regname [Char]
"DX" = Register
DX
read_regname [Char]
"DH" = Register
DH
read_regname [Char]
"DL" = Register
DL
read_regname [Char]
"RDI" = Register
RDI
read_regname [Char]
"EDI" = Register
EDI
read_regname [Char]
"DI" = Register
DI
read_regname [Char]
"DIL" = Register
DIL
read_regname [Char]
"RSI" = Register
RSI
read_regname [Char]
"ESI" = Register
ESI
read_regname [Char]
"SI" = Register
SI
read_regname [Char]
"SIL" = Register
SIL
read_regname [Char]
"RSP" = Register
RSP
read_regname [Char]
"ESP" = Register
ESP
read_regname [Char]
"SP" = Register
SP
read_regname [Char]
"SPL" = Register
SPL
read_regname [Char]
"RBP" = Register
RBP
read_regname [Char]
"EBP" = Register
EBP
read_regname [Char]
"BP" = Register
BP
read_regname [Char]
"BPL" = Register
BPL
read_regname [Char]
"R15" = Register
R15
read_regname [Char]
"R15D" = Register
R15D
read_regname [Char]
"R15W" = Register
R15W
read_regname [Char]
"R15B" = Register
R15B
read_regname [Char]
"R14" = Register
R14
read_regname [Char]
"R14D" = Register
R14D
read_regname [Char]
"R14W" = Register
R14W
read_regname [Char]
"R14B" = Register
R14B
read_regname [Char]
"R13" = Register
R13
read_regname [Char]
"R13D" = Register
R13D
read_regname [Char]
"R13W" = Register
R13W
read_regname [Char]
"R13B" = Register
R13B
read_regname [Char]
"R12" = Register
R12
read_regname [Char]
"R12D" = Register
R12D
read_regname [Char]
"R12W" = Register
R12W
read_regname [Char]
"R12B" = Register
R12B
read_regname [Char]
"R11" = Register
R11
read_regname [Char]
"R11D" = Register
R11D
read_regname [Char]
"R11W" = Register
R11W
read_regname [Char]
"R11B" = Register
R11B
read_regname [Char]
"R10" = Register
R10
read_regname [Char]
"R10D" = Register
R10D
read_regname [Char]
"R10W" = Register
R10W
read_regname [Char]
"R10B" = Register
R10B
read_regname [Char]
"R9" = Register
R9
read_regname [Char]
"R9D" = Register
R9D
read_regname [Char]
"R9W" = Register
R9W
read_regname [Char]
"R9B" = Register
R9B
read_regname [Char]
"R8" = Register
R8
read_regname [Char]
"R8D" = Register
R8D
read_regname [Char]
"R8W" = Register
R8W
read_regname [Char]
"R8B" = Register
R8B
read_regname [Char]
"CS" = Register
CS
read_regname [Char]
"DS" = Register
DS
read_regname [Char]
"ES" = Register
ES
read_regname [Char]
"FS" = Register
FS
read_regname [Char]
"GS" = Register
GS
read_regname [Char]
"SS" = Register
SS
read_regname [Char]
"EIZ" = Register
EIZ
read_regname [Char]
"RIZ" = Register
RIZ
read_regname [Char]
"ST0" = Register
ST0
read_regname [Char]
"ST1" = Register
ST1
read_regname [Char]
"ST2" = Register
ST2
read_regname [Char]
"ST3" = Register
ST3
read_regname [Char]
"ST4" = Register
ST4
read_regname [Char]
"ST5" = Register
ST5
read_regname [Char]
"ST6" = Register
ST6
read_regname [Char]
"ST7" = Register
ST7
read_regname [Char]
"YMM0" = Register
YMM0
read_regname [Char]
"YMM1" = Register
YMM1
read_regname [Char]
"YMM2" = Register
YMM2
read_regname [Char]
"YMM3" = Register
YMM3
read_regname [Char]
"YMM4" = Register
YMM4
read_regname [Char]
"YMM5" = Register
YMM5
read_regname [Char]
"YMM6" = Register
YMM6
read_regname [Char]
"YMM7" = Register
YMM7
read_regname [Char]
"YMM8" = Register
YMM8
read_regname [Char]
"YMM9" = Register
YMM9
read_regname [Char]
"YMM10" = Register
YMM10
read_regname [Char]
"YMM11" = Register
YMM11
read_regname [Char]
"YMM12" = Register
YMM12
read_regname [Char]
"YMM13" = Register
YMM13
read_regname [Char]
"YMM14" = Register
YMM14
read_regname [Char]
"YMM15" = Register
YMM15
read_regname [Char]
"XMM0" = Register
XMM0
read_regname [Char]
"XMM1" = Register
XMM1
read_regname [Char]
"XMM2" = Register
XMM2
read_regname [Char]
"XMM3" = Register
XMM3
read_regname [Char]
"XMM4" = Register
XMM4
read_regname [Char]
"XMM5" = Register
XMM5
read_regname [Char]
"XMM6" = Register
XMM6
read_regname [Char]
"XMM7" = Register
XMM7
read_regname [Char]
"XMM8" = Register
XMM8
read_regname [Char]
"XMM9" = Register
XMM9
read_regname [Char]
"XMM10" = Register
XMM10
read_regname [Char]
"XMM11" = Register
XMM11
read_regname [Char]
"XMM12" = Register
XMM12
read_regname [Char]
"XMM13" = Register
XMM13
read_regname [Char]
"XMM14" = Register
XMM14
read_regname [Char]
"XMM15" = Register
XMM15



read_regname [Char]
"ST(0)" = Register
ST0
read_regname [Char]
"ST(1)" = Register
ST1
read_regname [Char]
"ST(2)" = Register
ST2
read_regname [Char]
"ST(3)" = Register
ST3
read_regname [Char]
"ST(4)" = Register
ST4
read_regname [Char]
"ST(5)" = Register
ST5
read_regname [Char]
"ST(6)" = Register
ST6
read_regname [Char]
"ST(7)" = Register
ST7

read_regname [Char]
_ = Register
InvalidRegister