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

import Numeric
import Data.Maybe
import Data.Monoid
import qualified Data.Vector.Unboxed as V
import Data.Bits
import Data.Int
import Data.Word
import Control.Arrow
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.Tardis
import Debug.Trace

import CodeGen.X86.Asm

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

takes :: [Int] -> [a] -> [[a]]
takes [] [a]
_ = []
takes (Int
i: [Int]
is) [a]
xs = forall a. Int -> [a] -> [a]
take Int
i [a]
xsforall a. a -> [a] -> [a]
: [Int] -> [a] -> [[a]]
takes [Int]
is (forall a. Int -> [a] -> [a]
drop Int
i [a]
xs)

iff :: Bool -> p -> p
iff Bool
b p
a = if Bool
b then p
a else forall a. Monoid a => a
mempty

indicator :: Integral a => Bool -> a
indicator :: forall a. Integral a => Bool -> a
indicator Bool
False = a
0x0
indicator Bool
True  = a
0x1

pattern $bFJust :: forall {a}. a -> First a
$mFJust :: forall {r} {a}. First a -> (a -> r) -> ((# #) -> r) -> r
FJust a = First (Just a)
pattern $bFNothing :: forall {a}. First a
$mFNothing :: forall {r} {a}. First a -> ((# #) -> r) -> ((# #) -> r) -> r
FNothing = First Nothing

integralToBytes :: (Bits a, Integral a) => Bool{-signed-} -> Size -> a -> Maybe Bytes
integralToBytes :: forall a.
(Bits a, Integral a) =>
Bool -> Size -> a -> Maybe [Word8]
integralToBytes Bool
False Size
S64 a
w = forall a. HasBytes a => a -> [Word8]
toBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized a
w :: Maybe Word64)
integralToBytes Bool
False Size
S32 a
w = forall a. HasBytes a => a -> [Word8]
toBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized a
w :: Maybe Word32)
integralToBytes Bool
False Size
S16 a
w = forall a. HasBytes a => a -> [Word8]
toBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized a
w :: Maybe Word16)
integralToBytes Bool
False Size
S8  a
w = forall a. HasBytes a => a -> [Word8]
toBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized a
w :: Maybe Word8)
integralToBytes Bool
True  Size
S64 a
w = forall a. HasBytes a => a -> [Word8]
toBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized a
w :: Maybe Int64)
integralToBytes Bool
True  Size
S32 a
w = forall a. HasBytes a => a -> [Word8]
toBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized a
w :: Maybe Int32)
integralToBytes Bool
True  Size
S16 a
w = forall a. HasBytes a => a -> [Word8]
toBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized a
w :: Maybe Int16)
integralToBytes Bool
True  Size
S8  a
w = forall a. HasBytes a => a -> [Word8]
toBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized a
w :: Maybe Int8)

------------------------------------------------------- register packed with its size

data SReg where
  SReg :: IsSize s => Reg s -> SReg

phisicalReg :: SReg -> Reg S64
phisicalReg :: SReg -> Reg 'S64
phisicalReg (SReg (HighReg Word8
x)) = forall (s :: Size). Word8 -> Reg s
NormalReg Word8
x
phisicalReg (SReg (NormalReg Word8
x)) = forall (s :: Size). Word8 -> Reg s
NormalReg Word8
x

isHigh :: SReg -> Bool
isHigh (SReg HighReg{}) = Bool
True
isHigh SReg
_ = Bool
False

regs :: IsSize s => Operand r s -> [SReg]
regs :: forall (s :: Size) (r :: Access). IsSize s => Operand r s -> [SReg]
regs = \case
  MemOp (Addr BaseReg s'
r Displacement
_ IndexReg s'
i) -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Size). IsSize r => Reg r -> SReg
SReg) BaseReg s'
r forall a. [a] -> [a] -> [a]
++ case IndexReg s'
i of IndexReg s'
NoIndex -> []; IndexReg Scale
_ Reg s'
x -> [forall (r :: Size). IsSize r => Reg r -> SReg
SReg Reg s'
x]
  RegOp Reg s
r -> [forall (r :: Size). IsSize r => Reg r -> SReg
SReg Reg s
r]
  Operand r s
_ -> forall a. Monoid a => a
mempty

isRex :: SReg -> Bool
isRex (SReg x :: Reg s
x@(NormalReg Word8
r)) = Word8
r forall a. Bits a => a -> a -> a
.&. Word8
0x8 forall a. Eq a => a -> a -> Bool
/= Word8
0 Bool -> Bool -> Bool
|| forall a. HasSize a => a -> Size
size Reg s
x forall a. Eq a => a -> a -> Bool
== Size
S8 Bool -> Bool -> Bool
&& Word8
r forall a. Bits a => a -> Int -> a
`shiftR` Int
2 forall a. Eq a => a -> a -> Bool
== Word8
1
isRex SReg
_ = Bool
False

noHighRex :: t SReg -> Bool
noHighRex t SReg
r = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any SReg -> Bool
isHigh t SReg
r Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any SReg -> Bool
isRex t SReg
r

no64 :: Size -> Size
no64 Size
S64 = Size
S32
no64 Size
s = Size
s

------------------------------------------------------- code builder

type CodeBuilderRes = [Either Int (Int, Word8)]

type CodeBuilderTardis = Tardis (Int, [Int]) (Int, [Int], LabelState)

data CodeBuilder = CodeBuilder
  { CodeBuilder -> Int
minLen, CodeBuilder -> Int
maxLen :: Int
  , CodeBuilder -> WriterT CodeBuilderRes CodeBuilderTardis ()
getCodeBuilder :: WriterT CodeBuilderRes CodeBuilderTardis ()
  }

codeBuilderLength :: CodeBuilder -> Int
codeBuilderLength (CodeBuilder Int
a Int
b WriterT CodeBuilderRes CodeBuilderTardis ()
_) | Int
a forall a. Eq a => a -> a -> Bool
== Int
b = Int
a

type LabelState = [[(Size, Int, Int)]]

#if MIN_VERSION_base(4,11,0)
instance Semigroup CodeBuilder where
  CodeBuilder Int
mi Int
ma WriterT CodeBuilderRes CodeBuilderTardis ()
a <> :: CodeBuilder -> CodeBuilder -> CodeBuilder
<> CodeBuilder Int
mi' Int
ma' WriterT CodeBuilderRes CodeBuilderTardis ()
b = Int
-> Int
-> WriterT CodeBuilderRes CodeBuilderTardis ()
-> CodeBuilder
CodeBuilder (forall a. Ord a => a -> a -> a
min Int
mi Int
mi') (forall a. Ord a => a -> a -> a
max Int
ma Int
ma') forall a b. (a -> b) -> a -> b
$ WriterT CodeBuilderRes CodeBuilderTardis ()
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterT CodeBuilderRes CodeBuilderTardis ()
b
#endif

instance Monoid CodeBuilder where
  mempty :: CodeBuilder
mempty = Int
-> Int
-> WriterT CodeBuilderRes CodeBuilderTardis ()
-> CodeBuilder
CodeBuilder Int
0 Int
0 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if !MIN_VERSION_base(4,11,0)
  CodeBuilder mi ma a `mappend` CodeBuilder mi' ma' b = CodeBuilder (min mi mi') (max ma ma') $ a >> b
#endif

codeBytes :: [Word8] -> CodeBuilder
codeBytes :: [Word8] -> CodeBuilder
codeBytes [Word8]
bs = Int
-> Int
-> WriterT CodeBuilderRes CodeBuilderTardis ()
-> CodeBuilder
CodeBuilder Int
n Int
n forall a b. (a -> b) -> a -> b
$ do
  Int
c <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ mdo
    (Int
c, [Int]
ls, [[(Size, Int, Int)]]
ps) <- forall bw fw (m :: * -> *). MonadTardis bw fw m => m fw
getPast
    forall bw fw (m :: * -> *). MonadTardis bw fw m => fw -> m ()
sendFuture (Int
c forall a. Num a => a -> a -> a
+ Int
n, [Int]
ls, [[(Size, Int, Int)]]
ps)
    forall bw fw (m :: * -> *). MonadTardis bw fw m => bw -> m ()
sendPast (Int
ma forall a. Num a => a -> a -> a
+ Int
n, [Int]
mls)
    ~(Int
ma, [Int]
mls) <- forall bw fw (m :: * -> *). MonadTardis bw fw m => m bw
getFuture
    forall (m :: * -> *) a. Monad m => a -> m a
return Int
c
  forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. [a] -> [b] -> [(a, b)]
zip [Int
c..] [Word8]
bs
  where
  n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
bs

codeByte :: Word8 -> CodeBuilder
codeByte :: Word8 -> CodeBuilder
codeByte = [Word8] -> CodeBuilder
codeBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])

mkRef :: Size -> Int -> Label -> CodeBuilder
mkRef :: Size -> Int -> Label -> CodeBuilder
mkRef s :: Size
s@(forall {a}. Num a => Size -> a
sizeLen -> Int
sn) Int
offset (Label Int
l_) = Int
-> Int
-> WriterT CodeBuilderRes CodeBuilderTardis ()
-> CodeBuilder
CodeBuilder Int
sn Int
sn forall a b. (a -> b) -> a -> b
$ do
  [(Int, Word8)]
bs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ mdo
    (Int
n, [Int]
ls, [[(Size, Int, Int)]]
ps) <- forall bw fw (m :: * -> *). MonadTardis bw fw m => m fw
getPast
    forall bw fw (m :: * -> *). MonadTardis bw fw m => fw -> m ()
sendFuture (Int
n forall a. Num a => a -> a -> a
+ Int
sn, [Int]
ls, [[(Size, Int, Int)]]
ps')
    forall bw fw (m :: * -> *). MonadTardis bw fw m => bw -> m ()
sendPast (Int
ma forall a. Num a => a -> a -> a
+ Int
sn, [Int]
mls)
    ~(Int
ma, [Int]
mls) <- forall bw fw (m :: * -> *). MonadTardis bw fw m => m bw
getFuture
    let i :: Int
i = [Int]
ls forall a. [a] -> Int -> a
!! (- Int
l forall a. Num a => a -> a -> a
- Int
1)
        vx :: Int
vx = Int
i forall a. Num a => a -> a -> a
- Int
n forall a. Num a => a -> a -> a
- Int
offset
        z :: [Word8]
z = case Size
s of
          Size
S8  -> case Int
vx of
            Integral Int8
j -> forall a. HasBytes a => a -> [Word8]
toBytes (Int8
j :: Int8)
            Int
_ -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Int
vx forall a. [a] -> [a] -> [a]
++ [Char]
" does not fit into an Int8"
          Size
S32  -> case Int
vx of
            Integral Int32
j -> forall a. HasBytes a => a -> [Word8]
toBytes (Int32
j :: Int32)
            Int
_ -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Int
vx forall a. [a] -> [a] -> [a]
++ [Char]
" does not fit into an Int32"
        ~([Word8]
bs, [[(Size, Int, Int)]]
ps')
          | Int
l forall a. Ord a => a -> a -> Bool
< Int
0 = ([Word8]
z, [[(Size, Int, Int)]]
ps)
          | Bool
otherwise = ([], forall a. Int -> a -> [[a]] -> [[a]]
ins Int
l (Size
s, Int
n, - Int
n forall a. Num a => a -> a -> a
- Int
offset) [[(Size, Int, Int)]]
ps)
        l :: Int
l = Int
l_ forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ls
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
n..] [Word8]
bs
  forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Word8)]
bs

ins :: Int -> a -> [[a]] -> [[a]]
ins :: forall a. Int -> a -> [[a]] -> [[a]]
ins Int
0 a
a [] = [[a
a]]
ins Int
0 a
a ([a]
as:[[a]]
ass) = (a
aforall a. a -> [a] -> [a]
:[a]
as)forall a. a -> [a] -> [a]
: [[a]]
ass
ins Int
n a
a [] = []forall a. a -> [a] -> [a]
: forall a. Int -> a -> [[a]] -> [[a]]
ins (Int
nforall a. Num a => a -> a -> a
-Int
1) a
a []
ins Int
n a
a ([a]
as: [[a]]
ass) = [a]
asforall a. a -> [a] -> [a]
: forall a. Int -> a -> [[a]] -> [[a]]
ins (Int
nforall a. Num a => a -> a -> a
-Int
1) a
a [[a]]
ass

mkAutoRef :: [(Size, Bytes)] -> Label -> CodeBuilder
mkAutoRef :: [(Size, [Word8])] -> Label -> CodeBuilder
mkAutoRef [(Size, [Word8])]
ss (Label Int
l_) = Int
-> Int
-> WriterT CodeBuilderRes CodeBuilderTardis ()
-> CodeBuilder
CodeBuilder (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
sizes) (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
sizes) forall a b. (a -> b) -> a -> b
$ do
  [(Int, Word8)]
bs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ mdo
    (Int
n, [Int]
ls, [[(Size, Int, Int)]]
ps) <- forall bw fw (m :: * -> *). MonadTardis bw fw m => m fw
getPast
    forall bw fw (m :: * -> *). MonadTardis bw fw m => fw -> m ()
sendFuture (Int
n forall a. Num a => a -> a -> a
+ Int
sn, [Int]
ls, [[(Size, Int, Int)]]
ps')
    forall bw fw (m :: * -> *). MonadTardis bw fw m => bw -> m ()
sendPast (Int
ma forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
sizes, [Int]
mls)
    ~(Int
ma, [Int]
mls) <- forall bw fw (m :: * -> *). MonadTardis bw fw m => m bw
getFuture
    let i :: Int
i = [Int]
ls forall a. [a] -> Int -> a
!! (- Int
l forall a. Num a => a -> a -> a
- Int
1)
        vx :: Int
vx = Int
i forall a. Num a => a -> a -> a
- Int
n
        z :: [Word8]
z = [(Size, [Word8])] -> [Word8]
g [(Size, [Word8])]
ss

        g :: [(Size, [Word8])] -> [Word8]
g [] = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Int
vx forall a. [a] -> [a] -> [a]
++ [Char]
" does not fit into auto size"
        g ((Size
s, [Word8]
c): [(Size, [Word8])]
ss) = case (Size
s, Int
vx forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
c forall a. Num a => a -> a -> a
- forall {a}. Num a => Size -> a
sizeLen Size
s) of
          (Size
S8,  Integral Int8
j) -> [Word8]
c forall a. Semigroup a => a -> a -> a
<> forall a. HasBytes a => a -> [Word8]
toBytes (Int8
j :: Int8)
          (Size
S32, Integral Int32
j) -> [Word8]
c forall a. Semigroup a => a -> a -> a
<> forall a. HasBytes a => a -> [Word8]
toBytes (Int32
j :: Int32)
          (Size, Int)
_ -> [(Size, [Word8])] -> [Word8]
g [(Size, [Word8])]
ss

        ~(Int
sn, [Word8]
bs, [[(Size, Int, Int)]]
ps')
          | Int
l forall a. Ord a => a -> a -> Bool
< Int
0 = (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
z, [Word8]
z, [[(Size, Int, Int)]]
ps)
          | Bool
otherwise = (Int
nz, [Word8]
z', forall a. Int -> a -> [[a]] -> [[a]]
ins Int
l (Size
s, Int
n forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
z', - Int
n forall a. Num a => a -> a -> a
- Int
nz) [[(Size, Int, Int)]]
ps)

        nz :: Int
nz = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
z' forall a. Num a => a -> a -> a
+ forall {a}. Num a => Size -> a
sizeLen Size
s
        ma' :: Int
ma' = [Int]
mls forall a. [a] -> Int -> a
!! Int
l
        vx' :: Int
vx' = Int
ma forall a. Num a => a -> a -> a
- Int
ma'
        ([Word8]
z', Size
s) = [(Size, [Word8])] -> ([Word8], Size)
g' [(Size, [Word8])]
ss

        g' :: [(Size, [Word8])] -> ([Word8], Size)
g' [] = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Int
vx' forall a. [a] -> [a] -> [a]
++ [Char]
" does not fit into auto size"
        g' ((Size
s, [Word8]
c): [(Size, [Word8])]
ss) = case (Size
s, Int
vx') of
          (Size
S8,  Integral (Int8
j :: Int8)) -> ([Word8]
c, Size
s)
          (Size
S32, Integral (Int32
j :: Int32)) -> ([Word8]
c, Size
s)
          (Size, Int)
_ -> [(Size, [Word8])] -> ([Word8], Size)
g' [(Size, [Word8])]
ss

        l :: Int
l = Int
l_ forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ls
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
n..] [Word8]
bs
  forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Word8)]
bs
  where
  sizes :: [Int]
sizes = forall a b. (a -> b) -> [a] -> [b]
map (\(Size
s, [Word8]
c) -> forall {a}. Num a => Size -> a
sizeLen Size
s forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
c) [(Size, [Word8])]
ss

-- prebuild code
preBuild :: Code -> Code
preBuild :: Code -> Code
preBuild Code
c = forall a. StateT Int (WriterT LCode Identity) a -> CodeM a
CodeM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell forall a b. (a -> b) -> a -> b
$ Vector Word8 -> LCode -> LCode
Prebuilt ((CodeBuilderRes, Int) -> Vector Word8
compactCode (LCode -> (CodeBuilderRes, Int)
buildCode LCode
lc)) LCode
lc
  where
  lc :: LCode
lc = Code -> LCode
withLabels Code
c

------------------------------------------------------- code to code builder

instance Show Code where
  show :: Code -> [Char]
show = forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> LCode
withLabels

instance Show LCode where
  show :: LCode -> [Char]
show LCode
c = [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$ forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 forall {a} {a}.
(Integral a, Integral a, Bits a, Bits a) =>
a -> [a] -> ShowS
showLine [Int]
is (forall {a}. [Int] -> [a] -> [[a]]
takes (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) (forall a. [a] -> [a]
tail [Int]
is forall a. [a] -> [a] -> [a]
++ [Int
s]) [Int]
is) [Word8]
bs) [[Char]]
ss where
    ss :: [[Char]]
ss = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w a. Writer w a -> (a, w)
runWriter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. LCode -> StateT Int (WriterT [[Char]] Identity) ()
showCode forall a b. (a -> b) -> a -> b
$ LCode
c
    (CodeBuilderRes
x, Int
s) = LCode -> (CodeBuilderRes, Int)
buildCode LCode
c
    bs :: [Word8]
bs = forall a. Unbox a => Vector a -> [a]
V.toList forall a b. (a -> b) -> a -> b
$ (CodeBuilderRes, Int) -> Vector Word8
compactCode (CodeBuilderRes
x, Int
s)
    is :: [Int]
is = [Int
i | Left Int
i <- CodeBuilderRes
x]

    showLine :: a -> [a] -> ShowS
showLine a
addr [] [Char]
s = [Char]
s
    showLine a
addr [a]
bs [Char]
s = [forall a. (Integral a, Bits a) => Int -> a -> Char
showNibble Int
i a
addr | Int
i <- [Int
5,Int
4..Int
0]] forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Int -> ShowS
pad (Int
2 forall a. Num a => a -> a -> a
* forall {a}. Num a => a
maxbytes) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. (Integral a, Bits a) => a -> [Char]
showByte [a]
bs) forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char]
s

    pad :: Int -> ShowS
pad Int
i [Char]
xs = [Char]
xs forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
i forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
xs) Char
' '

    maxbytes :: a
maxbytes = a
12

compactCode :: (CodeBuilderRes, Int) -> V.Vector Word8
compactCode :: (CodeBuilderRes, Int) -> Vector Word8
compactCode (CodeBuilderRes
x, Int
s) = forall a. Unbox a => Int -> a -> Vector a
V.replicate Int
s Word8
0 forall a. Unbox a => Vector a -> [(Int, a)] -> Vector a
V.// [(Int, Word8)
p | Right (Int, Word8)
p <- CodeBuilderRes
x]

buildTheCode :: Code -> (CodeBuilderRes, Int)
buildTheCode :: Code -> (CodeBuilderRes, Int)
buildTheCode = LCode -> (CodeBuilderRes, Int)
buildCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> LCode
withLabels

buildCode :: LCode -> (CodeBuilderRes, Int)
buildCode :: LCode -> (CodeBuilderRes, Int)
buildCode LCode
x = (CodeBuilderRes
r, Int
len)
  where
  ((()
_, CodeBuilderRes
r), ((Int, [Int])
_, (Int
len, [Int]
_, [[(Size, Int, Int)]]
_))) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall bw fw a. Tardis bw fw a -> (bw, fw) -> (a, (bw, fw))
runTardis ((Int
0, []), (Int
0, [], [])) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeBuilder -> WriterT CodeBuilderRes CodeBuilderTardis ()
getCodeBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. LCode -> CodeBuilder
mkCodeBuilder forall a b. (a -> b) -> a -> b
$ LCode
x

mkCodeBuilder :: LCode -> CodeBuilder
mkCodeBuilder :: LCode -> CodeBuilder
mkCodeBuilder = \case
  CodeLine CodeBuilder
x CodeLine
_ -> CodeBuilder
x
  Prebuilt Vector Word8
v LCode
_ -> CodeLine -> CodeBuilder
mkCodeBuilder' (Int -> CodeLine
Align_ Int
4) forall a. Semigroup a => a -> a -> a
<> [Word8] -> CodeBuilder
codeBytes (forall a. Unbox a => Vector a -> [a]
V.toList Vector Word8
v)
  AppendCode CodeBuilder
x LCode
_ LCode
_ -> CodeBuilder
x
  LCode
EmptyCode -> forall a. Monoid a => a
mempty

newtype CodeM a = CodeM {forall a. CodeM a -> StateT Int (WriterT LCode Identity) a
unCodeM :: StateT Int (Writer LCode) a}
  deriving (forall a b. a -> CodeM b -> CodeM a
forall a b. (a -> b) -> CodeM a -> CodeM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CodeM b -> CodeM a
$c<$ :: forall a b. a -> CodeM b -> CodeM a
fmap :: forall a b. (a -> b) -> CodeM a -> CodeM b
$cfmap :: forall a b. (a -> b) -> CodeM a -> CodeM b
Functor, Functor CodeM
forall a. a -> CodeM a
forall a b. CodeM a -> CodeM b -> CodeM a
forall a b. CodeM a -> CodeM b -> CodeM b
forall a b. CodeM (a -> b) -> CodeM a -> CodeM b
forall a b c. (a -> b -> c) -> CodeM a -> CodeM b -> CodeM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. CodeM a -> CodeM b -> CodeM a
$c<* :: forall a b. CodeM a -> CodeM b -> CodeM a
*> :: forall a b. CodeM a -> CodeM b -> CodeM b
$c*> :: forall a b. CodeM a -> CodeM b -> CodeM b
liftA2 :: forall a b c. (a -> b -> c) -> CodeM a -> CodeM b -> CodeM c
$cliftA2 :: forall a b c. (a -> b -> c) -> CodeM a -> CodeM b -> CodeM c
<*> :: forall a b. CodeM (a -> b) -> CodeM a -> CodeM b
$c<*> :: forall a b. CodeM (a -> b) -> CodeM a -> CodeM b
pure :: forall a. a -> CodeM a
$cpure :: forall a. a -> CodeM a
Applicative, Applicative CodeM
forall a. a -> CodeM a
forall a b. CodeM a -> CodeM b -> CodeM b
forall a b. CodeM a -> (a -> CodeM b) -> CodeM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> CodeM a
$creturn :: forall a. a -> CodeM a
>> :: forall a b. CodeM a -> CodeM b -> CodeM b
$c>> :: forall a b. CodeM a -> CodeM b -> CodeM b
>>= :: forall a b. CodeM a -> (a -> CodeM b) -> CodeM b
$c>>= :: forall a b. CodeM a -> (a -> CodeM b) -> CodeM b
Monad, Monad CodeM
forall a. (a -> CodeM a) -> CodeM a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: forall a. (a -> CodeM a) -> CodeM a
$cmfix :: forall a. (a -> CodeM a) -> CodeM a
MonadFix)

type Code = CodeM ()

withLabels :: Code -> LCode
withLabels :: Code -> LCode
withLabels =
  forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w a. Writer w a -> (a, w)
runWriter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CodeM a -> StateT Int (WriterT LCode Identity) a
unCodeM

-- multi-byte nop operations
nops :: Int -> Bytes
nops :: Int -> [Word8]
nops = \case
  Int
0 -> []
  Int
1 -> [Word8
0x90]
  Int
2 -> [Word8
0x66, Word8
0x90]
  Int
3 -> [Word8
0x0f, Word8
0x1f, Word8
0x00]
  Int
4 -> [Word8
0x0f, Word8
0x1f, Word8
0x40, Word8
0x00]
  Int
5 -> [Word8
0x0f, Word8
0x1f, Word8
0x44, Word8
0x00, Word8
0x00]
  Int
6 -> [Word8
0x66, Word8
0x0f, Word8
0x1f, Word8
0x44, Word8
0x00, Word8
0x00]
  Int
7 -> [Word8
0x0f, Word8
0x1f, Word8
0x80, Word8
0x00, Word8
0x00, Word8
0x00, Word8
0x00]
  Int
8 -> [Word8
0x0f, Word8
0x1f, Word8
0x84, Word8
0x00, Word8
0x00, Word8
0x00, Word8
0x00, Word8
0x00]
  Int
9 -> [Word8
0x66, Word8
0x0f, Word8
0x1f, Word8
0x84, Word8
0x00, Word8
0x00, Word8
0x00, Word8
0x00, Word8
0x00]
  ((forall a. Num a => a -> a -> a
+(-Int
2)) -> Integral Int8
x) -> [Word8
0xeb] forall a. [a] -> [a] -> [a]
++ forall a. HasBytes a => a -> [Word8]
toBytes (Int8
x :: Int8) forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
x) Word8
0x00
  ((forall a. Num a => a -> a -> a
+(-Int
5)) -> Integral Int32
x) -> [Word8
0xe9] forall a. [a] -> [a] -> [a]
++ forall a. HasBytes a => a -> [Word8]
toBytes (Int32
x :: Int32) forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x) Word8
0x00

mkCodeBuilder' :: CodeLine -> CodeBuilder
mkCodeBuilder' :: CodeLine -> CodeBuilder
mkCodeBuilder' = \case
  Add_  Operand 'RW s
a Operand r s
b -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r s -> CodeBuilder
op2 Word8
0x0 Operand 'RW s
a Operand r s
b
  Or_   Operand 'RW s
a Operand r s
b -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r s -> CodeBuilder
op2 Word8
0x1 Operand 'RW s
a Operand r s
b
  Adc_  Operand 'RW s
a Operand r s
b -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r s -> CodeBuilder
op2 Word8
0x2 Operand 'RW s
a Operand r s
b
  Sbb_  Operand 'RW s
a Operand r s
b -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r s -> CodeBuilder
op2 Word8
0x3 Operand 'RW s
a Operand r s
b
  And_  Operand 'RW s
a Operand r s
b -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r s -> CodeBuilder
op2 Word8
0x4 Operand 'RW s
a Operand r s
b
  Sub_  Operand 'RW s
a Operand r s
b -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r s -> CodeBuilder
op2 Word8
0x5 Operand 'RW s
a Operand r s
b
  Xor_  Operand 'RW s
a Operand r s
b -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r s -> CodeBuilder
op2 Word8
0x6 Operand 'RW s
a Operand r s
b
  Cmp_  Operand 'RW s
a Operand r s
b -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r s -> CodeBuilder
op2 Word8
0x7 Operand 'RW s
a Operand r s
b

  Rol_ Operand 'RW s
a Operand r 'S8
b -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r 'S8 -> CodeBuilder
shiftOp Word8
0x0 Operand 'RW s
a Operand r 'S8
b
  Ror_ Operand 'RW s
a Operand r 'S8
b -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r 'S8 -> CodeBuilder
shiftOp Word8
0x1 Operand 'RW s
a Operand r 'S8
b
  Rcl_ Operand 'RW s
a Operand r 'S8
b -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r 'S8 -> CodeBuilder
shiftOp Word8
0x2 Operand 'RW s
a Operand r 'S8
b
  Rcr_ Operand 'RW s
a Operand r 'S8
b -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r 'S8 -> CodeBuilder
shiftOp Word8
0x3 Operand 'RW s
a Operand r 'S8
b
  Shl_ Operand 'RW s
a Operand r 'S8
b -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r 'S8 -> CodeBuilder
shiftOp Word8
0x4 Operand 'RW s
a Operand r 'S8
b -- sal
  Shr_ Operand 'RW s
a Operand r 'S8
b -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r 'S8 -> CodeBuilder
shiftOp Word8
0x5 Operand 'RW s
a Operand r 'S8
b
  Sar_ Operand 'RW s
a Operand r 'S8
b -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r 'S8 -> CodeBuilder
shiftOp Word8
0x7 Operand 'RW s
a Operand r 'S8
b

  Xchg_ x :: Operand 'RW s
x@Operand 'RW s
RegA Operand 'RW s
r -> forall (s :: Size) (r :: Access).
IsSize s =>
Operand r s -> CodeBuilder
xchg_a Operand 'RW s
r
  Xchg_ Operand 'RW s
r x :: Operand 'RW s
x@Operand 'RW s
RegA -> forall (s :: Size) (r :: Access).
IsSize s =>
Operand r s -> CodeBuilder
xchg_a Operand 'RW s
r
  Xchg_ Operand 'RW s
dest Operand 'RW s
src -> forall (s :: Size).
IsSize s =>
Word8 -> Operand 'RW s -> Operand 'RW s -> CodeBuilder
op2' Word8
0x43 Operand 'RW s
dest' Operand 'RW s
src where
    (Operand 'RW s
dest', Operand 'RW s
src') = if forall {a :: Access} {b :: Size}. Operand a b -> Bool
isMemOp Operand 'RW s
src then (Operand 'RW s
src, Operand 'RW s
dest) else (Operand 'RW s
dest, Operand 'RW s
src)

  Test_ Operand 'RW s
dest (forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImmNo64 (forall a. HasSize a => a -> Size
size Operand 'RW s
dest) -> FJust ((Bool, Size)
_, CodeBuilder
im)) -> case Operand 'RW s
dest of
    Operand 'RW s
RegA -> forall (s :: Size) (r :: Access).
IsSize s =>
Operand r s -> Word8 -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix'' Operand 'RW s
dest Word8
0x54 forall a. Monoid a => a
mempty CodeBuilder
im
    Operand 'RW s
_ -> forall (s :: Size) (r :: Access).
IsSize s =>
Operand r s -> Word8 -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix'' Operand 'RW s
dest Word8
0x7b (forall (r :: Access) (s :: Size).
Word8 -> Operand r s -> CodeBuilder
reg8 Word8
0x0 Operand 'RW s
dest) CodeBuilder
im
  Test_ Operand 'RW s
dest (forall (r :: Access) (s :: Size).
[Char] -> Operand r s -> Operand 'RW s
noImm [Char]
"" -> Operand 'RW s
src) -> forall (s :: Size).
IsSize s =>
Word8 -> Operand 'RW s -> Operand 'RW s -> CodeBuilder
op2' Word8
0x42 Operand 'RW s
dest' Operand 'RW s
src' where
    (Operand 'RW s
dest', Operand 'RW s
src') = if forall {a :: Access} {b :: Size}. Operand a b -> Bool
isMemOp Operand 'RW s
src then (Operand 'RW s
src, Operand 'RW s
dest) else (Operand 'RW s
dest, Operand 'RW s
src)

  Mov_ dest :: Operand 'RW s
dest@(RegOp Reg s
r) ((if forall a. HasSize a => a -> Size
size Operand 'RW s
dest forall a. Eq a => a -> a -> Bool
== Size
S64 then forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImmU Size
S32 forall a. Semigroup a => a -> a -> a
<> forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImm Size
S64 else forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImm (forall a. HasSize a => a -> Size
size Operand 'RW s
dest)) -> FJust ((Bool
se, Size
si), CodeBuilder
im))
    | (Bool
se, Size
si, forall a. HasSize a => a -> Size
size Operand 'RW s
dest) forall a. Eq a => a -> a -> Bool
/= (Bool
True, Size
S32, Size
S64) -> forall (s :: Size) (r :: Access).
IsSize s =>
Size -> Operand r s -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix Size
si Operand 'RW s
dest (forall (t :: Size). Word8 -> Reg t -> CodeBuilder
oneReg (Word8
0x16 forall a. Bits a => a -> a -> a
.|. forall a. Integral a => Bool -> a
indicator (forall a. HasSize a => a -> Size
size Operand 'RW s
dest forall a. Eq a => a -> a -> Bool
/= Size
S8)) Reg s
r) CodeBuilder
im
    | Bool
otherwise -> forall (s :: Size) (r :: Access).
IsSize s =>
Operand r s -> Word8 -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix'' Operand 'RW s
dest Word8
0x63 (forall (r :: Access) (s :: Size).
Word8 -> Operand r s -> CodeBuilder
reg8 Word8
0x0 Operand 'RW s
dest) CodeBuilder
im
  Mov_ dest :: Operand 'RW s
dest@(forall a. HasSize a => a -> Size
size -> Size
s) (forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImmNo64 Size
s -> FJust ((Bool, Size)
_, CodeBuilder
im)) -> forall (s :: Size) (r :: Access).
IsSize s =>
Operand r s -> Word8 -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix'' Operand 'RW s
dest Word8
0x63 (forall (r :: Access) (s :: Size).
Word8 -> Operand r s -> CodeBuilder
reg8 Word8
0x0 Operand 'RW s
dest) CodeBuilder
im
  Mov_ Operand 'RW s
dest Operand r s
src -> forall (s :: Size).
IsSize s =>
Word8 -> Operand 'RW s -> Operand 'RW s -> CodeBuilder
op2' Word8
0x44 Operand 'RW s
dest forall a b. (a -> b) -> a -> b
$ forall (r :: Access) (s :: Size).
[Char] -> Operand r s -> Operand 'RW s
noImm (forall a. Show a => a -> [Char]
show (Operand 'RW s
dest, Operand r s
src)) Operand r s
src

  Cmov_ (Condition Word8
c) Operand 'RW s
dest Operand 'RW s
src | forall a. HasSize a => a -> Size
size Operand 'RW s
dest forall a. Eq a => a -> a -> Bool
/= Size
S8 -> forall (s1 :: Size) (s :: Size) (r1 :: Access) (r :: Access).
(IsSize s1, IsSize s) =>
Operand r1 s1 -> Operand r s -> CodeBuilder -> CodeBuilder
regprefix2 Operand 'RW s
src Operand 'RW s
dest forall a b. (a -> b) -> a -> b
$ Word8 -> CodeBuilder
codeByte Word8
0x0f forall a. Semigroup a => a -> a -> a
<> Word8 -> CodeBuilder
codeByte (Word8
0x40 forall a. Bits a => a -> a -> a
.|. Word8
c) forall a. Semigroup a => a -> a -> a
<> forall (s :: Size) (s' :: Size) (r :: Access) (r' :: Access).
(IsSize s, IsSize s') =>
Operand r s -> Operand r' s' -> CodeBuilder
reg2x8 Operand 'RW s
dest Operand 'RW s
src
  Bsf Operand 'RW s
dest Operand r s
src | forall a. HasSize a => a -> Size
size Operand 'RW s
dest forall a. Eq a => a -> a -> Bool
/= Size
S8 -> forall (s1 :: Size) (s :: Size) (r1 :: Access) (r :: Access).
(IsSize s1, IsSize s) =>
Operand r1 s1 -> Operand r s -> CodeBuilder -> CodeBuilder
regprefix2 Operand r s
src Operand 'RW s
dest forall a b. (a -> b) -> a -> b
$ Word8 -> CodeBuilder
codeByte Word8
0x0f forall a. Semigroup a => a -> a -> a
<> Word8 -> CodeBuilder
codeByte Word8
0xbc forall a. Semigroup a => a -> a -> a
<> forall (s :: Size) (s' :: Size) (r :: Access) (r' :: Access).
(IsSize s, IsSize s') =>
Operand r s -> Operand r' s' -> CodeBuilder
reg2x8 Operand 'RW s
dest Operand r s
src
  Bsr Operand 'RW s
dest Operand r s
src | forall a. HasSize a => a -> Size
size Operand 'RW s
dest forall a. Eq a => a -> a -> Bool
/= Size
S8 -> forall (s1 :: Size) (s :: Size) (r1 :: Access) (r :: Access).
(IsSize s1, IsSize s) =>
Operand r1 s1 -> Operand r s -> CodeBuilder -> CodeBuilder
regprefix2 Operand r s
src Operand 'RW s
dest forall a b. (a -> b) -> a -> b
$ Word8 -> CodeBuilder
codeByte Word8
0x0f forall a. Semigroup a => a -> a -> a
<> Word8 -> CodeBuilder
codeByte Word8
0xbd forall a. Semigroup a => a -> a -> a
<> forall (s :: Size) (s' :: Size) (r :: Access) (r' :: Access).
(IsSize s, IsSize s') =>
Operand r s -> Operand r' s' -> CodeBuilder
reg2x8 Operand 'RW s
dest Operand r s
src
  Bt  Operand r s
src Operand 'RW s
dest | forall a. HasSize a => a -> Size
size Operand 'RW s
dest forall a. Eq a => a -> a -> Bool
/= Size
S8 -> forall (s1 :: Size) (s :: Size) (r1 :: Access) (r :: Access).
(IsSize s1, IsSize s) =>
Operand r1 s1 -> Operand r s -> CodeBuilder -> CodeBuilder
regprefix2 Operand r s
src Operand 'RW s
dest forall a b. (a -> b) -> a -> b
$ Word8 -> CodeBuilder
codeByte Word8
0x0f forall a. Semigroup a => a -> a -> a
<> Word8 -> CodeBuilder
codeByte Word8
0xa3 forall a. Semigroup a => a -> a -> a
<> forall (s :: Size) (s' :: Size) (r :: Access) (r' :: Access).
(IsSize s, IsSize s') =>
Operand r s -> Operand r' s' -> CodeBuilder
reg2x8 Operand 'RW s
dest Operand r s
src

  Lea_ Operand 'RW s
dest Operand 'RW s'
src | forall a. HasSize a => a -> Size
size Operand 'RW s
dest forall a. Eq a => a -> a -> Bool
/= Size
S8 -> forall (s1 :: Size) (s :: Size) (r1 :: Access) (r :: Access).
(IsSize s1, IsSize s) =>
Operand r1 s1 -> Operand r s -> Word8 -> CodeBuilder -> CodeBuilder
regprefix2' (forall (s1 :: Size) (x :: Access) (s2 :: Size).
IsSize s1 =>
Operand x s1 -> Operand 'RW s2 -> Operand 'RW s1
resizeOperand' Operand 'RW s
dest Operand 'RW s'
src) Operand 'RW s
dest Word8
0x46 forall a b. (a -> b) -> a -> b
$ forall (s :: Size) (s' :: Size) (r :: Access) (r' :: Access).
(IsSize s, IsSize s') =>
Operand r s -> Operand r' s' -> CodeBuilder
reg2x8 Operand 'RW s
dest Operand 'RW s'
src where
    resizeOperand' :: IsSize s1 => Operand x s1 -> Operand RW s2 -> Operand RW s1
    resizeOperand' :: forall (s1 :: Size) (x :: Access) (s2 :: Size).
IsSize s1 =>
Operand x s1 -> Operand 'RW s2 -> Operand 'RW s1
resizeOperand' Operand x s1
_ = forall (s' :: Size) (s :: Size).
IsSize s' =>
Operand 'RW s -> Operand 'RW s'
resizeOperand

  Not_  Operand 'RW s
a -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Word8 -> Operand r s -> CodeBuilder
op1 Word8
0x7b Word8
0x2 Operand 'RW s
a
  Neg_  Operand 'RW s
a -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Word8 -> Operand r s -> CodeBuilder
op1 Word8
0x7b Word8
0x3 Operand 'RW s
a
  Inc_  Operand 'RW s
a -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Word8 -> Operand r s -> CodeBuilder
op1 Word8
0x7f Word8
0x0 Operand 'RW s
a
  Dec_  Operand 'RW s
a -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Word8 -> Operand r s -> CodeBuilder
op1 Word8
0x7f Word8
0x1 Operand 'RW s
a
  Bswap a :: Operand 'RW s
a@RegOp{} | forall a. HasSize a => a -> Size
size Operand 'RW s
a forall a. Ord a => a -> a -> Bool
>= Size
S32 -> forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Word8 -> Operand r s -> CodeBuilder
op1 Word8
0x07 Word8
0x1 Operand 'RW s
a
  Bswap Operand 'RW s
a  -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"wrong bswap operand: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Operand 'RW s
a

  Call_ (ImmOp (LabelRelValue Size
S32 Label
l)) -> Word8 -> CodeBuilder
codeByte Word8
0xe8 forall a. Semigroup a => a -> a -> a
<> Size -> Int -> Label -> CodeBuilder
mkRef Size
S32 Int
4 Label
l
  Call_ Operand r 'S64
a -> forall (r :: Access).
Word8 -> Word8 -> Operand r 'S64 -> CodeBuilder
op1' Word8
0xff Word8
0x2 Operand r 'S64
a

  Movd_ a :: Operand 'RW s
a@Operand 'RW s
OpXMM Operand r s'
b -> forall (s :: Size) (r :: Access) (r' :: Access).
IsSize s =>
Word8 -> Operand r 'S128 -> Operand r' s -> CodeBuilder
sse Word8
0x6e Operand 'RW s
a Operand r s'
b
  Movd_ Operand 'RW s
b a :: Operand r s'
a@Operand r s'
OpXMM -> forall (s :: Size) (r :: Access) (r' :: Access).
IsSize s =>
Word8 -> Operand r 'S128 -> Operand r' s -> CodeBuilder
sse Word8
0x7e Operand r s'
a Operand 'RW s
b
  Movq_ Operand 'RW s
b a :: Operand r s'
a@Operand r s'
OpXMM -> forall (s :: Size) (r :: Access) (r' :: Access).
IsSize s =>
Word8 -> Operand r 'S128 -> Operand r' s -> CodeBuilder
sse Word8
0xd6 Operand r s'
a Operand 'RW s
b
  Movdqa_ a :: Operand 'RW 'S128
a@Operand 'RW 'S128
OpXMM Operand r 'S128
b -> forall (s :: Size) (r :: Access) (r' :: Access).
IsSize s =>
Word8 -> Operand r 'S128 -> Operand r' s -> CodeBuilder
sse Word8
0x6f Operand 'RW 'S128
a Operand r 'S128
b
  Movdqa_ Operand 'RW 'S128
b a :: Operand r 'S128
a@Operand r 'S128
OpXMM -> forall (s :: Size) (r :: Access) (r' :: Access).
IsSize s =>
Word8 -> Operand r 'S128 -> Operand r' s -> CodeBuilder
sse Word8
0x7f Operand r 'S128
a Operand 'RW 'S128
b
  Paddb_  Operand 'RW 'S128
a Operand r 'S128
b -> forall (s :: Size) (r :: Access) (r' :: Access).
IsSize s =>
Word8 -> Operand r 'S128 -> Operand r' s -> CodeBuilder
sse Word8
0xfc Operand 'RW 'S128
a Operand r 'S128
b
  Paddw_  Operand 'RW 'S128
a Operand r 'S128
b -> forall (s :: Size) (r :: Access) (r' :: Access).
IsSize s =>
Word8 -> Operand r 'S128 -> Operand r' s -> CodeBuilder
sse Word8
0xfd Operand 'RW 'S128
a Operand r 'S128
b
  Paddd_  Operand 'RW 'S128
a Operand r 'S128
b -> forall (s :: Size) (r :: Access) (r' :: Access).
IsSize s =>
Word8 -> Operand r 'S128 -> Operand r' s -> CodeBuilder
sse Word8
0xfe Operand 'RW 'S128
a Operand r 'S128
b
  Paddq_  Operand 'RW 'S128
a Operand r 'S128
b -> forall (s :: Size) (r :: Access) (r' :: Access).
IsSize s =>
Word8 -> Operand r 'S128 -> Operand r' s -> CodeBuilder
sse Word8
0xd4 Operand 'RW 'S128
a Operand r 'S128
b
  Psubb_  Operand 'RW 'S128
a Operand r 'S128
b -> forall (s :: Size) (r :: Access) (r' :: Access).
IsSize s =>
Word8 -> Operand r 'S128 -> Operand r' s -> CodeBuilder
sse Word8
0xf8 Operand 'RW 'S128
a Operand r 'S128
b
  Psubw_  Operand 'RW 'S128
a Operand r 'S128
b -> forall (s :: Size) (r :: Access) (r' :: Access).
IsSize s =>
Word8 -> Operand r 'S128 -> Operand r' s -> CodeBuilder
sse Word8
0xf9 Operand 'RW 'S128
a Operand r 'S128
b
  Psubd_  Operand 'RW 'S128
a Operand r 'S128
b -> forall (s :: Size) (r :: Access) (r' :: Access).
IsSize s =>
Word8 -> Operand r 'S128 -> Operand r' s -> CodeBuilder
sse Word8
0xfa Operand 'RW 'S128
a Operand r 'S128
b
  Psubq_  Operand 'RW 'S128
a Operand r 'S128
b -> forall (s :: Size) (r :: Access) (r' :: Access).
IsSize s =>
Word8 -> Operand r 'S128 -> Operand r' s -> CodeBuilder
sse Word8
0xfb Operand 'RW 'S128
a Operand r 'S128
b
  Pxor_   Operand 'RW 'S128
a Operand r 'S128
b -> forall (s :: Size) (r :: Access) (r' :: Access).
IsSize s =>
Word8 -> Operand r 'S128 -> Operand r' s -> CodeBuilder
sse Word8
0xef Operand 'RW 'S128
a Operand r 'S128
b
  Psllw_  Operand 'RW 'S128
a Operand r 'S8
b -> forall (r :: Access).
Word8
-> Word8
-> Word8
-> Operand 'RW 'S128
-> Operand r 'S8
-> CodeBuilder
sseShift Word8
0x71 Word8
0x2 Word8
0xd1 Operand 'RW 'S128
a Operand r 'S8
b
  Pslld_  Operand 'RW 'S128
a Operand r 'S8
b -> forall (r :: Access).
Word8
-> Word8
-> Word8
-> Operand 'RW 'S128
-> Operand r 'S8
-> CodeBuilder
sseShift Word8
0x72 Word8
0x2 Word8
0xd2 Operand 'RW 'S128
a Operand r 'S8
b
  Psllq_  Operand 'RW 'S128
a Operand r 'S8
b -> forall (r :: Access).
Word8
-> Word8
-> Word8
-> Operand 'RW 'S128
-> Operand r 'S8
-> CodeBuilder
sseShift Word8
0x73 Word8
0x2 Word8
0xd3 Operand 'RW 'S128
a Operand r 'S8
b
  Pslldq_ Operand 'RW 'S128
a Operand r 'S8
b -> forall (r :: Access).
Word8
-> Word8
-> Word8
-> Operand 'RW 'S128
-> Operand r 'S8
-> CodeBuilder
sseShift Word8
0x73 Word8
0x7 forall a. HasCallStack => a
undefined Operand 'RW 'S128
a Operand r 'S8
b
  Psrlw_  Operand 'RW 'S128
a Operand r 'S8
b -> forall (r :: Access).
Word8
-> Word8
-> Word8
-> Operand 'RW 'S128
-> Operand r 'S8
-> CodeBuilder
sseShift Word8
0x71 Word8
0x6 Word8
0xf1 Operand 'RW 'S128
a Operand r 'S8
b
  Psrld_  Operand 'RW 'S128
a Operand r 'S8
b -> forall (r :: Access).
Word8
-> Word8
-> Word8
-> Operand 'RW 'S128
-> Operand r 'S8
-> CodeBuilder
sseShift Word8
0x72 Word8
0x6 Word8
0xf2 Operand 'RW 'S128
a Operand r 'S8
b
  Psrlq_  Operand 'RW 'S128
a Operand r 'S8
b -> forall (r :: Access).
Word8
-> Word8
-> Word8
-> Operand 'RW 'S128
-> Operand r 'S8
-> CodeBuilder
sseShift Word8
0x73 Word8
0x6 Word8
0xf3 Operand 'RW 'S128
a Operand r 'S8
b
  Psrldq_ Operand 'RW 'S128
a Operand r 'S8
b -> forall (r :: Access).
Word8
-> Word8
-> Word8
-> Operand 'RW 'S128
-> Operand r 'S8
-> CodeBuilder
sseShift Word8
0x73 Word8
0x3 forall a. HasCallStack => a
undefined Operand 'RW 'S128
a Operand r 'S8
b
  Psraw_  Operand 'RW 'S128
a Operand r 'S8
b -> forall (r :: Access).
Word8
-> Word8
-> Word8
-> Operand 'RW 'S128
-> Operand r 'S8
-> CodeBuilder
sseShift Word8
0x71 Word8
0x4 Word8
0xe1 Operand 'RW 'S128
a Operand r 'S8
b
  Psrad_  Operand 'RW 'S128
a Operand r 'S8
b -> forall (r :: Access).
Word8
-> Word8
-> Word8
-> Operand 'RW 'S128
-> Operand r 'S8
-> CodeBuilder
sseShift Word8
0x72 Word8
0x4 Word8
0xe2 Operand 'RW 'S128
a Operand r 'S8
b

  Pop_ dest :: Operand 'RW 'S64
dest@(RegOp Reg 'S64
r) -> forall (s :: Size) (r :: Access).
IsSize s =>
Size -> Operand r s -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix Size
S32 Operand 'RW 'S64
dest (forall (t :: Size). Word8 -> Reg t -> CodeBuilder
oneReg Word8
0x0b Reg 'S64
r) forall a. Monoid a => a
mempty
  Pop_ Operand 'RW 'S64
dest -> forall (s :: Size) (r :: Access).
IsSize s =>
Size -> Operand r s -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix Size
S32 Operand 'RW 'S64
dest (Word8 -> CodeBuilder
codeByte Word8
0x8f forall a. Semigroup a => a -> a -> a
<> forall (r :: Access) (s :: Size).
Word8 -> Operand r s -> CodeBuilder
reg8 Word8
0x0 Operand 'RW 'S64
dest) forall a. Monoid a => a
mempty

  Push_ (forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImmS Size
S8 -> FJust ((Bool, Size)
_, CodeBuilder
im)) -> Word8 -> CodeBuilder
codeByte Word8
0x6a forall a. Semigroup a => a -> a -> a
<> CodeBuilder
im
  Push_ (forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImm Size
S32 -> FJust ((Bool, Size)
_, CodeBuilder
im)) -> Word8 -> CodeBuilder
codeByte Word8
0x68 forall a. Semigroup a => a -> a -> a
<> CodeBuilder
im
  Push_ dest :: Operand r 'S64
dest@(RegOp Reg 'S64
r) -> forall (s :: Size) (r :: Access).
IsSize s =>
Size -> Operand r s -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix Size
S32 Operand r 'S64
dest (forall (t :: Size). Word8 -> Reg t -> CodeBuilder
oneReg Word8
0x0a Reg 'S64
r) forall a. Monoid a => a
mempty
  Push_ Operand r 'S64
dest -> forall (s :: Size) (r :: Access).
IsSize s =>
Size -> Operand r s -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix Size
S32 Operand r 'S64
dest (Word8 -> CodeBuilder
codeByte Word8
0xff forall a. Semigroup a => a -> a -> a
<> forall (r :: Access) (s :: Size).
Word8 -> Operand r s -> CodeBuilder
reg8 Word8
0x6 Operand r 'S64
dest) forall a. Monoid a => a
mempty

  CodeLine
Ret_   -> Word8 -> CodeBuilder
codeByte Word8
0xc3
  CodeLine
Nop_   -> Word8 -> CodeBuilder
codeByte Word8
0x90
  CodeLine
PushF_ -> Word8 -> CodeBuilder
codeByte Word8
0x9c
  CodeLine
PopF_  -> Word8 -> CodeBuilder
codeByte Word8
0x9d
  CodeLine
Cmc_   -> Word8 -> CodeBuilder
codeByte Word8
0xf5
  CodeLine
Clc_   -> Word8 -> CodeBuilder
codeByte Word8
0xf8
  CodeLine
Stc_   -> Word8 -> CodeBuilder
codeByte Word8
0xf9
  CodeLine
Cli_   -> Word8 -> CodeBuilder
codeByte Word8
0xfa
  CodeLine
Sti_   -> Word8 -> CodeBuilder
codeByte Word8
0xfb
  CodeLine
Cld_   -> Word8 -> CodeBuilder
codeByte Word8
0xfc
  CodeLine
Std_   -> Word8 -> CodeBuilder
codeByte Word8
0xfd

  J_ (Condition Word8
c) (Just Size
S8)  Label
l -> Word8 -> CodeBuilder
codeByte (Word8
0x70 forall a. Bits a => a -> a -> a
.|. Word8
c) forall a. Semigroup a => a -> a -> a
<> Size -> Int -> Label -> CodeBuilder
mkRef Size
S8 Int
1 Label
l
  J_ (Condition Word8
c) (Just Size
S32) Label
l -> Word8 -> CodeBuilder
codeByte Word8
0x0f forall a. Semigroup a => a -> a -> a
<> Word8 -> CodeBuilder
codeByte (Word8
0x80 forall a. Bits a => a -> a -> a
.|. Word8
c) forall a. Semigroup a => a -> a -> a
<> Size -> Int -> Label -> CodeBuilder
mkRef Size
S32 Int
4 Label
l
  J_ (Condition Word8
c) Maybe Size
Nothing  Label
l -> [(Size, [Word8])] -> Label -> CodeBuilder
mkAutoRef [(Size
S8, [Word8
0x70 forall a. Bits a => a -> a -> a
.|. Word8
c]), (Size
S32, [Word8
0x0f, Word8
0x80 forall a. Bits a => a -> a -> a
.|. Word8
c])] Label
l

  Jmp_ (Just Size
S8)  Label
l -> Word8 -> CodeBuilder
codeByte Word8
0xeb forall a. Semigroup a => a -> a -> a
<> Size -> Int -> Label -> CodeBuilder
mkRef Size
S8 Int
1 Label
l
  Jmp_ (Just Size
S32) Label
l -> Word8 -> CodeBuilder
codeByte Word8
0xe9 forall a. Semigroup a => a -> a -> a
<> Size -> Int -> Label -> CodeBuilder
mkRef Size
S32 Int
4 Label
l
  Jmp_ Maybe Size
Nothing  Label
l -> [(Size, [Word8])] -> Label -> CodeBuilder
mkAutoRef [(Size
S8, [Word8
0xeb]), (Size
S32, [Word8
0xe9])] Label
l

  Jmpq_ (ImmOp (LabelRelValue Size
S32 Label
l)) -> [(Size, [Word8])] -> Label -> CodeBuilder
mkAutoRef [(Size
S8, [Word8
0xeb]), (Size
S32, [Word8
0xe9])] Label
l
  Jmpq_ Operand r 'S64
a -> forall (r :: Access).
Word8 -> Word8 -> Operand r 'S64 -> CodeBuilder
op1' Word8
0xff Word8
0x4 Operand r 'S64
a

  CodeLine
Label_ -> Int
-> Int
-> WriterT CodeBuilderRes CodeBuilderTardis ()
-> CodeBuilder
CodeBuilder Int
0 Int
0 forall a b. (a -> b) -> a -> b
$ do
    [(Int, Word8)]
bs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ mdo
      (Int
n, [Int]
ls, [[(Size, Int, Int)]]
ps) <- forall bw fw (m :: * -> *). MonadTardis bw fw m => m fw
getPast
      forall bw fw (m :: * -> *). MonadTardis bw fw m => fw -> m ()
sendFuture (Int
n, Int
nforall a. a -> [a] -> [a]
: [Int]
ls, [[(Size, Int, Int)]]
ps')
      forall bw fw (m :: * -> *). MonadTardis bw fw m => bw -> m ()
sendPast (Int
ma, Int
maforall a. a -> [a] -> [a]
: [Int]
mls)
      ~(Int
ma, [Int]
mls) <- forall bw fw (m :: * -> *). MonadTardis bw fw m => m bw
getFuture
      let ([(Int, Word8)]
bs, [[(Size, Int, Int)]]
ps') = case [[(Size, Int, Int)]]
ps of
            [] -> ([], [])
            [(Size, Int, Int)]
corr: [[(Size, Int, Int)]]
ps -> (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Size, Int, Int) -> [(Int, Word8)]
g [(Size, Int, Int)]
corr, [[(Size, Int, Int)]]
ps)
          g :: (Size, Int, Int) -> [(Int, Word8)]
g (Size
size, Int
p, Int
v) = forall a b. [a] -> [b] -> [(a, b)]
zip [Int
p..] forall a b. (a -> b) -> a -> b
$ case (Size
size, Int
v forall a. Num a => a -> a -> a
+ Int
n) of
            (Size
S8, Integral Int8
v) -> forall a. HasBytes a => a -> [Word8]
toBytes (Int8
v :: Int8)
            (Size
S32, Integral Int32
v) -> forall a. HasBytes a => a -> [Word8]
toBytes (Int32
v :: Int32)
            (Size
s, Int
i) -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Int
i forall a. [a] -> [a] -> [a]
++ [Char]
" doesn't fit into " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Size
s
      forall (m :: * -> *) a. Monad m => a -> m a
return [(Int, Word8)]
bs
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Word8)]
bs


  Data_ [Word8]
x -> [Word8] -> CodeBuilder
codeBytes [Word8]
x

  Align_ Int
s -> Int
-> Int
-> WriterT CodeBuilderRes CodeBuilderTardis ()
-> CodeBuilder
CodeBuilder Int
0 (Int
sforall a. Num a => a -> a -> a
-Int
1) forall a b. (a -> b) -> a -> b
$ do
    [(Int, Word8)]
bs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ mdo
      (Int
n, [Int]
ls, [[(Size, Int, Int)]]
ps) <- forall bw fw (m :: * -> *). MonadTardis bw fw m => m fw
getPast
      forall bw fw (m :: * -> *). MonadTardis bw fw m => fw -> m ()
sendFuture (Int
n', [Int]
ls, [[(Size, Int, Int)]]
ps)
      forall bw fw (m :: * -> *). MonadTardis bw fw m => bw -> m ()
sendPast (Int
ma forall a. Num a => a -> a -> a
+ Int
sforall a. Num a => a -> a -> a
-Int
1, [Int]
mls)
      ~(Int
ma, [Int]
mls) <- forall bw fw (m :: * -> *). MonadTardis bw fw m => m bw
getFuture
      let n' :: Int
n' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Num a => a -> a -> a
- Int64
1 :: Int64) forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s forall a. Num a => a -> a -> a
- Int64
1)) forall a. Num a => a -> a -> a
+ Int64
1
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
n..] forall a b. (a -> b) -> a -> b
$ Int -> [Word8]
nops forall a b. (a -> b) -> a -> b
$ Int
n' forall a. Num a => a -> a -> a
- Int
n
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Word8)]
bs

  where
  convertImm :: Bool{-signed-} -> Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
  convertImm :: forall (r :: Access) (s :: Size).
Bool -> Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
convertImm Bool
a Size
b (ImmOp (Immediate Int64
c)) = forall a. Maybe a -> First a
First forall a b. (a -> b) -> a -> b
$ (,) (Bool
a, Size
b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> CodeBuilder
codeBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
(Bits a, Integral a) =>
Bool -> Size -> a -> Maybe [Word8]
integralToBytes Bool
a Size
b Int64
c
  convertImm Bool
True Size
b (ImmOp (LabelRelValue Size
s Label
d)) | Size
b forall a. Eq a => a -> a -> Bool
== Size
s = forall {a}. a -> First a
FJust forall a b. (a -> b) -> a -> b
$ (,) (Bool
True, Size
b) forall a b. (a -> b) -> a -> b
$ Size -> Int -> Label -> CodeBuilder
mkRef Size
s (forall {a}. Num a => Size -> a
sizeLen Size
s) Label
d
  convertImm Bool
_ Size
_ Operand r s
_ = forall {a}. First a
FNothing

  mkImmS, mkImmU, mkImm, mkImmNo64 :: Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
  mkImmS :: forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImmS = forall (r :: Access) (s :: Size).
Bool -> Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
convertImm Bool
True
  mkImmU :: forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImmU = forall (r :: Access) (s :: Size).
Bool -> Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
convertImm Bool
False
  mkImm :: forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImm Size
s = forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImmS Size
s forall a. Semigroup a => a -> a -> a
<> forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImmU Size
s
  mkImmNo64 :: forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImmNo64 Size
s = forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImm (Size -> Size
no64 Size
s)

  xchg_a :: IsSize s => Operand r s -> CodeBuilder
  xchg_a :: forall (s :: Size) (r :: Access).
IsSize s =>
Operand r s -> CodeBuilder
xchg_a dest :: Operand r s
dest@(RegOp Reg s
r) | forall a. HasSize a => a -> Size
size Operand r s
dest forall a. Eq a => a -> a -> Bool
/= Size
S8 = forall (s :: Size) (r :: Access).
IsSize s =>
Size -> Operand r s -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix (forall a. HasSize a => a -> Size
size Operand r s
dest) Operand r s
dest (forall (t :: Size). Word8 -> Reg t -> CodeBuilder
oneReg Word8
0x12 Reg s
r) forall a. Monoid a => a
mempty
  xchg_a Operand r s
dest = forall (s :: Size) (r :: Access).
IsSize s =>
Operand r s -> Word8 -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix'' Operand r s
dest Word8
0x43 (forall (r :: Access) (s :: Size).
Word8 -> Operand r s -> CodeBuilder
reg8 Word8
0x0 Operand r s
dest) forall a. Monoid a => a
mempty

  toCode :: HasBytes a => a -> CodeBuilder
  toCode :: forall a. HasBytes a => a -> CodeBuilder
toCode = [Word8] -> CodeBuilder
codeBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasBytes a => a -> [Word8]
toBytes

  sizePrefix_ :: [SReg] -> Size -> Operand r s -> Word8 -> CodeBuilder -> CodeBuilder -> CodeBuilder
  sizePrefix_ :: forall (r :: Access) (s :: Size).
[SReg]
-> Size
-> Operand r s
-> Word8
-> CodeBuilder
-> CodeBuilder
-> CodeBuilder
sizePrefix_ [SReg]
rs Size
s Operand r s
r Word8
x CodeBuilder
c CodeBuilder
im
    | forall {t :: * -> *}. Foldable t => t SReg -> Bool
noHighRex [SReg]
rs = CodeBuilder
pre forall a. Semigroup a => a -> a -> a
<> CodeBuilder
c forall a. Semigroup a => a -> a -> a
<> forall (r :: Access) (s :: Size). Operand r s -> CodeBuilder
displacement Operand r s
r forall a. Semigroup a => a -> a -> a
<> CodeBuilder
im
    | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"cannot use high register in rex instruction"
    where
      pre :: CodeBuilder
pre = case Size
s of
        Size
S8  -> forall (r :: Access) (s :: Size). Operand r s -> CodeBuilder
mem32pre Operand r s
r forall a. Semigroup a => a -> a -> a
<> CodeBuilder
maybePrefix40
        Size
S16 -> Word8 -> CodeBuilder
codeByte Word8
0x66 forall a. Semigroup a => a -> a -> a
<> forall (r :: Access) (s :: Size). Operand r s -> CodeBuilder
mem32pre Operand r s
r forall a. Semigroup a => a -> a -> a
<> Word8 -> CodeBuilder
prefix40 Word8
x
        Size
S32 -> forall (r :: Access) (s :: Size). Operand r s -> CodeBuilder
mem32pre Operand r s
r forall a. Semigroup a => a -> a -> a
<> Word8 -> CodeBuilder
prefix40 Word8
x
        Size
S64 -> forall (r :: Access) (s :: Size). Operand r s -> CodeBuilder
mem32pre Operand r s
r forall a. Semigroup a => a -> a -> a
<> Word8 -> CodeBuilder
prefix40 (Word8
0x8 forall a. Bits a => a -> a -> a
.|. Word8
x)
        Size
S128 -> forall (r :: Access) (s :: Size). Operand r s -> CodeBuilder
mem32pre Operand r s
r forall a. Semigroup a => a -> a -> a
<> Word8 -> CodeBuilder
codeByte Word8
0x66 forall a. Semigroup a => a -> a -> a
<> CodeBuilder
maybePrefix40

      mem32pre :: Operand r s -> CodeBuilder
      mem32pre :: forall (r :: Access) (s :: Size). Operand r s -> CodeBuilder
mem32pre (MemOp r :: Addr s'
r@Addr{}) | forall a. HasSize a => a -> Size
size Addr s'
r forall a. Eq a => a -> a -> Bool
== Size
S32 = Word8 -> CodeBuilder
codeByte Word8
0x67
      mem32pre Operand r s
_ = forall a. Monoid a => a
mempty

      prefix40 :: Word8 -> CodeBuilder
prefix40 Word8
x = forall {p}. Monoid p => Bool -> p -> p
iff (Word8
x forall a. Eq a => a -> a -> Bool
/= Word8
0) forall a b. (a -> b) -> a -> b
$ Word8 -> CodeBuilder
prefix40_ Word8
x
      prefix40_ :: Word8 -> CodeBuilder
prefix40_ Word8
x = Word8 -> CodeBuilder
codeByte forall a b. (a -> b) -> a -> b
$ Word8
0x40 forall a. Bits a => a -> a -> a
.|. Word8
x

      maybePrefix40 :: CodeBuilder
maybePrefix40 = forall {p}. Monoid p => Bool -> p -> p
iff (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any SReg -> Bool
isRex [SReg]
rs Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
/= Word8
0) (Word8 -> CodeBuilder
prefix40_ Word8
x)

      displacement :: Operand r s -> CodeBuilder
      displacement :: forall (r :: Access) (s :: Size). Operand r s -> CodeBuilder
displacement (IPMemOp (Immediate Int32
d)) = forall a. HasBytes a => a -> CodeBuilder
toCode Int32
d
      displacement (IPMemOp (LabelRelValue s :: Size
s@Size
S32 Label
d)) = Size -> Int -> Label -> CodeBuilder
mkRef Size
s (forall {a}. Num a => Size -> a
sizeLen Size
s forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (CodeBuilder -> Int
codeBuilderLength CodeBuilder
im)) Label
d
      displacement (MemOp (Addr BaseReg s'
b Displacement
d IndexReg s'
i)) = BaseReg s' -> IndexReg s' -> CodeBuilder
mkSIB BaseReg s'
b IndexReg s'
i forall a. Semigroup a => a -> a -> a
<> forall {a} {t :: Size}.
(Integral a, Bits a, HasBytes a) =>
Maybe (Reg t) -> Maybe a -> CodeBuilder
dispVal BaseReg s'
b Displacement
d
        where
          mkSIB :: BaseReg s' -> IndexReg s' -> CodeBuilder
mkSIB BaseReg s'
_ (IndexReg Scale
s (NormalReg Word8
0x4)) = forall a. HasCallStack => [Char] -> a
error [Char]
"sp cannot be used as index"
          mkSIB BaseReg s'
_ (IndexReg Scale
s Reg s'
i) = Scale -> Word8 -> CodeBuilder
f Scale
s forall a b. (a -> b) -> a -> b
$ forall (t :: Size). Reg t -> Word8
reg8_ Reg s'
i
          mkSIB BaseReg s'
Nothing IndexReg s'
_ = Scale -> Word8 -> CodeBuilder
f Scale
s1 Word8
0x4
          mkSIB (Just (forall (t :: Size). Reg t -> Word8
reg8_ -> Word8
0x4)) IndexReg s'
_ = Scale -> Word8 -> CodeBuilder
f Scale
s1 Word8
0x4
          mkSIB BaseReg s'
_ IndexReg s'
_ = forall a. Monoid a => a
mempty

          f :: Scale -> Word8 -> CodeBuilder
f (Scale Word8
s) Word8
i = Word8 -> CodeBuilder
codeByte forall a b. (a -> b) -> a -> b
$ Word8
s forall a. Bits a => a -> Int -> a
`shiftL` Int
6 forall a. Bits a => a -> a -> a
.|. Word8
i forall a. Bits a => a -> Int -> a
`shiftL` Int
3 forall a. Bits a => a -> a -> a
.|. forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word8
0x5 forall (t :: Size). Reg t -> Word8
reg8_ BaseReg s'
b

          dispVal :: Maybe (Reg t) -> Maybe a -> CodeBuilder
dispVal Just{} (Disp (Integral (Int8
d :: Int8))) = forall a. HasBytes a => a -> CodeBuilder
toCode Int8
d
          dispVal Maybe (Reg t)
_ (Disp a
d) = forall a. HasBytes a => a -> CodeBuilder
toCode a
d
          dispVal Maybe (Reg t)
Nothing Maybe a
_ = forall a. HasBytes a => a -> CodeBuilder
toCode (Int32
0 :: Int32)    -- [rbp] --> [rbp + 0]
          dispVal (Just (forall (t :: Size). Reg t -> Word8
reg8_ -> Word8
0x5)) Maybe a
_ = Word8 -> CodeBuilder
codeByte Word8
0    -- [rbp] --> [rbp + 0]
          dispVal Maybe (Reg t)
_ Maybe a
_ = forall a. Monoid a => a
mempty
      displacement Operand r s
_ = forall a. Monoid a => a
mempty

  reg8_ :: Reg t -> Word8
  reg8_ :: forall (t :: Size). Reg t -> Word8
reg8_ (NormalReg Word8
r) = Word8
r forall a. Bits a => a -> a -> a
.&. Word8
0x7
  reg8_ (HighReg Word8
r) = Word8
r forall a. Bits a => a -> a -> a
.|. Word8
0x4
  reg8_ (XMM Word8
r) = Word8
r forall a. Bits a => a -> a -> a
.&. Word8
0x7

  regprefix :: IsSize s => Size -> Operand r s -> CodeBuilder -> CodeBuilder -> CodeBuilder
  regprefix :: forall (s :: Size) (r :: Access).
IsSize s =>
Size -> Operand r s -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix Size
s Operand r s
r = forall (r :: Access) (s :: Size).
[SReg]
-> Size
-> Operand r s
-> Word8
-> CodeBuilder
-> CodeBuilder
-> CodeBuilder
sizePrefix_ (forall (s :: Size) (r :: Access). IsSize s => Operand r s -> [SReg]
regs Operand r s
r) Size
s Operand r s
r (forall (r :: Access) (s :: Size). Operand r s -> Word8
extbits Operand r s
r)

  regprefix2 :: (IsSize s1, IsSize s) => Operand r1 s1 -> Operand r s -> CodeBuilder -> CodeBuilder
  regprefix2 :: forall (s1 :: Size) (s :: Size) (r1 :: Access) (r :: Access).
(IsSize s1, IsSize s) =>
Operand r1 s1 -> Operand r s -> CodeBuilder -> CodeBuilder
regprefix2 Operand r1 s1
r Operand r s
r' CodeBuilder
c = forall (r :: Access) (s :: Size).
[SReg]
-> Size
-> Operand r s
-> Word8
-> CodeBuilder
-> CodeBuilder
-> CodeBuilder
sizePrefix_ (forall (s :: Size) (r :: Access). IsSize s => Operand r s -> [SReg]
regs Operand r1 s1
r forall a. Semigroup a => a -> a -> a
<> forall (s :: Size) (r :: Access). IsSize s => Operand r s -> [SReg]
regs Operand r s
r') (forall a. HasSize a => a -> Size
size Operand r1 s1
r) Operand r1 s1
r (forall (r :: Access) (s :: Size). Operand r s -> Word8
extbits Operand r s
r' forall a. Bits a => a -> Int -> a
`shiftL` Int
2 forall a. Bits a => a -> a -> a
.|. forall (r :: Access) (s :: Size). Operand r s -> Word8
extbits Operand r1 s1
r) CodeBuilder
c forall a. Monoid a => a
mempty

  regprefix'' :: IsSize s => Operand r s -> Word8 -> CodeBuilder -> CodeBuilder -> CodeBuilder
  regprefix'' :: forall (s :: Size) (r :: Access).
IsSize s =>
Operand r s -> Word8 -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix'' Operand r s
r Word8
p CodeBuilder
c = forall (s :: Size) (r :: Access).
IsSize s =>
Size -> Operand r s -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix (forall a. HasSize a => a -> Size
size Operand r s
r) Operand r s
r forall a b. (a -> b) -> a -> b
$ forall a. HasSize a => a -> Word8 -> CodeBuilder
extension Operand r s
r Word8
p forall a. Semigroup a => a -> a -> a
<> CodeBuilder
c

  regprefix2' :: (IsSize s1, IsSize s) => Operand r1 s1 -> Operand r s -> Word8 -> CodeBuilder -> CodeBuilder
  regprefix2' :: forall (s1 :: Size) (s :: Size) (r1 :: Access) (r :: Access).
(IsSize s1, IsSize s) =>
Operand r1 s1 -> Operand r s -> Word8 -> CodeBuilder -> CodeBuilder
regprefix2' Operand r1 s1
r Operand r s
r' Word8
p CodeBuilder
c = forall (s1 :: Size) (s :: Size) (r1 :: Access) (r :: Access).
(IsSize s1, IsSize s) =>
Operand r1 s1 -> Operand r s -> CodeBuilder -> CodeBuilder
regprefix2 Operand r1 s1
r Operand r s
r' forall a b. (a -> b) -> a -> b
$ forall a. HasSize a => a -> Word8 -> CodeBuilder
extension Operand r1 s1
r Word8
p forall a. Semigroup a => a -> a -> a
<> CodeBuilder
c

  sse :: IsSize s => Word8 -> Operand r S128 -> Operand r' s -> CodeBuilder
  sse :: forall (s :: Size) (r :: Access) (r' :: Access).
IsSize s =>
Word8 -> Operand r 'S128 -> Operand r' s -> CodeBuilder
sse Word8
op a :: Operand r 'S128
a@Operand r 'S128
OpXMM Operand r' s
b = forall (s :: Size) (r :: Access).
IsSize s =>
Size -> Operand r s -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix Size
S128 Operand r' s
b (Word8 -> CodeBuilder
codeByte Word8
0x0f forall a. Semigroup a => a -> a -> a
<> Word8 -> CodeBuilder
codeByte Word8
op forall a. Semigroup a => a -> a -> a
<> forall (s :: Size) (s' :: Size) (r :: Access) (r' :: Access).
(IsSize s, IsSize s') =>
Operand r s -> Operand r' s' -> CodeBuilder
reg2x8 Operand r 'S128
a Operand r' s
b) forall a. Monoid a => a
mempty

  sseShift :: Word8 -> Word8 -> Word8 -> Operand RW S128 -> Operand r S8 -> CodeBuilder
  sseShift :: forall (r :: Access).
Word8
-> Word8
-> Word8
-> Operand 'RW 'S128
-> Operand r 'S8
-> CodeBuilder
sseShift Word8
op Word8
x Word8
op' a :: Operand 'RW 'S128
a@Operand 'RW 'S128
OpXMM b :: Operand r 'S8
b@(forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImmU Size
S8 -> FJust ((Bool, Size)
_, CodeBuilder
i)) = forall (s :: Size) (r :: Access).
IsSize s =>
Size -> Operand r s -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix Size
S128 Operand r 'S8
b (Word8 -> CodeBuilder
codeByte Word8
0x0f forall a. Semigroup a => a -> a -> a
<> Word8 -> CodeBuilder
codeByte Word8
op forall a. Semigroup a => a -> a -> a
<> forall (r :: Access) (s :: Size).
Word8 -> Operand r s -> CodeBuilder
reg8 Word8
x Operand 'RW 'S128
a) CodeBuilder
i
  -- TODO: xmm argument

  extension :: HasSize a => a -> Word8 -> CodeBuilder
  extension :: forall a. HasSize a => a -> Word8 -> CodeBuilder
extension a
x Word8
p = Word8 -> CodeBuilder
codeByte forall a b. (a -> b) -> a -> b
$ Word8
p forall a. Bits a => a -> Int -> a
`shiftL` Int
1 forall a. Bits a => a -> a -> a
.|. forall a. Integral a => Bool -> a
indicator (forall a. HasSize a => a -> Size
size a
x forall a. Eq a => a -> a -> Bool
/= Size
S8)

  extbits :: Operand r s -> Word8
  extbits :: forall (r :: Access) (s :: Size). Operand r s -> Word8
extbits = \case
    MemOp (Addr BaseReg s'
b Displacement
_ IndexReg s'
i) -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word8
0 forall (t :: Size). Reg t -> Word8
indexReg BaseReg s'
b forall a. Bits a => a -> a -> a
.|. case IndexReg s'
i of IndexReg s'
NoIndex -> Word8
0; IndexReg Scale
_ Reg s'
x -> forall (t :: Size). Reg t -> Word8
indexReg Reg s'
x forall a. Bits a => a -> Int -> a
`shiftL` Int
1
    RegOp Reg s
r -> forall (t :: Size). Reg t -> Word8
indexReg Reg s
r
    Operand r s
_ -> Word8
0
    where
      indexReg :: Reg a -> Word8
indexReg (NormalReg Word8
r) = Word8
r forall a. Bits a => a -> Int -> a
`shiftR` Int
3 forall a. Bits a => a -> a -> a
.&. Word8
1
      indexReg Reg a
_ = Word8
0

  reg8 :: Word8 -> Operand r s -> CodeBuilder
  reg8 :: forall (r :: Access) (s :: Size).
Word8 -> Operand r s -> CodeBuilder
reg8 Word8
w Operand r s
x = Word8 -> CodeBuilder
codeByte forall a b. (a -> b) -> a -> b
$ forall (r :: Access) (s :: Size). Operand r s -> Word8
operMode Operand r s
x forall a. Bits a => a -> Int -> a
`shiftL` Int
6 forall a. Bits a => a -> a -> a
.|. Word8
w forall a. Bits a => a -> Int -> a
`shiftL` Int
3 forall a. Bits a => a -> a -> a
.|. forall (r :: Access) (s :: Size). Operand r s -> Word8
rc Operand r s
x
    where
      operMode :: Operand r s -> Word8
      operMode :: forall (r :: Access) (s :: Size). Operand r s -> Word8
operMode (MemOp (Addr (Just (forall (t :: Size). Reg t -> Word8
reg8_ -> Word8
0x5)) Displacement
NoDisp IndexReg s'
_)) = Word8
0x1   -- [rbp] --> [rbp + 0]
      operMode (MemOp (Addr Maybe (Reg s')
Nothing Displacement
_ IndexReg s'
_)) = Word8
0x0
      operMode (MemOp (Addr BaseReg s'
_ Displacement
NoDisp IndexReg s'
_))  = Word8
0x0
      operMode (MemOp (Addr BaseReg s'
_ (Disp (Integral (Int8
_ :: Int8))) IndexReg s'
_))  = Word8
0x1
      operMode (MemOp (Addr BaseReg s'
_ Disp{} IndexReg s'
_))  = Word8
0x2
      operMode IPMemOp{}          = Word8
0x0
      operMode Operand r s
_              = Word8
0x3

      rc :: Operand r s -> Word8
      rc :: forall (r :: Access) (s :: Size). Operand r s -> Word8
rc (MemOp (Addr (Just Reg s'
r) Displacement
_ IndexReg s'
NoIndex)) = forall (t :: Size). Reg t -> Word8
reg8_ Reg s'
r
      rc MemOp{}   = Word8
0x04    -- SIB byte
      rc IPMemOp{} = Word8
0x05
      rc (RegOp Reg s
r) = forall (t :: Size). Reg t -> Word8
reg8_ Reg s
r

  op2 :: IsSize s => Word8 -> Operand RW s -> Operand r s -> CodeBuilder
  op2 :: forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r s -> CodeBuilder
op2 Word8
op dest :: Operand 'RW s
dest@Operand 'RW s
RegA src :: Operand r s
src@(forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImmNo64 (forall a. HasSize a => a -> Size
size Operand 'RW s
dest) -> FJust ((Bool, Size)
_, CodeBuilder
im)) | forall a. HasSize a => a -> Size
size Operand 'RW s
dest forall a. Eq a => a -> a -> Bool
== Size
S8 Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isNothing (forall a. First a -> Maybe a
getFirst forall a b. (a -> b) -> a -> b
$ forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImmS Size
S8 Operand r s
src)
    = forall (s :: Size) (r :: Access).
IsSize s =>
Operand r s -> Word8 -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix'' Operand 'RW s
dest (Word8
op forall a. Bits a => a -> Int -> a
`shiftL` Int
2 forall a. Bits a => a -> a -> a
.|. Word8
0x2) forall a. Monoid a => a
mempty CodeBuilder
im
  op2 Word8
op Operand 'RW s
dest (forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImmS Size
S8 forall a. Semigroup a => a -> a -> a
<> forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImmNo64 (forall a. HasSize a => a -> Size
size Operand 'RW s
dest) -> FJust ((Bool
_, Size
k), CodeBuilder
im))
    = forall (s :: Size) (r :: Access).
IsSize s =>
Operand r s -> Word8 -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix'' Operand 'RW s
dest (Word8
0x40 forall a. Bits a => a -> a -> a
.|. forall a. Integral a => Bool -> a
indicator (forall a. HasSize a => a -> Size
size Operand 'RW s
dest forall a. Eq a => a -> a -> Bool
/= Size
S8 Bool -> Bool -> Bool
&& Size
k forall a. Eq a => a -> a -> Bool
== Size
S8)) (forall (r :: Access) (s :: Size).
Word8 -> Operand r s -> CodeBuilder
reg8 Word8
op Operand 'RW s
dest) CodeBuilder
im
  op2 Word8
op Operand 'RW s
dest Operand r s
src = forall (s :: Size).
IsSize s =>
Word8 -> Operand 'RW s -> Operand 'RW s -> CodeBuilder
op2' (Word8
op forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Operand 'RW s
dest forall a b. (a -> b) -> a -> b
$ forall (r :: Access) (s :: Size).
[Char] -> Operand r s -> Operand 'RW s
noImm [Char]
"1" Operand r s
src

  noImm :: String -> Operand r s -> Operand RW s
  noImm :: forall (r :: Access) (s :: Size).
[Char] -> Operand r s -> Operand 'RW s
noImm [Char]
_ (RegOp Reg s
r) = forall (s :: Size) (rw :: Access). Reg s -> Operand rw s
RegOp Reg s
r
  noImm [Char]
_ (MemOp Addr s'
a) = forall (r :: Size) (rw :: Access) (s :: Size).
IsSize r =>
Addr r -> Operand rw s
MemOp Addr s'
a
  noImm [Char]
_ (IPMemOp Immediate Int32
a) = forall (rw :: Access) (s :: Size). Immediate Int32 -> Operand rw s
IPMemOp Immediate Int32
a
  noImm [Char]
er Operand r s
_ = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"immediate value of this size is not supported: " forall a. [a] -> [a] -> [a]
++ [Char]
er

  op2' :: IsSize s => Word8 -> Operand RW s -> Operand RW s -> CodeBuilder
  op2' :: forall (s :: Size).
IsSize s =>
Word8 -> Operand 'RW s -> Operand 'RW s -> CodeBuilder
op2' Word8
op Operand 'RW s
dest src :: Operand 'RW s
src@RegOp{} = forall (t :: Size) (s :: Size) (r :: Access) (r' :: Access).
(IsSize t, IsSize s) =>
Word8 -> Operand r s -> Operand r' t -> CodeBuilder
op2g Word8
op Operand 'RW s
dest Operand 'RW s
src
  op2' Word8
op dest :: Operand 'RW s
dest@RegOp{} Operand 'RW s
src = forall (t :: Size) (s :: Size) (r :: Access) (r' :: Access).
(IsSize t, IsSize s) =>
Word8 -> Operand r s -> Operand r' t -> CodeBuilder
op2g (Word8
op forall a. Bits a => a -> a -> a
.|. Word8
0x1) Operand 'RW s
src Operand 'RW s
dest

  op2g :: (IsSize t, IsSize s) => Word8 -> Operand r s -> Operand r' t -> CodeBuilder
  op2g :: forall (t :: Size) (s :: Size) (r :: Access) (r' :: Access).
(IsSize t, IsSize s) =>
Word8 -> Operand r s -> Operand r' t -> CodeBuilder
op2g Word8
op Operand r s
dest Operand r' t
src = forall (s1 :: Size) (s :: Size) (r1 :: Access) (r :: Access).
(IsSize s1, IsSize s) =>
Operand r1 s1 -> Operand r s -> Word8 -> CodeBuilder -> CodeBuilder
regprefix2' Operand r s
dest Operand r' t
src Word8
op forall a b. (a -> b) -> a -> b
$ forall (s :: Size) (s' :: Size) (r :: Access) (r' :: Access).
(IsSize s, IsSize s') =>
Operand r s -> Operand r' s' -> CodeBuilder
reg2x8 Operand r' t
src Operand r s
dest

  reg2x8 :: (IsSize s, IsSize s') => Operand r s -> Operand r' s' -> CodeBuilder
  reg2x8 :: forall (s :: Size) (s' :: Size) (r :: Access) (r' :: Access).
(IsSize s, IsSize s') =>
Operand r s -> Operand r' s' -> CodeBuilder
reg2x8 (RegOp Reg s
r) = forall (r :: Access) (s :: Size).
Word8 -> Operand r s -> CodeBuilder
reg8 (forall (t :: Size). Reg t -> Word8
reg8_ Reg s
r)

  op1_ :: IsSize s => Word8 -> Word8 -> Operand r s -> CodeBuilder -> CodeBuilder
  op1_ :: forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Word8 -> Operand r s -> CodeBuilder -> CodeBuilder
op1_ Word8
r1 Word8
r2 Operand r s
dest = forall (s :: Size) (r :: Access).
IsSize s =>
Operand r s -> Word8 -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix'' Operand r s
dest Word8
r1 (forall (r :: Access) (s :: Size).
Word8 -> Operand r s -> CodeBuilder
reg8 Word8
r2 Operand r s
dest)

  op1 :: IsSize s => Word8 -> Word8 -> Operand r s -> CodeBuilder
  op1 :: forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Word8 -> Operand r s -> CodeBuilder
op1 Word8
a Word8
b Operand r s
c = forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Word8 -> Operand r s -> CodeBuilder -> CodeBuilder
op1_ Word8
a Word8
b Operand r s
c forall a. Monoid a => a
mempty

  op1' :: Word8 -> Word8 -> Operand r S64 -> CodeBuilder
  op1' :: forall (r :: Access).
Word8 -> Word8 -> Operand r 'S64 -> CodeBuilder
op1' Word8
r1 Word8
r2 Operand r 'S64
dest = forall (s :: Size) (r :: Access).
IsSize s =>
Size -> Operand r s -> CodeBuilder -> CodeBuilder -> CodeBuilder
regprefix Size
S32 Operand r 'S64
dest (Word8 -> CodeBuilder
codeByte Word8
r1 forall a. Semigroup a => a -> a -> a
<> forall (r :: Access) (s :: Size).
Word8 -> Operand r s -> CodeBuilder
reg8 Word8
r2 Operand r 'S64
dest) forall a. Monoid a => a
mempty

  shiftOp :: IsSize s => Word8 -> Operand RW s -> Operand r S8 -> CodeBuilder
  shiftOp :: forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Operand 'RW s -> Operand r 'S8 -> CodeBuilder
shiftOp Word8
c Operand 'RW s
dest (ImmOp (Immediate Int64
1)) = forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Word8 -> Operand r s -> CodeBuilder
op1 Word8
0x68 Word8
c Operand 'RW s
dest
  shiftOp Word8
c Operand 'RW s
dest (forall (r :: Access) (s :: Size).
Size -> Operand r s -> First ((Bool, Size), CodeBuilder)
mkImmU Size
S8 -> FJust ((Bool, Size)
_, CodeBuilder
i)) = forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Word8 -> Operand r s -> CodeBuilder -> CodeBuilder
op1_ Word8
0x60 Word8
c Operand 'RW s
dest CodeBuilder
i
  shiftOp Word8
c Operand 'RW s
dest Operand r 'S8
RegCl = forall (s :: Size) (r :: Access).
IsSize s =>
Word8 -> Word8 -> Operand r s -> CodeBuilder
op1 Word8
0x69 Word8
c Operand 'RW s
dest
  shiftOp Word8
_ Operand 'RW s
_ Operand r 'S8
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"invalid shift operands"

  oneReg :: Word8 -> Reg t -> CodeBuilder
  oneReg :: forall (t :: Size). Word8 -> Reg t -> CodeBuilder
oneReg Word8
x Reg t
r = Word8 -> CodeBuilder
codeByte forall a b. (a -> b) -> a -> b
$ Word8
x forall a. Bits a => a -> Int -> a
`shiftL` Int
3 forall a. Bits a => a -> a -> a
.|. forall (t :: Size). Reg t -> Word8
reg8_ Reg t
r

pattern $mOpXMM :: forall {r} {a :: Access} {b :: Size}.
Operand a b -> ((b ~ 'S128) => r) -> ((# #) -> r) -> r
OpXMM <- RegOp XMM{}

-------------------------------------------------------------- asm codes

data LCode where
  Prebuilt   :: V.Vector Word8 -> LCode -> LCode
  EmptyCode  :: LCode
  AppendCode :: CodeBuilder -> LCode -> LCode -> LCode
  CodeLine   :: CodeBuilder -> CodeLine -> LCode

#if MIN_VERSION_base(4,11,0)
instance Semigroup LCode where
  LCode
a <> :: LCode -> LCode -> LCode
<> LCode
b = CodeBuilder -> LCode -> LCode -> LCode
AppendCode (LCode -> CodeBuilder
mkCodeBuilder LCode
a forall a. Semigroup a => a -> a -> a
<> LCode -> CodeBuilder
mkCodeBuilder LCode
b) LCode
a LCode
b
#endif

instance Monoid LCode where
  mempty :: LCode
mempty  = LCode
EmptyCode

#if !MIN_VERSION_base(4,11,0)
  mappend a b = AppendCode (mkCodeBuilder a <> mkCodeBuilder b) a b
#endif

ret :: Code
ret        = CodeLine -> Code
mkCodeLine CodeLine
Ret_
nop :: Code
nop        = CodeLine -> Code
mkCodeLine CodeLine
Nop_
pushf :: Code
pushf      = CodeLine -> Code
mkCodeLine CodeLine
PushF_
popf :: Code
popf       = CodeLine -> Code
mkCodeLine CodeLine
PopF_
cmc :: Code
cmc        = CodeLine -> Code
mkCodeLine CodeLine
Cmc_
clc :: Code
clc        = CodeLine -> Code
mkCodeLine CodeLine
Clc_
stc :: Code
stc        = CodeLine -> Code
mkCodeLine CodeLine
Stc_
cli :: Code
cli        = CodeLine -> Code
mkCodeLine CodeLine
Cli_
sti :: Code
sti        = CodeLine -> Code
mkCodeLine CodeLine
Sti_
cld :: Code
cld        = CodeLine -> Code
mkCodeLine CodeLine
Cld_
std :: Code
std        = CodeLine -> Code
mkCodeLine CodeLine
Std_
inc :: Operand 'RW s -> Code
inc Operand 'RW s
a      = CodeLine -> Code
mkCodeLine (forall (r :: Size). IsSize r => Operand 'RW r -> CodeLine
Inc_ Operand 'RW s
a)
dec :: Operand 'RW s -> Code
dec Operand 'RW s
a      = CodeLine -> Code
mkCodeLine (forall (r :: Size). IsSize r => Operand 'RW r -> CodeLine
Dec_ Operand 'RW s
a)
not_ :: Operand 'RW s -> Code
not_ Operand 'RW s
a     = CodeLine -> Code
mkCodeLine (forall (r :: Size). IsSize r => Operand 'RW r -> CodeLine
Not_ Operand 'RW s
a)
neg :: Operand 'RW s -> Code
neg Operand 'RW s
a      = CodeLine -> Code
mkCodeLine (forall (r :: Size). IsSize r => Operand 'RW r -> CodeLine
Neg_ Operand 'RW s
a)
bswap :: Operand 'RW s -> Code
bswap Operand 'RW s
a    = CodeLine -> Code
mkCodeLine (forall (r :: Size). IsSize r => Operand 'RW r -> CodeLine
Bswap Operand 'RW s
a)
bsf :: Operand 'RW s -> Operand r s -> Code
bsf Operand 'RW s
a Operand r s
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' r -> CodeLine
Bsf Operand 'RW s
a Operand r s
b)
bsr :: Operand 'RW s -> Operand r s -> Code
bsr Operand 'RW s
a Operand r s
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' r -> CodeLine
Bsr Operand 'RW s
a Operand r s
b)
bt :: Operand r s -> Operand 'RW s -> Code
bt Operand r s
a Operand 'RW s
b     = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand s' r -> Operand 'RW r -> CodeLine
Bt  Operand r s
a Operand 'RW s
b)
add :: Operand 'RW s -> Operand r s -> Code
add Operand 'RW s
a Operand r s
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' r -> CodeLine
Add_ Operand 'RW s
a Operand r s
b)
or_ :: Operand 'RW s -> Operand r s -> Code
or_  Operand 'RW s
a Operand r s
b   = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' r -> CodeLine
Or_  Operand 'RW s
a Operand r s
b)
adc :: Operand 'RW s -> Operand r s -> Code
adc Operand 'RW s
a Operand r s
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' r -> CodeLine
Adc_ Operand 'RW s
a Operand r s
b)
sbb :: Operand 'RW s -> Operand r s -> Code
sbb Operand 'RW s
a Operand r s
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' r -> CodeLine
Sbb_ Operand 'RW s
a Operand r s
b)
and_ :: Operand 'RW s -> Operand r s -> Code
and_ Operand 'RW s
a Operand r s
b   = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' r -> CodeLine
And_ Operand 'RW s
a Operand r s
b)
sub :: Operand 'RW s -> Operand r s -> Code
sub Operand 'RW s
a Operand r s
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' r -> CodeLine
Sub_ Operand 'RW s
a Operand r s
b)
xor_ :: Operand 'RW s -> Operand r s -> Code
xor_ Operand 'RW s
a Operand r s
b   = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' r -> CodeLine
Xor_ Operand 'RW s
a Operand r s
b)
cmp :: Operand 'RW s -> Operand r s -> Code
cmp Operand 'RW s
a Operand r s
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' r -> CodeLine
Cmp_ Operand 'RW s
a Operand r s
b)
test :: Operand 'RW s -> Operand r s -> Code
test Operand 'RW s
a Operand r s
b   = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' r -> CodeLine
Test_ Operand 'RW s
a Operand r s
b)
mov :: Operand 'RW s -> Operand r s -> Code
mov Operand 'RW s
a Operand r s
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' r -> CodeLine
Mov_ Operand 'RW s
a Operand r s
b)
cmov :: Condition -> Operand 'RW s -> Operand 'RW s -> Code
cmov Condition
c Operand 'RW s
a Operand 'RW s
b = CodeLine -> Code
mkCodeLine (forall (r :: Size).
IsSize r =>
Condition -> Operand 'RW r -> Operand 'RW r -> CodeLine
Cmov_ Condition
c Operand 'RW s
a Operand 'RW s
b)
rol :: Operand 'RW s -> Operand r 'S8 -> Code
rol Operand 'RW s
a Operand r 'S8
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' 'S8 -> CodeLine
Rol_ Operand 'RW s
a Operand r 'S8
b)
ror :: Operand 'RW s -> Operand r 'S8 -> Code
ror Operand 'RW s
a Operand r 'S8
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' 'S8 -> CodeLine
Ror_ Operand 'RW s
a Operand r 'S8
b)
rcl :: Operand 'RW s -> Operand r 'S8 -> Code
rcl Operand 'RW s
a Operand r 'S8
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' 'S8 -> CodeLine
Rcl_ Operand 'RW s
a Operand r 'S8
b)
rcr :: Operand 'RW s -> Operand r 'S8 -> Code
rcr Operand 'RW s
a Operand r 'S8
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' 'S8 -> CodeLine
Rcr_ Operand 'RW s
a Operand r 'S8
b)
shl :: Operand 'RW s -> Operand r 'S8 -> Code
shl Operand 'RW s
a Operand r 'S8
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' 'S8 -> CodeLine
Shl_ Operand 'RW s
a Operand r 'S8
b)
shr :: Operand 'RW s -> Operand r 'S8 -> Code
shr Operand 'RW s
a Operand r 'S8
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' 'S8 -> CodeLine
Shr_ Operand 'RW s
a Operand r 'S8
b)
sar :: Operand 'RW s -> Operand r 'S8 -> Code
sar Operand 'RW s
a Operand r 'S8
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Access).
IsSize r =>
Operand 'RW r -> Operand s' 'S8 -> CodeLine
Sar_ Operand 'RW s
a Operand r 'S8
b)
xchg :: Operand 'RW s -> Operand 'RW s -> Code
xchg Operand 'RW s
a Operand 'RW s
b   = CodeLine -> Code
mkCodeLine (forall (r :: Size).
IsSize r =>
Operand 'RW r -> Operand 'RW r -> CodeLine
Xchg_ Operand 'RW s
a Operand 'RW s
b)
movd :: Operand 'RW s -> Operand r s' -> Code
movd   Operand 'RW s
a Operand r s'
b = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Size) (r :: Access).
(IsSize r, IsSize s') =>
Operand 'RW r -> Operand r s' -> CodeLine
Movd_   Operand 'RW s
a Operand r s'
b)
movq :: Operand 'RW s -> Operand r s' -> Code
movq   Operand 'RW s
a Operand r s'
b = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Size) (r :: Access).
(IsSize r, IsSize s') =>
Operand 'RW r -> Operand r s' -> CodeLine
Movq_   Operand 'RW s
a Operand r s'
b)
movdqa :: Operand 'RW 'S128 -> Operand r 'S128 -> Code
movdqa Operand 'RW 'S128
a Operand r 'S128
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S128 -> CodeLine
Movdqa_ Operand 'RW 'S128
a Operand r 'S128
b)
paddb :: Operand 'RW 'S128 -> Operand r 'S128 -> Code
paddb  Operand 'RW 'S128
a Operand r 'S128
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S128 -> CodeLine
Paddb_  Operand 'RW 'S128
a Operand r 'S128
b)
paddw :: Operand 'RW 'S128 -> Operand r 'S128 -> Code
paddw  Operand 'RW 'S128
a Operand r 'S128
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S128 -> CodeLine
Paddw_  Operand 'RW 'S128
a Operand r 'S128
b)
paddd :: Operand 'RW 'S128 -> Operand r 'S128 -> Code
paddd  Operand 'RW 'S128
a Operand r 'S128
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S128 -> CodeLine
Paddd_  Operand 'RW 'S128
a Operand r 'S128
b)
paddq :: Operand 'RW 'S128 -> Operand r 'S128 -> Code
paddq  Operand 'RW 'S128
a Operand r 'S128
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S128 -> CodeLine
Paddq_  Operand 'RW 'S128
a Operand r 'S128
b)
psubb :: Operand 'RW 'S128 -> Operand r 'S128 -> Code
psubb  Operand 'RW 'S128
a Operand r 'S128
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S128 -> CodeLine
Psubb_  Operand 'RW 'S128
a Operand r 'S128
b)
psubw :: Operand 'RW 'S128 -> Operand r 'S128 -> Code
psubw  Operand 'RW 'S128
a Operand r 'S128
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S128 -> CodeLine
Psubw_  Operand 'RW 'S128
a Operand r 'S128
b)
psubd :: Operand 'RW 'S128 -> Operand r 'S128 -> Code
psubd  Operand 'RW 'S128
a Operand r 'S128
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S128 -> CodeLine
Psubd_  Operand 'RW 'S128
a Operand r 'S128
b)
psubq :: Operand 'RW 'S128 -> Operand r 'S128 -> Code
psubq  Operand 'RW 'S128
a Operand r 'S128
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S128 -> CodeLine
Psubq_  Operand 'RW 'S128
a Operand r 'S128
b)
pxor :: Operand 'RW 'S128 -> Operand r 'S128 -> Code
pxor   Operand 'RW 'S128
a Operand r 'S128
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S128 -> CodeLine
Pxor_   Operand 'RW 'S128
a Operand r 'S128
b)
psllw :: Operand 'RW 'S128 -> Operand r 'S8 -> Code
psllw  Operand 'RW 'S128
a Operand r 'S8
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S8 -> CodeLine
Psllw_  Operand 'RW 'S128
a Operand r 'S8
b)
pslld :: Operand 'RW 'S128 -> Operand r 'S8 -> Code
pslld  Operand 'RW 'S128
a Operand r 'S8
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S8 -> CodeLine
Pslld_  Operand 'RW 'S128
a Operand r 'S8
b)
psllq :: Operand 'RW 'S128 -> Operand r 'S8 -> Code
psllq  Operand 'RW 'S128
a Operand r 'S8
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S8 -> CodeLine
Psllq_  Operand 'RW 'S128
a Operand r 'S8
b)
pslldq :: Operand 'RW 'S128 -> Operand r 'S8 -> Code
pslldq Operand 'RW 'S128
a Operand r 'S8
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S8 -> CodeLine
Pslldq_ Operand 'RW 'S128
a Operand r 'S8
b)
psrlw :: Operand 'RW 'S128 -> Operand r 'S8 -> Code
psrlw  Operand 'RW 'S128
a Operand r 'S8
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S8 -> CodeLine
Psrlw_  Operand 'RW 'S128
a Operand r 'S8
b)
psrld :: Operand 'RW 'S128 -> Operand r 'S8 -> Code
psrld  Operand 'RW 'S128
a Operand r 'S8
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S8 -> CodeLine
Psrld_  Operand 'RW 'S128
a Operand r 'S8
b)
psrlq :: Operand 'RW 'S128 -> Operand r 'S8 -> Code
psrlq  Operand 'RW 'S128
a Operand r 'S8
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S8 -> CodeLine
Psrlq_  Operand 'RW 'S128
a Operand r 'S8
b)
psrldq :: Operand 'RW 'S128 -> Operand r 'S8 -> Code
psrldq Operand 'RW 'S128
a Operand r 'S8
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S8 -> CodeLine
Psrldq_ Operand 'RW 'S128
a Operand r 'S8
b)
psraw :: Operand 'RW 'S128 -> Operand r 'S8 -> Code
psraw  Operand 'RW 'S128
a Operand r 'S8
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S8 -> CodeLine
Psraw_  Operand 'RW 'S128
a Operand r 'S8
b)
psrad :: Operand 'RW 'S128 -> Operand r 'S8 -> Code
psrad  Operand 'RW 'S128
a Operand r 'S8
b = CodeLine -> Code
mkCodeLine (forall (r :: Access).
Operand 'RW 'S128 -> Operand r 'S8 -> CodeLine
Psrad_  Operand 'RW 'S128
a Operand r 'S8
b)
lea :: Operand 'RW s -> Operand 'RW s' -> Code
lea Operand 'RW s
a Operand 'RW s'
b    = CodeLine -> Code
mkCodeLine (forall (r :: Size) (s' :: Size).
(IsSize r, IsSize s') =>
Operand 'RW r -> Operand 'RW s' -> CodeLine
Lea_ Operand 'RW s
a Operand 'RW s'
b)
j :: Condition -> Label -> Code
j Condition
a Label
c      = CodeLine -> Code
mkCodeLine (Condition -> Maybe Size -> Label -> CodeLine
J_ Condition
a forall a. Maybe a
Nothing Label
c)
pop :: Operand 'RW 'S64 -> Code
pop Operand 'RW 'S64
a      = CodeLine -> Code
mkCodeLine (Operand 'RW 'S64 -> CodeLine
Pop_ Operand 'RW 'S64
a)
push :: Operand r 'S64 -> Code
push Operand r 'S64
a     = CodeLine -> Code
mkCodeLine (forall (r :: Access). Operand r 'S64 -> CodeLine
Push_ Operand r 'S64
a)
call :: Operand r 'S64 -> Code
call Operand r 'S64
a     = CodeLine -> Code
mkCodeLine (forall (r :: Access). Operand r 'S64 -> CodeLine
Call_ Operand r 'S64
a)
jmpq :: Operand r 'S64 -> Code
jmpq Operand r 'S64
a     = CodeLine -> Code
mkCodeLine (forall (r :: Access). Operand r 'S64 -> CodeLine
Jmpq_ Operand r 'S64
a)
jmp :: Label -> Code
jmp Label
b      = CodeLine -> Code
mkCodeLine (Maybe Size -> Label -> CodeLine
Jmp_ forall a. Maybe a
Nothing Label
b)
db :: [Word8] -> Code
db [Word8]
a       = CodeLine -> Code
mkCodeLine ([Word8] -> CodeLine
Data_ [Word8]
a)
align :: Int -> Code
align Int
a    = CodeLine -> Code
mkCodeLine (Int -> CodeLine
Align_ Int
a)

label :: CodeM Label
label :: CodeM Label
label = do
  Int
i <- forall a. StateT Int (WriterT LCode Identity) a -> CodeM a
CodeM forall (m :: * -> *). MonadState m => m (StateType m)
get
  forall a. StateT Int (WriterT LCode Identity) a -> CodeM a
CodeM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadState m => StateType m -> m ()
put forall a b. (a -> b) -> a -> b
$ Int
iforall a. Num a => a -> a -> a
+Int
1
  CodeLine -> Code
mkCodeLine CodeLine
Label_
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Label
Label Int
i

mkCodeLine :: CodeLine -> Code
mkCodeLine :: CodeLine -> Code
mkCodeLine CodeLine
x = forall a. StateT Int (WriterT LCode Identity) a -> CodeM a
CodeM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell forall a b. (a -> b) -> a -> b
$ CodeBuilder -> CodeLine -> LCode
CodeLine (CodeBuilder
tellAddr forall a. Semigroup a => a -> a -> a
<> CodeLine -> CodeBuilder
mkCodeBuilder' CodeLine
x) CodeLine
x

tellAddr :: CodeBuilder
tellAddr = Int
-> Int
-> WriterT CodeBuilderRes CodeBuilderTardis ()
-> CodeBuilder
CodeBuilder Int
0 Int
0 forall a b. (a -> b) -> a -> b
$ do
  (Int
c, [Int]
_, [[(Size, Int, Int)]]
_) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall bw fw (m :: * -> *). MonadTardis bw fw m => m fw
getPast
  forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell [forall a b. a -> Either a b
Left Int
c]

showCode :: LCode -> StateT Int (WriterT [[Char]] Identity) ()
showCode = \case
  LCode
EmptyCode  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  AppendCode CodeBuilder
_ LCode
a LCode
b -> LCode -> StateT Int (WriterT [[Char]] Identity) ()
showCode LCode
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LCode -> StateT Int (WriterT [[Char]] Identity) ()
showCode LCode
b
  Prebuilt Vector Word8
_ LCode
c -> CodeLine -> StateT Int (WriterT [[Char]] Identity) ()
showCodeLine (Int -> CodeLine
Align_ Int
4) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
codeLine [Char]
"{" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LCode -> StateT Int (WriterT [[Char]] Identity) ()
showCode LCode
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {m :: * -> *} {a}.
(WriterType m ~ [a], MonadWriter m) =>
a -> m ()
codeLine [Char]
"}"
  CodeLine CodeBuilder
_ CodeLine
x -> CodeLine -> StateT Int (WriterT [[Char]] Identity) ()
showCodeLine CodeLine
x