{-# language GeneralizedNewtypeDeriving #-}
{-# language NoMonomorphismRestriction #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneDeriving #-}
{-# language FlexibleInstances #-}
{-# language FlexibleContexts #-}
{-# language PatternSynonyms #-}
{-# language KindSignatures #-}
{-# language PatternGuards #-}
{-# language BangPatterns #-}
{-# language ViewPatterns #-}
{-# language TypeFamilies #-}
{-# language LambdaCase #-}
{-# language RankNTypes #-}
{-# language DataKinds #-}
{-# language PolyKinds #-}
{-# language GADTs #-}
{-# language CPP #-}
module CodeGen.X86.Asm where

import Numeric
import Data.List
import Data.Bits
import Data.Int
import Data.Word
import Control.Monad
import Control.Arrow
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.State

------------------------------------------------------- utils

everyNth :: Int -> [a] -> [[a]]
everyNth Int
n [] = []
everyNth Int
n [a]
xs = forall a. Int -> [a] -> [a]
take Int
n [a]
xsforall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
everyNth Int
n (forall a. Int -> [a] -> [a]
drop Int
n [a]
xs)

showNibble :: (Integral a, Bits a) => Int -> a -> Char
showNibble :: forall a. (Integral a, Bits a) => Int -> a -> Char
showNibble Int
n a
x = forall a. Enum a => Int -> a
toEnum (Int
b forall a. Num a => a -> a -> a
+ if Int
b forall a. Ord a => a -> a -> Bool
< Int
10 then Int
48 else Int
87)
  where b :: Int
b = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ a
x forall a. Bits a => a -> Int -> a
`shiftR` (Int
4 forall a. Num a => a -> a -> a
* Int
n) forall a. Bits a => a -> a -> a
.&. a
0x0f

showByte :: a -> String
showByte a
b = [forall a. (Integral a, Bits a) => Int -> a -> Char
showNibble Int
1 a
b, forall a. (Integral a, Bits a) => Int -> a -> Char
showNibble Int
0 a
b]

showHex' :: a -> String
showHex' a
x = String
"0x" forall a. [a] -> [a] -> [a]
++ forall a. (Integral a, Show a) => a -> ShowS
showHex a
x String
""

pattern $mIntegral :: forall {r} {a} {b}.
(Integral a, Integral b, Bits a, Bits b) =>
a -> (b -> r) -> ((# #) -> r) -> r
Integral xs <- (toIntegralSized -> Just xs)

------------------------------------------------------- byte sequences

type Bytes = [Word8]

class HasBytes a where toBytes :: a -> Bytes

instance HasBytes Word8  where
  toBytes :: Word8 -> Bytes
toBytes Word8
w = [Word8
w]
instance HasBytes Word16 where
  toBytes :: Word16 -> Bytes
toBytes Word16
w = [forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w, forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word16
w forall a. Bits a => a -> Int -> a
`shiftR` Int
8]
instance HasBytes Word32 where
  toBytes :: Word32 -> Bytes
toBytes Word32
w = [ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
n | Int
n <- [Int
0, Int
8 .. Int
24] ]
instance HasBytes Word64 where
  toBytes :: Word64 -> Bytes
toBytes Word64
w = [ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w forall a. Bits a => a -> Int -> a
`shiftR` Int
n | Int
n <- [Int
0, Int
8 .. Int
56] ]

instance HasBytes Int8  where
  toBytes :: Int8 -> Bytes
toBytes Int8
w = forall a. HasBytes a => a -> Bytes
toBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
w :: Word8)
instance HasBytes Int16 where
  toBytes :: Int16 -> Bytes
toBytes Int16
w = forall a. HasBytes a => a -> Bytes
toBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
w :: Word16)
instance HasBytes Int32 where
  toBytes :: Int32 -> Bytes
toBytes Int32
w = forall a. HasBytes a => a -> Bytes
toBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
w :: Word32)
instance HasBytes Int64 where
  toBytes :: Int64 -> Bytes
toBytes Int64
w = forall a. HasBytes a => a -> Bytes
toBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
w :: Word64)

------------------------------------------------------- sizes

-- | The size of a register (in bits)
data Size = S1 | S8 | S16 | S32 | S64 | S128
  deriving (Size -> Size -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c== :: Size -> Size -> Bool
Eq, Eq Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmax :: Size -> Size -> Size
>= :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c< :: Size -> Size -> Bool
compare :: Size -> Size -> Ordering
$ccompare :: Size -> Size -> Ordering
Ord)

instance Show Size where
  show :: Size -> String
show = \case
    Size
S1   -> String
"bit"
    Size
S8   -> String
"byte"
    Size
S16  -> String
"word"
    Size
S32  -> String
"dword"
    Size
S64  -> String
"qword"
    Size
S128 -> String
"oword"

mkSize :: a -> Size
mkSize  a
1 = Size
S8
mkSize  a
2 = Size
S16
mkSize  a
4 = Size
S32
mkSize  a
8 = Size
S64
mkSize a
16 = Size
S128

sizeLen :: Size -> a
sizeLen = \case
  Size
S8   -> a
1
  Size
S16  -> a
2
  Size
S32  -> a
4
  Size
S64  -> a
8
  Size
S128 -> a
16

class HasSize a where size :: a -> Size

instance HasSize Word8  where size :: Word8 -> Size
size Word8
_ = Size
S8
instance HasSize Word16 where size :: Word16 -> Size
size Word16
_ = Size
S16
instance HasSize Word32 where size :: Word32 -> Size
size Word32
_ = Size
S32
instance HasSize Word64 where size :: Word64 -> Size
size Word64
_ = Size
S64
instance HasSize Int8   where size :: Int8 -> Size
size Int8
_ = Size
S8
instance HasSize Int16  where size :: Int16 -> Size
size Int16
_ = Size
S16
instance HasSize Int32  where size :: Int32 -> Size
size Int32
_ = Size
S32
instance HasSize Int64  where size :: Int64 -> Size
size Int64
_ = Size
S64

-- | Singleton type for size
data SSize (s :: Size) where
  SSize1   :: SSize S1
  SSize8   :: SSize S8
  SSize16  :: SSize S16
  SSize32  :: SSize S32
  SSize64  :: SSize S64
  SSize128 :: SSize S128

instance HasSize (SSize s) where
  size :: SSize s -> Size
size = \case
    SSize s
SSize1   -> Size
S1
    SSize s
SSize8   -> Size
S8
    SSize s
SSize16  -> Size
S16
    SSize s
SSize32  -> Size
S32
    SSize s
SSize64  -> Size
S64
    SSize s
SSize128 -> Size
S128

class IsSize (s :: Size) where
  ssize :: SSize s

instance IsSize S1   where ssize :: SSize 'S1
ssize = SSize 'S1
SSize1
instance IsSize S8   where ssize :: SSize 'S8
ssize = SSize 'S8
SSize8
instance IsSize S16  where ssize :: SSize 'S16
ssize = SSize 'S16
SSize16
instance IsSize S32  where ssize :: SSize 'S32
ssize = SSize 'S32
SSize32
instance IsSize S64  where ssize :: SSize 'S64
ssize = SSize 'S64
SSize64
instance IsSize S128 where ssize :: SSize 'S128
ssize = SSize 'S128
SSize128

data EqT s s' where
  Refl :: EqT s s

sizeEqCheck :: forall s s' f g . (IsSize s, IsSize s') => f s -> g s' -> Maybe (EqT s s')
sizeEqCheck :: forall (s :: Size) (s' :: Size) (f :: Size -> *) (g :: Size -> *).
(IsSize s, IsSize s') =>
f s -> g s' -> Maybe (EqT s s')
sizeEqCheck f s
_ g s'
_ = case (forall (s :: Size). IsSize s => SSize s
ssize :: SSize s, forall (s :: Size). IsSize s => SSize s
ssize :: SSize s') of
  (SSize s
SSize8 , SSize s'
SSize8)  -> forall a. a -> Maybe a
Just forall {k} (s :: k). EqT s s
Refl
  (SSize s
SSize16, SSize s'
SSize16) -> forall a. a -> Maybe a
Just forall {k} (s :: k). EqT s s
Refl
  (SSize s
SSize32, SSize s'
SSize32) -> forall a. a -> Maybe a
Just forall {k} (s :: k). EqT s s
Refl
  (SSize s
SSize64, SSize s'
SSize64) -> forall a. a -> Maybe a
Just forall {k} (s :: k). EqT s s
Refl
  (SSize s, SSize s')
_ -> forall a. Maybe a
Nothing

------------------------------------------------------- scale

-- | The scaling of an index. (replace with Size?)
newtype Scale = Scale Word8
  deriving (Scale -> Scale -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scale -> Scale -> Bool
$c/= :: Scale -> Scale -> Bool
== :: Scale -> Scale -> Bool
$c== :: Scale -> Scale -> Bool
Eq)

s1 :: Scale
s1 = Word8 -> Scale
Scale Word8
0x0
s2 :: Scale
s2 = Word8 -> Scale
Scale Word8
0x1
s4 :: Scale
s4 = Word8 -> Scale
Scale Word8
0x2
s8 :: Scale
s8 = Word8 -> Scale
Scale Word8
0x3

toScale :: a -> Scale
toScale = \case
  a
1 -> Scale
s1
  a
2 -> Scale
s2
  a
4 -> Scale
s4
  a
8 -> Scale
s8

scaleFactor :: Scale -> a
scaleFactor (Scale Word8
i) = case Word8
i of
  Word8
0x0 -> a
1
  Word8
0x1 -> a
2
  Word8
0x2 -> a
4
  Word8
0x3 -> a
8

------------------------------------------------------- operand

-- | An operand can be an immediate, a register, a memory address or RIP-relative (memory address relative to the instruction pointer)
data Operand :: Access -> Size -> * where
  ImmOp     :: Immediate Int64 -> Operand R s
  RegOp     :: Reg s -> Operand rw s
  MemOp     :: IsSize s' => Addr s' -> Operand rw s
  IPMemOp   :: Immediate Int32 -> Operand rw s

addr :: IsSize s => Address s -> Operand rw s'
addr :: forall (s :: Size) (rw :: Access) (s' :: Size).
IsSize s =>
Address s -> Operand rw s'
addr = forall (s' :: Size) (rw :: Access) (s :: Size).
IsSize s' =>
Addr s' -> Operand rw s
MemOp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Size). Address s -> Addr s
makeAddr

-- | `addr` with specialized type
addr8 :: IsSize s => Address s -> Operand rw S8
addr8 :: forall (s :: Size) (rw :: Access).
IsSize s =>
Address s -> Operand rw 'S8
addr8 = forall (s :: Size) (rw :: Access) (s' :: Size).
IsSize s =>
Address s -> Operand rw s'
addr

-- | `addr` with specialized type
addr16 :: IsSize s => Address s -> Operand rw S16
addr16 :: forall (s :: Size) (rw :: Access).
IsSize s =>
Address s -> Operand rw 'S16
addr16 = forall (s :: Size) (rw :: Access) (s' :: Size).
IsSize s =>
Address s -> Operand rw s'
addr

-- | `addr` with specialized type
addr32 :: IsSize s => Address s -> Operand rw S32
addr32 :: forall (s :: Size) (rw :: Access).
IsSize s =>
Address s -> Operand rw 'S32
addr32 = forall (s :: Size) (rw :: Access) (s' :: Size).
IsSize s =>
Address s -> Operand rw s'
addr

-- | `addr` with specialized type
addr64 :: IsSize s => Address s -> Operand rw S64
addr64 :: forall (s :: Size) (rw :: Access).
IsSize s =>
Address s -> Operand rw 'S64
addr64 = forall (s :: Size) (rw :: Access) (s' :: Size).
IsSize s =>
Address s -> Operand rw s'
addr

data Immediate a
  = Immediate a
  | LabelRelValue Size{-size hint-} Label

-- Type of labels
newtype Label = Label {Label -> Int
unLabel :: Int}

instance Show Label where
  show :: Label -> String
show (Label Int
i) = String
".l" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i

-- | Operand access modes
data Access
  = R     -- ^ readable operand
  | RW    -- ^ readable and writeable operand

-- | A register.
data Reg :: Size -> * where
  NormalReg :: Word8 -> Reg s      -- \"normal\" registers are for example @AL@, @BX@, @ECX@ or @RSI@
  HighReg   :: Word8 -> Reg S8     -- \"high\" registers are @AH@, @BH@, @CH@ etc
  XMM       :: Word8 -> Reg S128   -- XMM registers

deriving instance Eq (Reg s)
deriving instance Ord (Reg s)

-- | A (relative) address is made up base a base register, a displacement, and a (scaled) index.
-- For example in @[eax+4*ecx+20]@ the base register is @eax@, the displacement is @20@ and the
-- index is @4*ecx@.
data Addr s = Addr
  { forall (s :: Size). Addr s -> BaseReg s
baseReg        :: BaseReg s
  , forall (s :: Size). Addr s -> Displacement
displacement   :: Displacement
  , forall (s :: Size). Addr s -> IndexReg s
indexReg       :: IndexReg s
  }
  deriving (Addr s -> Addr s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Size). Addr s -> Addr s -> Bool
/= :: Addr s -> Addr s -> Bool
$c/= :: forall (s :: Size). Addr s -> Addr s -> Bool
== :: Addr s -> Addr s -> Bool
$c== :: forall (s :: Size). Addr s -> Addr s -> Bool
Eq)

type BaseReg s = Maybe (Reg s)

data IndexReg s = NoIndex | IndexReg Scale (Reg s)
  deriving (IndexReg s -> IndexReg s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Size). IndexReg s -> IndexReg s -> Bool
/= :: IndexReg s -> IndexReg s -> Bool
$c/= :: forall (s :: Size). IndexReg s -> IndexReg s -> Bool
== :: IndexReg s -> IndexReg s -> Bool
$c== :: forall (s :: Size). IndexReg s -> IndexReg s -> Bool
Eq)

type Displacement = Maybe Int32

pattern $bNoDisp :: forall a. Maybe a
$mNoDisp :: forall {r} {a}. Maybe a -> ((# #) -> r) -> ((# #) -> r) -> r
NoDisp = Nothing
pattern $bDisp :: forall a. a -> Maybe a
$mDisp :: forall {r} {a}. Maybe a -> (a -> r) -> ((# #) -> r) -> r
Disp a = Just a

-- | intruction pointer (RIP) relative address
ipRel :: Label -> Operand rw s
ipRel :: forall (rw :: Access) (s :: Size). Label -> Operand rw s
ipRel Label
l = forall (rw :: Access) (s :: Size). Immediate Int32 -> Operand rw s
IPMemOp forall a b. (a -> b) -> a -> b
$ forall a. Size -> Label -> Immediate a
LabelRelValue Size
S32 Label
l

ipRelValue :: Label -> Operand 'R s
ipRelValue Label
l = forall (s :: Size). Immediate Int64 -> Operand 'R s
ImmOp forall a b. (a -> b) -> a -> b
$ forall a. Size -> Label -> Immediate a
LabelRelValue Size
S32 Label
l

-- | `ipRel` with specialized type
ipRel8 :: Label -> Operand rw S8
ipRel8 :: forall (rw :: Access). Label -> Operand rw 'S8
ipRel8 = forall (rw :: Access) (s :: Size). Label -> Operand rw s
ipRel

instance IsSize s => Show (Reg s) where
  show :: Reg s -> String
show (XMM Word8
i) = String
"xmm" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
i
  show (HighReg Word8
i) =
    ([String
"ah", String
" ch", String
"dh", String
"bh"] forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat (forall a. HasCallStack => String -> a
error (String
"show @Reg")))
      forall a. [a] -> Int -> a
!! forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i

  show r :: Reg s
r@(NormalReg Word8
i) =
    (forall a. [a] -> Int -> a
!! forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat (forall a. HasCallStack => String -> a
error (String
"show @Reg"))) forall a b. (a -> b) -> a -> b
$ case forall a. HasSize a => a -> Size
size Reg s
r of
      Size
S8 ->
        [String
"al", String
"cl", String
"dl", String
"bl", String
"spl", String
"bpl", String
"sil", String
"dil"] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a] -> [a]
++ String
"b") [String]
r8
      Size
S16 -> [String]
r0 forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a] -> [a]
++ String
"w") [String]
r8
      Size
S32 -> forall a b. (a -> b) -> [a] -> [b]
map (Char
'e' forall a. a -> [a] -> [a]
:) [String]
r0 forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a] -> [a]
++ String
"d") [String]
r8
      Size
S64 -> forall a b. (a -> b) -> [a] -> [b]
map (Char
'r' forall a. a -> [a] -> [a]
:) [String]
r0 forall a. [a] -> [a] -> [a]
++ [String]
r8
   where
    r0 :: [String]
r0 = [String
"ax", String
"cx", String
"dx", String
"bx", String
"sp", String
"bp", String
"si", String
"di"]
    r8 :: [String]
r8 = [String
"r8", String
"r9", String
"r10", String
"r11", String
"r12", String
"r13", String
"r14", String
"r15"]

instance IsSize s => Show (Addr s) where
  show :: Addr s -> String
show (Addr BaseReg s
b Displacement
d IndexReg s
i) = [(Bool, String)] -> String
showSum forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => Maybe a -> [(Bool, String)]
shb BaseReg s
b forall a. [a] -> [a] -> [a]
++ forall {a}. (Eq a, Num a, Show a) => Maybe a -> [(Bool, String)]
shd Displacement
d forall a. [a] -> [a] -> [a]
++ forall {s :: Size}. IsSize s => IndexReg s -> [(Bool, String)]
shi IndexReg s
i
   where
    shb :: Maybe a -> [(Bool, String)]
shb Maybe a
Nothing  = []
    shb (Just a
x) = [(Bool
True, forall a. Show a => a -> String
show a
x)]
    shd :: Maybe a -> [(Bool, String)]
shd Maybe a
NoDisp   = []
    shd (Disp a
x) = [(forall a. Num a => a -> a
signum a
x forall a. Eq a => a -> a -> Bool
/= (-a
1), forall a. Show a => a -> String
show (forall a. Num a => a -> a
abs a
x))]
    shi :: IndexReg s -> [(Bool, String)]
shi IndexReg s
NoIndex         = []
    shi (IndexReg Scale
sc Reg s
x) = [(Bool
True, forall {a}. (Eq a, Num a, Show a) => a -> String
show' (forall {a}. Num a => Scale -> a
scaleFactor Scale
sc) forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Reg s
x)]
    show' :: a -> String
show' a
1 = String
""
    show' a
n = forall a. Show a => a -> String
show a
n forall a. [a] -> [a] -> [a]
++ String
" * "
    showSum :: [(Bool, String)] -> String
showSum []                = String
"0"
    showSum ((Bool
True , String
x) : [(Bool, String)]
xs) = String
x forall a. [a] -> [a] -> [a]
++ forall {t :: * -> *}. Foldable t => t (Bool, String) -> String
g [(Bool, String)]
xs
    showSum ((Bool
False, String
x) : [(Bool, String)]
xs) = String
"-" forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ forall {t :: * -> *}. Foldable t => t (Bool, String) -> String
g [(Bool, String)]
xs
    g :: t (Bool, String) -> String
g = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Bool
a, String
b) -> Bool -> String
f Bool
a forall a. [a] -> [a] -> [a]
++ String
b)
    f :: Bool -> String
f Bool
True  = String
" + "
    f Bool
False = String
" - "

instance IsSize s => Show (Operand a s) where
  show :: Operand a s -> String
show = \case
    ImmOp Immediate Int64
w       -> forall a. Show a => a -> String
show Immediate Int64
w
    RegOp Reg s
r       -> forall a. Show a => a -> String
show Reg s
r
    r :: Operand a s
r@(MemOp   Addr s'
a) -> forall a. Show a => a -> String
show (forall a. HasSize a => a -> Size
size Operand a s
r) forall a. [a] -> [a] -> [a]
++ String
" [" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Addr s'
a forall a. [a] -> [a] -> [a]
++ String
"]"
    r :: Operand a s
r@(IPMemOp Immediate Int32
x) -> forall a. Show a => a -> String
show (forall a. HasSize a => a -> Size
size Operand a s
r) forall a. [a] -> [a] -> [a]
++ String
" [" forall a. [a] -> [a] -> [a]
++ String
"rel " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Immediate Int32
x forall a. [a] -> [a] -> [a]
++ String
"]"
   where
    showp :: a -> String
showp a
x | a
x forall a. Ord a => a -> a -> Bool
< a
0 = String
" - " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (-a
x)
    showp a
x         = String
" + " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x

instance Show a => Show (Immediate a) where
  show :: Immediate a -> String
show (Immediate a
x) = forall a. Show a => a -> String
show a
x
  show (LabelRelValue Size
s Label
x) = forall a. Show a => a -> String
show Label
x

instance IsSize s => HasSize (Operand a s) where
  size :: Operand a s -> Size
size Operand a s
_ = forall a. HasSize a => a -> Size
size (forall (s :: Size). IsSize s => SSize s
ssize :: SSize s)

instance IsSize s => HasSize (Addr s) where
  size :: Addr s -> Size
size Addr s
_ = forall a. HasSize a => a -> Size
size (forall (s :: Size). IsSize s => SSize s
ssize :: SSize s)

instance IsSize s => HasSize (Address s) where
  size :: Address s -> Size
size Address s
_ = forall a. HasSize a => a -> Size
size (forall (s :: Size). IsSize s => SSize s
ssize :: SSize s)

instance IsSize s => HasSize (BaseReg s) where
  size :: BaseReg s -> Size
size BaseReg s
_ = forall a. HasSize a => a -> Size
size (forall (s :: Size). IsSize s => SSize s
ssize :: SSize s)

instance IsSize s => HasSize (Reg s) where
  size :: Reg s -> Size
size Reg s
_ = forall a. HasSize a => a -> Size
size (forall (s :: Size). IsSize s => SSize s
ssize :: SSize s)

instance IsSize s => HasSize (IndexReg s) where
  size :: IndexReg s -> Size
size IndexReg s
_ = forall a. HasSize a => a -> Size
size (forall (s :: Size). IsSize s => SSize s
ssize :: SSize s)

instance (rw ~ R) => Num (Operand rw s) where
  negate :: Operand rw s -> Operand rw s
negate (ImmOp (Immediate Int64
x)) = forall (s :: Size). Immediate Int64 -> Operand 'R s
ImmOp forall a b. (a -> b) -> a -> b
$ forall a. a -> Immediate a
Immediate forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
negate Int64
x
  fromInteger :: Integer -> Operand rw s
fromInteger (Integral Int64
x) = forall (s :: Size). Immediate Int64 -> Operand 'R s
ImmOp forall a b. (a -> b) -> a -> b
$ forall a. a -> Immediate a
Immediate Int64
x
  fromInteger Integer
z = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Integer
z forall a. [a] -> [a] -> [a]
++ String
" does not fit into " -- ++ show s
  + :: Operand rw s -> Operand rw s -> Operand rw s
(+) = forall a. HasCallStack => String -> a
error String
"(+) @Operand"
  (-) = forall a. HasCallStack => String -> a
error String
"(-) @Operand"
  * :: Operand rw s -> Operand rw s -> Operand rw s
(*) = forall a. HasCallStack => String -> a
error String
"(*) @Operand"
  abs :: Operand rw s -> Operand rw s
abs = forall a. HasCallStack => String -> a
error String
"abs @Operand"
  signum :: Operand rw s -> Operand rw s
signum = forall a. HasCallStack => String -> a
error String
"signum @Operand"

#if MIN_VERSION_base(4,11,0)
instance Semigroup (Addr s) where
  Addr BaseReg s
a Displacement
b IndexReg s
c <> :: Addr s -> Addr s -> Addr s
<> Addr BaseReg s
a' Displacement
b' IndexReg s
c' = forall (s :: Size).
BaseReg s -> Displacement -> IndexReg s -> Addr s
Addr (forall a. First a -> Maybe a
getFirst forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> First a
First BaseReg s
a forall a. Semigroup a => a -> a -> a
<> forall a. Maybe a -> First a
First BaseReg s
a') (forall a. First a -> Maybe a
getFirst forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> First a
First Displacement
b forall a. Semigroup a => a -> a -> a
<> forall a. Maybe a -> First a
First Displacement
b') (IndexReg s
c forall a. Semigroup a => a -> a -> a
<> IndexReg s
c')

instance Semigroup (IndexReg s) where
  IndexReg s
i <> :: IndexReg s -> IndexReg s -> IndexReg s
<> IndexReg s
NoIndex = IndexReg s
i
  IndexReg s
NoIndex <> IndexReg s
i = IndexReg s
i
#endif

instance Monoid (Addr s) where
  mempty :: Addr s
mempty = forall (s :: Size).
BaseReg s -> Displacement -> IndexReg s -> Addr s
Addr (forall a. First a -> Maybe a
getFirst forall a. Monoid a => a
mempty) (forall a. First a -> Maybe a
getFirst forall a. Monoid a => a
mempty) forall a. Monoid a => a
mempty

#if !MIN_VERSION_base(4,11,0)
  Addr a b c `mappend` Addr a' b' c' = Addr (getFirst $ First a <> First a') (getFirst $ First b <> First b') (c <> c')
#endif

instance Monoid (IndexReg s) where
  mempty :: IndexReg s
mempty = forall (s :: Size). IndexReg s
NoIndex

#if !MIN_VERSION_base(4,11,0)
  i `mappend` NoIndex = i
  NoIndex `mappend` i = i
#endif

base :: Reg s -> Addr s
base :: forall (s :: Size). Reg s -> Addr s
base Reg s
x = forall (s :: Size).
BaseReg s -> Displacement -> IndexReg s -> Addr s
Addr (forall a. a -> Maybe a
Just Reg s
x) forall a. Maybe a
NoDisp forall (s :: Size). IndexReg s
NoIndex

index :: Scale -> Reg s -> Addr s
index :: forall (s :: Size). Scale -> Reg s -> Addr s
index Scale
sc Reg s
x = forall (s :: Size).
BaseReg s -> Displacement -> IndexReg s -> Addr s
Addr forall a. Maybe a
Nothing forall a. Maybe a
NoDisp (forall (s :: Size). Scale -> Reg s -> IndexReg s
IndexReg Scale
sc Reg s
x)

index' :: Int -> Reg s -> Addr s
index' :: forall (s :: Size). Int -> Reg s -> Addr s
index' Int
sc Reg s
x = forall (s :: Size).
BaseReg s -> Displacement -> IndexReg s -> Addr s
Addr forall a. Maybe a
Nothing forall a. Maybe a
NoDisp (forall (s :: Size). Scale -> Reg s -> IndexReg s
IndexReg (forall {a}. (Eq a, Num a) => a -> Scale
toScale Int
sc) Reg s
x)

index1 :: Reg s -> Addr s
index1 = forall (s :: Size). Scale -> Reg s -> Addr s
index Scale
s1
index2 :: Reg s -> Addr s
index2 = forall (s :: Size). Scale -> Reg s -> Addr s
index Scale
s2
index4 :: Reg s -> Addr s
index4 = forall (s :: Size). Scale -> Reg s -> Addr s
index Scale
s4
index8 :: Reg s -> Addr s
index8 = forall (s :: Size). Scale -> Reg s -> Addr s
index Scale
s8

disp :: (Bits a, Integral a) => a -> Addr s
disp :: forall a (s :: Size). (Bits a, Integral a) => a -> Addr s
disp (Integral Int32
x)
  | Int32
x forall a. Eq a => a -> a -> Bool
== Int32
0 = forall a. Monoid a => a
mempty
  | Bool
otherwise = forall (s :: Size).
BaseReg s -> Displacement -> IndexReg s -> Addr s
Addr forall a. Maybe a
Nothing (forall a. a -> Maybe a
Disp Int32
x) forall (s :: Size). IndexReg s
NoIndex

data Address :: Size -> * where
  Address :: [(Int, Reg s)] -> Int -> Address s

scaleAddress :: (Int -> Int) -> Address s -> Address s
scaleAddress :: forall (s :: Size). (Int -> Int) -> Address s -> Address s
scaleAddress Int -> Int
f (Address [(Int, Reg s)]
rs Int
d) = forall (s :: Size). [(Int, Reg s)] -> Int -> Address s
Address (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Int -> Int
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Reg s)]
rs) forall a b. (a -> b) -> a -> b
$ Int -> Int
f Int
d

instance Num (Address s) where
  fromInteger :: Integer -> Address s
fromInteger Integer
d = forall (s :: Size). [(Int, Reg s)] -> Int -> Address s
Address [] forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
d
  negate :: Address s -> Address s
negate = forall (s :: Size). (Int -> Int) -> Address s -> Address s
scaleAddress forall a. Num a => a -> a
negate

  Address [] Int
t * :: Address s -> Address s -> Address s
* Address s
a            = forall (s :: Size). (Int -> Int) -> Address s -> Address s
scaleAddress (Int
t forall a. Num a => a -> a -> a
*) Address s
a
  Address s
a            * Address [] Int
t = forall (s :: Size). (Int -> Int) -> Address s -> Address s
scaleAddress (Int
t forall a. Num a => a -> a -> a
*) Address s
a

  Address [(Int, Reg s)]
rs Int
d + :: Address s -> Address s -> Address s
+ Address [(Int, Reg s)]
rs' Int
d' = forall (s :: Size). [(Int, Reg s)] -> Int -> Address s
Address (forall {a} {a}.
(Ord a, Num a, Eq a) =>
[(a, a)] -> [(a, a)] -> [(a, a)]
f [(Int, Reg s)]
rs [(Int, Reg s)]
rs') (Int
d forall a. Num a => a -> a -> a
+ Int
d')   where
    f :: [(a, a)] -> [(a, a)] -> [(a, a)]
f []              [(a, a)]
rs                  = [(a, a)]
rs
    f [(a, a)]
rs              []                  = [(a, a)]
rs
    f (p :: (a, a)
p@(a
t, a
r) : [(a, a)]
rs) (p' :: (a, a)
p'@(a
t', a
r') : [(a, a)]
rs') = case forall a. Ord a => a -> a -> Ordering
compare a
r a
r' of
      Ordering
LT -> (a, a)
p forall a. a -> [a] -> [a]
: [(a, a)] -> [(a, a)] -> [(a, a)]
f [(a, a)]
rs ((a, a)
p' forall a. a -> [a] -> [a]
: [(a, a)]
rs')
      Ordering
GT -> (a, a)
p' forall a. a -> [a] -> [a]
: [(a, a)] -> [(a, a)] -> [(a, a)]
f ((a, a)
p forall a. a -> [a] -> [a]
: [(a, a)]
rs) [(a, a)]
rs'
      Ordering
EQ | a
t forall a. Num a => a -> a -> a
+ a
t' forall a. Eq a => a -> a -> Bool
== a
0 -> [(a, a)] -> [(a, a)] -> [(a, a)]
f [(a, a)]
rs [(a, a)]
rs'
         | Bool
otherwise   -> (a
t forall a. Num a => a -> a -> a
+ a
t', a
r) forall a. a -> [a] -> [a]
: [(a, a)] -> [(a, a)] -> [(a, a)]
f [(a, a)]
rs [(a, a)]
rs'

  abs :: Address s -> Address s
abs    = forall a. HasCallStack => String -> a
error String
"abs @Address"
  signum :: Address s -> Address s
signum = forall a. HasCallStack => String -> a
error String
"signum @Address"

makeAddr :: Address s -> Addr s
makeAddr :: forall (s :: Size). Address s -> Addr s
makeAddr (Address [(Int
1, Reg s
r)] Int
d) = forall (s :: Size). Reg s -> Addr s
base Reg s
r forall a. Semigroup a => a -> a -> a
<> forall a (s :: Size). (Bits a, Integral a) => a -> Addr s
disp Int
d
makeAddr (Address [(Int
t, Reg s
r)] Int
d) = forall (s :: Size). Int -> Reg s -> Addr s
index' Int
t Reg s
r forall a. Semigroup a => a -> a -> a
<> forall a (s :: Size). (Bits a, Integral a) => a -> Addr s
disp Int
d
makeAddr (Address [(Int
1, Reg s
r), (Int
1, r' :: Reg s
r'@(NormalReg Word8
0x4))] Int
d) = forall (s :: Size). Reg s -> Addr s
base Reg s
r' forall a. Semigroup a => a -> a -> a
<> forall (s :: Size). Reg s -> Addr s
index1 Reg s
r forall a. Semigroup a => a -> a -> a
<> forall a (s :: Size). (Bits a, Integral a) => a -> Addr s
disp Int
d
makeAddr (Address [(Int
1, Reg s
r), (Int
t, Reg s
r')] Int
d) = forall (s :: Size). Reg s -> Addr s
base Reg s
r forall a. Semigroup a => a -> a -> a
<> forall (s :: Size). Int -> Reg s -> Addr s
index' Int
t Reg s
r' forall a. Semigroup a => a -> a -> a
<> forall a (s :: Size). (Bits a, Integral a) => a -> Addr s
disp Int
d
makeAddr (Address [(Int
t, Reg s
r'), (Int
1, Reg s
r)] Int
d) = forall (s :: Size). Reg s -> Addr s
base Reg s
r forall a. Semigroup a => a -> a -> a
<> forall (s :: Size). Int -> Reg s -> Addr s
index' Int
t Reg s
r' forall a. Semigroup a => a -> a -> a
<> forall a (s :: Size). (Bits a, Integral a) => a -> Addr s
disp Int
d

class FromReg c where
  fromReg :: Reg s -> c s

instance FromReg Reg where
  fromReg :: forall (s :: Size). Reg s -> Reg s
fromReg = forall a. a -> a
id

instance FromReg (Operand r) where
  fromReg :: forall (s :: Size). Reg s -> Operand r s
fromReg = forall (s :: Size) (rw :: Access). Reg s -> Operand rw s
RegOp

instance FromReg Address where
  fromReg :: forall (s :: Size). Reg s -> Address s
fromReg Reg s
r = forall (s :: Size). [(Int, Reg s)] -> Int -> Address s
Address [(Int
1, Reg s
r)] Int
0

reg :: Word8 -> c s
reg = forall (c :: Size -> *) (s :: Size). FromReg c => Reg s -> c s
fromReg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Size). Word8 -> Reg s
NormalReg

rax, rcx, rdx, rbx, rsp, rbp, rsi, rdi, r8, r9, r10, r11, r12, r13, r14, r15 :: FromReg c => c S64
rax :: forall (c :: Size -> *). FromReg c => c 'S64
rax  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x0
rcx :: forall (c :: Size -> *). FromReg c => c 'S64
rcx  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x1
rdx :: forall (c :: Size -> *). FromReg c => c 'S64
rdx  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x2
rbx :: forall (c :: Size -> *). FromReg c => c 'S64
rbx  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x3
rsp :: forall (c :: Size -> *). FromReg c => c 'S64
rsp  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x4
rbp :: forall (c :: Size -> *). FromReg c => c 'S64
rbp  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x5
rsi :: forall (c :: Size -> *). FromReg c => c 'S64
rsi  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x6
rdi :: forall (c :: Size -> *). FromReg c => c 'S64
rdi  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x7
r8 :: forall (c :: Size -> *). FromReg c => c 'S64
r8   = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x8
r9 :: forall (c :: Size -> *). FromReg c => c 'S64
r9   = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x9
r10 :: forall (c :: Size -> *). FromReg c => c 'S64
r10  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xa
r11 :: forall (c :: Size -> *). FromReg c => c 'S64
r11  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xb
r12 :: forall (c :: Size -> *). FromReg c => c 'S64
r12  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xc
r13 :: forall (c :: Size -> *). FromReg c => c 'S64
r13  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xd
r14 :: forall (c :: Size -> *). FromReg c => c 'S64
r14  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xe
r15 :: forall (c :: Size -> *). FromReg c => c 'S64
r15  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xf

eax, ecx, edx, ebx, esp, ebp, esi, edi, r8d, r9d, r10d, r11d, r12d, r13d, r14d, r15d :: FromReg c => c S32
eax :: forall (c :: Size -> *). FromReg c => c 'S32
eax  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x0
ecx :: forall (c :: Size -> *). FromReg c => c 'S32
ecx  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x1
edx :: forall (c :: Size -> *). FromReg c => c 'S32
edx  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x2
ebx :: forall (c :: Size -> *). FromReg c => c 'S32
ebx  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x3
esp :: forall (c :: Size -> *). FromReg c => c 'S32
esp  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x4
ebp :: forall (c :: Size -> *). FromReg c => c 'S32
ebp  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x5
esi :: forall (c :: Size -> *). FromReg c => c 'S32
esi  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x6
edi :: forall (c :: Size -> *). FromReg c => c 'S32
edi  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x7
r8d :: forall (c :: Size -> *). FromReg c => c 'S32
r8d  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x8
r9d :: forall (c :: Size -> *). FromReg c => c 'S32
r9d  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x9
r10d :: forall (c :: Size -> *). FromReg c => c 'S32
r10d = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xa
r11d :: forall (c :: Size -> *). FromReg c => c 'S32
r11d = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xb
r12d :: forall (c :: Size -> *). FromReg c => c 'S32
r12d = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xc
r13d :: forall (c :: Size -> *). FromReg c => c 'S32
r13d = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xd
r14d :: forall (c :: Size -> *). FromReg c => c 'S32
r14d = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xe
r15d :: forall (c :: Size -> *). FromReg c => c 'S32
r15d = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xf

ax, cx, dx, bx, sp, bp, si, di, r8w, r9w, r10w, r11w, r12w, r13w, r14w, r15w :: FromReg c => c S16
ax :: forall (c :: Size -> *). FromReg c => c 'S16
ax   = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x0
cx :: forall (c :: Size -> *). FromReg c => c 'S16
cx   = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x1
dx :: forall (c :: Size -> *). FromReg c => c 'S16
dx   = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x2
bx :: forall (c :: Size -> *). FromReg c => c 'S16
bx   = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x3
sp :: forall (c :: Size -> *). FromReg c => c 'S16
sp   = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x4
bp :: forall (c :: Size -> *). FromReg c => c 'S16
bp   = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x5
si :: forall (c :: Size -> *). FromReg c => c 'S16
si   = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x6
di :: forall (c :: Size -> *). FromReg c => c 'S16
di   = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x7
r8w :: forall (c :: Size -> *). FromReg c => c 'S16
r8w  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x8
r9w :: forall (c :: Size -> *). FromReg c => c 'S16
r9w  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x9
r10w :: forall (c :: Size -> *). FromReg c => c 'S16
r10w = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xa
r11w :: forall (c :: Size -> *). FromReg c => c 'S16
r11w = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xb
r12w :: forall (c :: Size -> *). FromReg c => c 'S16
r12w = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xc
r13w :: forall (c :: Size -> *). FromReg c => c 'S16
r13w = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xd
r14w :: forall (c :: Size -> *). FromReg c => c 'S16
r14w = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xe
r15w :: forall (c :: Size -> *). FromReg c => c 'S16
r15w = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xf

al, cl, dl, bl, spl, bpl, sil, dil, r8b, r9b, r10b, r11b, r12b, r13b, r14b, r15b :: FromReg c => c S8
al :: forall (c :: Size -> *). FromReg c => c 'S8
al   = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x0
cl :: forall (c :: Size -> *). FromReg c => c 'S8
cl   = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x1
dl :: forall (c :: Size -> *). FromReg c => c 'S8
dl   = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x2
bl :: forall (c :: Size -> *). FromReg c => c 'S8
bl   = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x3
spl :: forall (c :: Size -> *). FromReg c => c 'S8
spl  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x4
bpl :: forall (c :: Size -> *). FromReg c => c 'S8
bpl  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x5
sil :: forall (c :: Size -> *). FromReg c => c 'S8
sil  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x6
dil :: forall (c :: Size -> *). FromReg c => c 'S8
dil  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x7
r8b :: forall (c :: Size -> *). FromReg c => c 'S8
r8b  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x8
r9b :: forall (c :: Size -> *). FromReg c => c 'S8
r9b  = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0x9
r10b :: forall (c :: Size -> *). FromReg c => c 'S8
r10b = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xa
r11b :: forall (c :: Size -> *). FromReg c => c 'S8
r11b = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xb
r12b :: forall (c :: Size -> *). FromReg c => c 'S8
r12b = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xc
r13b :: forall (c :: Size -> *). FromReg c => c 'S8
r13b = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xd
r14b :: forall (c :: Size -> *). FromReg c => c 'S8
r14b = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xe
r15b :: forall (c :: Size -> *). FromReg c => c 'S8
r15b = forall {c :: Size -> *} {s :: Size}. FromReg c => Word8 -> c s
reg Word8
0xf

ah, ch, dh, bh :: FromReg c => c S8
ah :: forall (c :: Size -> *). FromReg c => c 'S8
ah   = forall (c :: Size -> *) (s :: Size). FromReg c => Reg s -> c s
fromReg forall a b. (a -> b) -> a -> b
$ Word8 -> Reg 'S8
HighReg Word8
0x0
ch :: forall (c :: Size -> *). FromReg c => c 'S8
ch   = forall (c :: Size -> *) (s :: Size). FromReg c => Reg s -> c s
fromReg forall a b. (a -> b) -> a -> b
$ Word8 -> Reg 'S8
HighReg Word8
0x1
dh :: forall (c :: Size -> *). FromReg c => c 'S8
dh   = forall (c :: Size -> *) (s :: Size). FromReg c => Reg s -> c s
fromReg forall a b. (a -> b) -> a -> b
$ Word8 -> Reg 'S8
HighReg Word8
0x2
bh :: forall (c :: Size -> *). FromReg c => c 'S8
bh   = forall (c :: Size -> *) (s :: Size). FromReg c => Reg s -> c s
fromReg forall a b. (a -> b) -> a -> b
$ Word8 -> Reg 'S8
HighReg Word8
0x3

xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7 :: FromReg c => c S128
xmm0 :: forall (c :: Size -> *). FromReg c => c 'S128
xmm0 = forall (c :: Size -> *) (s :: Size). FromReg c => Reg s -> c s
fromReg forall a b. (a -> b) -> a -> b
$ Word8 -> Reg 'S128
XMM Word8
0x0
xmm1 :: forall (c :: Size -> *). FromReg c => c 'S128
xmm1 = forall (c :: Size -> *) (s :: Size). FromReg c => Reg s -> c s
fromReg forall a b. (a -> b) -> a -> b
$ Word8 -> Reg 'S128
XMM Word8
0x1
xmm2 :: forall (c :: Size -> *). FromReg c => c 'S128
xmm2 = forall (c :: Size -> *) (s :: Size). FromReg c => Reg s -> c s
fromReg forall a b. (a -> b) -> a -> b
$ Word8 -> Reg 'S128
XMM Word8
0x2
xmm3 :: forall (c :: Size -> *). FromReg c => c 'S128
xmm3 = forall (c :: Size -> *) (s :: Size). FromReg c => Reg s -> c s
fromReg forall a b. (a -> b) -> a -> b
$ Word8 -> Reg 'S128
XMM Word8
0x3
xmm4 :: forall (c :: Size -> *). FromReg c => c 'S128
xmm4 = forall (c :: Size -> *) (s :: Size). FromReg c => Reg s -> c s
fromReg forall a b. (a -> b) -> a -> b
$ Word8 -> Reg 'S128
XMM Word8
0x4
xmm5 :: forall (c :: Size -> *). FromReg c => c 'S128
xmm5 = forall (c :: Size -> *) (s :: Size). FromReg c => Reg s -> c s
fromReg forall a b. (a -> b) -> a -> b
$ Word8 -> Reg 'S128
XMM Word8
0x5
xmm6 :: forall (c :: Size -> *). FromReg c => c 'S128
xmm6 = forall (c :: Size -> *) (s :: Size). FromReg c => Reg s -> c s
fromReg forall a b. (a -> b) -> a -> b
$ Word8 -> Reg 'S128
XMM Word8
0x6
xmm7 :: forall (c :: Size -> *). FromReg c => c 'S128
xmm7 = forall (c :: Size -> *) (s :: Size). FromReg c => Reg s -> c s
fromReg forall a b. (a -> b) -> a -> b
$ Word8 -> Reg 'S128
XMM Word8
0x7

pattern $bRegA :: forall {a :: Access} {b :: Size}. Operand a b
$mRegA :: forall {r} {a :: Access} {b :: Size}.
Operand a b -> ((# #) -> r) -> ((# #) -> r) -> r
RegA = RegOp (NormalReg 0x0)

pattern RegCl :: Operand r S8
pattern $bRegCl :: forall (r :: Access). Operand r 'S8
$mRegCl :: forall {r} {r :: Access}.
Operand r 'S8 -> ((# #) -> r) -> ((# #) -> r) -> r
RegCl = RegOp (NormalReg 0x1)

--------------------------------------------------------------

resizeOperand :: IsSize s' => Operand RW s -> Operand RW s'
resizeOperand :: forall (s' :: Size) (s :: Size).
IsSize s' =>
Operand 'RW s -> Operand 'RW s'
resizeOperand (RegOp Reg s
x) = forall (s :: Size) (rw :: Access). Reg s -> Operand rw s
RegOp forall a b. (a -> b) -> a -> b
$ forall (s :: Size) (s' :: Size). Reg s -> Reg s'
resizeRegCode Reg s
x
resizeOperand (MemOp Addr s'
a) = forall (s' :: Size) (rw :: Access) (s :: Size).
IsSize s' =>
Addr s' -> Operand rw s
MemOp Addr s'
a
resizeOperand (IPMemOp Immediate Int32
a) = forall (rw :: Access) (s :: Size). Immediate Int32 -> Operand rw s
IPMemOp Immediate Int32
a

resizeRegCode :: Reg s -> Reg s'
resizeRegCode :: forall (s :: Size) (s' :: Size). Reg s -> Reg s'
resizeRegCode (NormalReg Word8
i) = forall (s :: Size). Word8 -> Reg s
NormalReg Word8
i

pattern $mMemLike :: forall {r} {a :: Access} {b :: Size}.
Operand a b -> ((# #) -> r) -> ((# #) -> r) -> r
MemLike <- (isMemOp -> True)

isMemOp :: Operand a b -> Bool
isMemOp MemOp{} = Bool
True
isMemOp IPMemOp{} = Bool
True
isMemOp Operand a b
_ = Bool
False

-------------------------------------------------------------- condition

newtype Condition = Condition Word8

pattern $bO :: Condition
$mO :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
O   = Condition 0x0
pattern $bNO :: Condition
$mNO :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
NO  = Condition 0x1
pattern $bB :: Condition
$mB :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
B   = Condition 0x2
pattern $bC :: Condition
$mC :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
C   = Condition 0x2
pattern $bNB :: Condition
$mNB :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
NB  = Condition 0x3
pattern $bNC :: Condition
$mNC :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
NC  = Condition 0x3
pattern $bE :: Condition
$mE :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
E   = Condition 0x4
pattern $bZ :: Condition
$mZ :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
Z   = Condition 0x4
pattern $bNE :: Condition
$mNE :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
NE  = Condition 0x5
pattern $bNZ :: Condition
$mNZ :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
NZ  = Condition 0x5
pattern $bNA :: Condition
$mNA :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
NA  = Condition 0x6
pattern $bBE :: Condition
$mBE :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
BE  = Condition 0x6
pattern $bA :: Condition
$mA :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
A   = Condition 0x7
pattern $bNBE :: Condition
$mNBE :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
NBE = Condition 0x7
pattern $bS :: Condition
$mS :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
S   = Condition 0x8
pattern $bNS :: Condition
$mNS :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
NS  = Condition 0x9
pattern $bP :: Condition
$mP :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
P   = Condition 0xa
pattern $bNP :: Condition
$mNP :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
NP  = Condition 0xb
pattern $bL :: Condition
$mL :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
L   = Condition 0xc
pattern $bNL :: Condition
$mNL :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
NL  = Condition 0xd
pattern $bNG :: Condition
$mNG :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
NG  = Condition 0xe
pattern $bLE :: Condition
$mLE :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
LE  = Condition 0xe
pattern $bG :: Condition
$mG :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
G   = Condition 0xf
pattern $bNLE :: Condition
$mNLE :: forall {r}. Condition -> ((# #) -> r) -> ((# #) -> r) -> r
NLE = Condition 0xf

instance Show Condition where
  show :: Condition -> String
show (Condition Word8
x) = case Word8
x of
    Word8
0x0 -> String
"o"
    Word8
0x1 -> String
"no"
    Word8
0x2 -> String
"c"
    Word8
0x3 -> String
"nc"
    Word8
0x4 -> String
"z"
    Word8
0x5 -> String
"nz"
    Word8
0x6 -> String
"be"
    Word8
0x7 -> String
"nbe"
    Word8
0x8 -> String
"s"
    Word8
0x9 -> String
"ns"
    Word8
0xa -> String
"p"
    Word8
0xb -> String
"np"
    Word8
0xc -> String
"l"
    Word8
0xd -> String
"nl"
    Word8
0xe -> String
"le"
    Word8
0xf -> String
"nle"

pattern $bN :: Condition -> Condition
$mN :: forall {r}. Condition -> (Condition -> r) -> ((# #) -> r) -> r
N cc <- (notCond -> cc)
  where N = Condition -> Condition
notCond

notCond :: Condition -> Condition
notCond :: Condition -> Condition
notCond (Condition Word8
c) = Word8 -> Condition
Condition forall a b. (a -> b) -> a -> b
$ Word8
c forall a. Bits a => a -> a -> a
`xor` Word8
1

-------------------------------------------------------------- asm code lines

{- HLINT ignore -}
data CodeLine where
  Ret_, Nop_, PushF_, PopF_, Cmc_, Clc_, Stc_, Cli_, Sti_, Cld_, Std_ :: CodeLine

  Inc_, Dec_, Not_, Neg_, Bswap                               :: IsSize s => Operand RW s -> CodeLine
  Add_, Or_, Adc_, Sbb_, And_, Sub_, Xor_, Cmp_, Test_, Mov_, Bsf, Bsr :: IsSize s => Operand RW s -> Operand r s -> CodeLine
  Rol_, Ror_, Rcl_, Rcr_, Shl_, Shr_, Sar_                 :: IsSize s => Operand RW s -> Operand r S8 -> CodeLine
  Bt :: IsSize s => Operand r s -> Operand RW s -> CodeLine

  Movdqa_, Paddb_, Paddw_, Paddd_, Paddq_, Psubb_, Psubw_, Psubd_, Psubq_, Pxor_ :: Operand RW S128 -> Operand r S128 -> CodeLine
  Psllw_, Pslld_, Psllq_, Pslldq_, Psrlw_, Psrld_, Psrlq_, Psrldq_, Psraw_, Psrad_ :: Operand RW S128 -> Operand r S8 -> CodeLine
  Movd_, Movq_ :: (IsSize s, IsSize s') => Operand RW s -> Operand r s' -> CodeLine

  Cmov_ :: IsSize s => Condition -> Operand RW s -> Operand RW s -> CodeLine
  Xchg_ :: IsSize s => Operand RW s -> Operand RW s -> CodeLine
  Lea_  :: (IsSize s, IsSize s') => Operand RW s -> Operand RW s' -> CodeLine

  Pop_  :: Operand RW S64 -> CodeLine
  Push_ :: Operand r  S64 -> CodeLine

  Call_ :: Operand r S64 -> CodeLine
  Jmpq_ :: Operand r S64 -> CodeLine

  J_    :: Condition -> Maybe Size -> Label -> CodeLine
  Jmp_  :: Maybe Size -> Label -> CodeLine

  Label_ :: CodeLine

  Data_  :: Bytes -> CodeLine
  Align_ :: Int   -> CodeLine

------------------------- show code lines

newLabel :: m Label
newLabel = do
  Int
i <- forall (m :: * -> *). MonadState m => m (StateType m)
get
  forall (m :: * -> *). MonadState m => StateType m -> m ()
put forall a b. (a -> b) -> a -> b
$ Int
i forall a. Num a => a -> a -> a
+ Int
1
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Label
Label Int
i

codeLine :: a -> m ()
codeLine a
x = forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell [a
x]

showOp0 :: a -> m ()
showOp0 a
s = forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
codeLine a
s
showOp :: String -> String -> m ()
showOp String
s String
a = forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
showOp0 forall a b. (a -> b) -> a -> b
$ String
s forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
a
showOp1 :: String -> a -> m ()
showOp1 String
s a
a = forall {m :: * -> *}.
(WriterType m ~ [String], MonadWriter m) =>
String -> String -> m ()
showOp String
s forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
a
showOp2 :: String -> a -> a -> m ()
showOp2 String
s a
a a
b = forall {m :: * -> *}.
(WriterType m ~ [String], MonadWriter m) =>
String -> String -> m ()
showOp String
s forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
a forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
b

showCodeLine :: CodeLine -> StateT Int (Writer [String]) ()
showCodeLine :: CodeLine -> StateT Int (Writer [String]) ()
showCodeLine = \case
  Add_  Operand 'RW s
op1 Operand r s
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"add"  Operand 'RW s
op1 Operand r s
op2
  Or_   Operand 'RW s
op1 Operand r s
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"or"   Operand 'RW s
op1 Operand r s
op2
  Adc_  Operand 'RW s
op1 Operand r s
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"adc"  Operand 'RW s
op1 Operand r s
op2
  Sbb_  Operand 'RW s
op1 Operand r s
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"sbb"  Operand 'RW s
op1 Operand r s
op2
  And_  Operand 'RW s
op1 Operand r s
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"and"  Operand 'RW s
op1 Operand r s
op2
  Sub_  Operand 'RW s
op1 Operand r s
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"sub"  Operand 'RW s
op1 Operand r s
op2
  Xor_  Operand 'RW s
op1 Operand r s
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"xor"  Operand 'RW s
op1 Operand r s
op2
  Cmp_  Operand 'RW s
op1 Operand r s
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"cmp"  Operand 'RW s
op1 Operand r s
op2
  Test_ Operand 'RW s
op1 Operand r s
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"test" Operand 'RW s
op1 Operand r s
op2
  Bsf   Operand 'RW s
op1 Operand r s
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"bsf"  Operand 'RW s
op1 Operand r s
op2
  Bsr   Operand 'RW s
op1 Operand r s
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"bsr"  Operand 'RW s
op1 Operand r s
op2
  Bt    Operand r s
op1 Operand 'RW s
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"bt"   Operand r s
op1 Operand 'RW s
op2
  Rol_  Operand 'RW s
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"rol"  Operand 'RW s
op1 Operand r 'S8
op2
  Ror_  Operand 'RW s
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"ror"  Operand 'RW s
op1 Operand r 'S8
op2
  Rcl_  Operand 'RW s
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"rcl"  Operand 'RW s
op1 Operand r 'S8
op2
  Rcr_  Operand 'RW s
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"rcr"  Operand 'RW s
op1 Operand r 'S8
op2
  Shl_  Operand 'RW s
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"shl"  Operand 'RW s
op1 Operand r 'S8
op2
  Shr_  Operand 'RW s
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"shr"  Operand 'RW s
op1 Operand r 'S8
op2
  Sar_  Operand 'RW s
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"sar"  Operand 'RW s
op1 Operand r 'S8
op2
  Mov_  Operand 'RW s
op1 Operand r s
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"mov"  Operand 'RW s
op1 Operand r s
op2
  Cmov_ Condition
cc Operand 'RW s
op1 Operand 'RW s
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 (String
"cmov" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Condition
cc) Operand 'RW s
op1 Operand 'RW s
op2
  Lea_  Operand 'RW s
op1 Operand 'RW s'
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"lea"  Operand 'RW s
op1 Operand 'RW s'
op2
  Xchg_ Operand 'RW s
op1 Operand 'RW s
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"xchg" Operand 'RW s
op1 Operand 'RW s
op2
  Movd_   Operand 'RW s
op1 Operand r s'
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"movd"   Operand 'RW s
op1 Operand r s'
op2
  Movq_   Operand 'RW s
op1 Operand r s'
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"movq"   Operand 'RW s
op1 Operand r s'
op2
  Movdqa_ Operand 'RW 'S128
op1 Operand r 'S128
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"movdqa" Operand 'RW 'S128
op1 Operand r 'S128
op2
  Paddb_  Operand 'RW 'S128
op1 Operand r 'S128
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"paddb"  Operand 'RW 'S128
op1 Operand r 'S128
op2
  Paddw_  Operand 'RW 'S128
op1 Operand r 'S128
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"paddw"  Operand 'RW 'S128
op1 Operand r 'S128
op2
  Paddd_  Operand 'RW 'S128
op1 Operand r 'S128
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"paddd"  Operand 'RW 'S128
op1 Operand r 'S128
op2
  Paddq_  Operand 'RW 'S128
op1 Operand r 'S128
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"paddq"  Operand 'RW 'S128
op1 Operand r 'S128
op2
  Psubb_  Operand 'RW 'S128
op1 Operand r 'S128
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"psubb"  Operand 'RW 'S128
op1 Operand r 'S128
op2
  Psubw_  Operand 'RW 'S128
op1 Operand r 'S128
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"psubw"  Operand 'RW 'S128
op1 Operand r 'S128
op2
  Psubd_  Operand 'RW 'S128
op1 Operand r 'S128
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"psubd"  Operand 'RW 'S128
op1 Operand r 'S128
op2
  Psubq_  Operand 'RW 'S128
op1 Operand r 'S128
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"psubq"  Operand 'RW 'S128
op1 Operand r 'S128
op2
  Pxor_   Operand 'RW 'S128
op1 Operand r 'S128
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"pxor"   Operand 'RW 'S128
op1 Operand r 'S128
op2
  Psllw_  Operand 'RW 'S128
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"psllw"  Operand 'RW 'S128
op1 Operand r 'S8
op2
  Pslld_  Operand 'RW 'S128
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"pslld"  Operand 'RW 'S128
op1 Operand r 'S8
op2
  Psllq_  Operand 'RW 'S128
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"psllq"  Operand 'RW 'S128
op1 Operand r 'S8
op2
  Pslldq_ Operand 'RW 'S128
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"pslldq" Operand 'RW 'S128
op1 Operand r 'S8
op2
  Psrlw_  Operand 'RW 'S128
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"psrlw"  Operand 'RW 'S128
op1 Operand r 'S8
op2
  Psrld_  Operand 'RW 'S128
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"psrld"  Operand 'RW 'S128
op1 Operand r 'S8
op2
  Psrlq_  Operand 'RW 'S128
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"psrlq"  Operand 'RW 'S128
op1 Operand r 'S8
op2
  Psrldq_ Operand 'RW 'S128
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"psrldq" Operand 'RW 'S128
op1 Operand r 'S8
op2
  Psraw_  Operand 'RW 'S128
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"psraw"  Operand 'RW 'S128
op1 Operand r 'S8
op2
  Psrad_  Operand 'RW 'S128
op1 Operand r 'S8
op2 -> forall {m :: * -> *} {a} {a}.
(WriterType m ~ [String], MonadWriter m, Show a, Show a) =>
String -> a -> a -> m ()
showOp2 String
"psrad"  Operand 'RW 'S128
op1 Operand r 'S8
op2
  Inc_  Operand 'RW s
op -> forall {m :: * -> *} {a}.
(WriterType m ~ [String], MonadWriter m, Show a) =>
String -> a -> m ()
showOp1 String
"inc"  Operand 'RW s
op
  Dec_  Operand 'RW s
op -> forall {m :: * -> *} {a}.
(WriterType m ~ [String], MonadWriter m, Show a) =>
String -> a -> m ()
showOp1 String
"dec"  Operand 'RW s
op
  Not_  Operand 'RW s
op -> forall {m :: * -> *} {a}.
(WriterType m ~ [String], MonadWriter m, Show a) =>
String -> a -> m ()
showOp1 String
"not"  Operand 'RW s
op
  Neg_  Operand 'RW s
op -> forall {m :: * -> *} {a}.
(WriterType m ~ [String], MonadWriter m, Show a) =>
String -> a -> m ()
showOp1 String
"neg"  Operand 'RW s
op
  Bswap Operand 'RW s
op -> forall {m :: * -> *} {a}.
(WriterType m ~ [String], MonadWriter m, Show a) =>
String -> a -> m ()
showOp1 String
"bswap" Operand 'RW s
op
  Pop_  Operand 'RW 'S64
op -> forall {m :: * -> *} {a}.
(WriterType m ~ [String], MonadWriter m, Show a) =>
String -> a -> m ()
showOp1 String
"pop"  Operand 'RW 'S64
op
  Push_ Operand r 'S64
op -> forall {m :: * -> *} {a}.
(WriterType m ~ [String], MonadWriter m, Show a) =>
String -> a -> m ()
showOp1 String
"push" Operand r 'S64
op
  Call_ Operand r 'S64
op -> forall {m :: * -> *} {a}.
(WriterType m ~ [String], MonadWriter m, Show a) =>
String -> a -> m ()
showOp1 String
"call" Operand r 'S64
op
  Jmpq_ Operand r 'S64
op -> forall {m :: * -> *} {a}.
(WriterType m ~ [String], MonadWriter m, Show a) =>
String -> a -> m ()
showOp1 String
"jmp"  Operand r 'S64
op
  CodeLine
Ret_   -> forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
showOp0 String
"ret"
  CodeLine
Nop_   -> forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
showOp0 String
"nop"
  CodeLine
PushF_ -> forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
showOp0 String
"pushf"
  CodeLine
PopF_  -> forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
showOp0 String
"popf"
  CodeLine
Cmc_   -> forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
showOp0 String
"cmc"
  CodeLine
Clc_   -> forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
showOp0 String
"clc"
  CodeLine
Stc_   -> forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
showOp0 String
"stc"
  CodeLine
Cli_   -> forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
showOp0 String
"cli"
  CodeLine
Sti_   -> forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
showOp0 String
"sti"
  CodeLine
Cld_   -> forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
showOp0 String
"cld"
  CodeLine
Std_   -> forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
showOp0 String
"std"

  Align_ Int
s -> forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
codeLine forall a b. (a -> b) -> a -> b
$ String
".align " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
s
  Data_ Bytes
x
      | Int
2 forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. (Ord a, Num a) => a -> Bool
isPrint Bytes
x) forall a. Ord a => a -> a -> Bool
> forall (t :: * -> *) a. Foldable t => t a -> Int
length Bytes
x -> forall {m :: * -> *}.
(WriterType m ~ [String], MonadWriter m) =>
String -> String -> m ()
showOp String
"db" forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bytes
x :: String)
      | Bool
otherwise -> forall {m :: * -> *}.
(WriterType m ~ [String], MonadWriter m) =>
String -> String -> m ()
showOp String
"db" forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bytes
x)
    where
      isPrint :: a -> Bool
isPrint a
c = a
c forall a. Ord a => a -> a -> Bool
>= a
32 Bool -> Bool -> Bool
&& a
c forall a. Ord a => a -> a -> Bool
<= a
126

  J_ Condition
cc Maybe Size
s Label
l -> forall {m :: * -> *}.
(WriterType m ~ [String], MonadWriter m) =>
String -> String -> m ()
showOp (String
"j" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Condition
cc) forall a b. (a -> b) -> a -> b
$ (case Maybe Size
s of Just Size
S8 -> String
"short "; Just Size
S32 -> String
"near "; Maybe Size
_ -> String
"") forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Label
l
  Jmp_ Maybe Size
s  Label
l -> forall {m :: * -> *}.
(WriterType m ~ [String], MonadWriter m) =>
String -> String -> m ()
showOp String
"jmp" forall a b. (a -> b) -> a -> b
$ (case Maybe Size
s of Just Size
S8 -> String
"short "; Just Size
S32 -> String
"near "; Maybe Size
_ -> String
"") forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Label
l
  CodeLine
Label_    -> forall {m :: * -> *}. (StateType m ~ Int, MonadState m) => m Label
newLabel forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
codeLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show