{-# LANGUAGE OverloadedStrings #-}
module Htcc.Asm.Intrinsic.Structure.Section.Text.Instruction (
SizeUnit (..),
UnaryInstruction (..),
BinaryInstruction (..),
Offset (..),
Ptr (..),
sete, setne, setl, setle, setg, setge,
byte, word, dword,
cqo, ret, leave,
jmp, je, jne, jnz,
call
) where
import qualified Data.Text as T
import Numeric.Natural
import Htcc.Asm.Intrinsic.Operand (IsOperand (..),
Ref (..))
import Htcc.Asm.Intrinsic.Register (Register (..))
import qualified Htcc.Asm.Intrinsic.Structure.Internal as I
import Htcc.Asm.Intrinsic.Structure.Section.Text.Directive
import Htcc.Utils (tshow)
{-# INLINE intelSyntaxUnary #-}
intelSyntaxUnary :: Show a => T.Text -> a -> I.Asm TextLabelCtx e ()
intelSyntaxUnary :: Text -> a -> Asm TextLabelCtx e ()
intelSyntaxUnary inst :: Text
inst arg :: a
arg = Text -> Asm TextLabelCtx e ()
forall ctx e. Text -> Asm ctx e ()
I.putStrLnWithIndent (Text -> Asm TextLabelCtx e ()) -> Text -> Asm TextLabelCtx e ()
forall a b. (a -> b) -> a -> b
$ Text
inst Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
tshow a
arg
{-# INLINE intelSyntaxBinary #-}
intelSyntaxBinary :: (Show a, Show b) => T.Text -> a -> b -> I.Asm TextLabelCtx e ()
intelSyntaxBinary :: Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary inst :: Text
inst lhs :: a
lhs rhs :: b
rhs = Text -> Asm TextLabelCtx e ()
forall ctx e. Text -> Asm ctx e ()
I.putStrLnWithIndent (Text -> Asm TextLabelCtx e ()) -> Text -> Asm TextLabelCtx e ()
forall a b. (a -> b) -> a -> b
$ Text
inst Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
tshow a
lhs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> b -> Text
forall a. Show a => a -> Text
tshow b
rhs
data SizeUnit = Byte
| Word
| DWord
deriving (SizeUnit -> SizeUnit -> Bool
(SizeUnit -> SizeUnit -> Bool)
-> (SizeUnit -> SizeUnit -> Bool) -> Eq SizeUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SizeUnit -> SizeUnit -> Bool
$c/= :: SizeUnit -> SizeUnit -> Bool
== :: SizeUnit -> SizeUnit -> Bool
$c== :: SizeUnit -> SizeUnit -> Bool
Eq, Eq SizeUnit
Eq SizeUnit =>
(SizeUnit -> SizeUnit -> Ordering)
-> (SizeUnit -> SizeUnit -> Bool)
-> (SizeUnit -> SizeUnit -> Bool)
-> (SizeUnit -> SizeUnit -> Bool)
-> (SizeUnit -> SizeUnit -> Bool)
-> (SizeUnit -> SizeUnit -> SizeUnit)
-> (SizeUnit -> SizeUnit -> SizeUnit)
-> Ord SizeUnit
SizeUnit -> SizeUnit -> Bool
SizeUnit -> SizeUnit -> Ordering
SizeUnit -> SizeUnit -> SizeUnit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SizeUnit -> SizeUnit -> SizeUnit
$cmin :: SizeUnit -> SizeUnit -> SizeUnit
max :: SizeUnit -> SizeUnit -> SizeUnit
$cmax :: SizeUnit -> SizeUnit -> SizeUnit
>= :: SizeUnit -> SizeUnit -> Bool
$c>= :: SizeUnit -> SizeUnit -> Bool
> :: SizeUnit -> SizeUnit -> Bool
$c> :: SizeUnit -> SizeUnit -> Bool
<= :: SizeUnit -> SizeUnit -> Bool
$c<= :: SizeUnit -> SizeUnit -> Bool
< :: SizeUnit -> SizeUnit -> Bool
$c< :: SizeUnit -> SizeUnit -> Bool
compare :: SizeUnit -> SizeUnit -> Ordering
$ccompare :: SizeUnit -> SizeUnit -> Ordering
$cp1Ord :: Eq SizeUnit
Ord, Int -> SizeUnit
SizeUnit -> Int
SizeUnit -> [SizeUnit]
SizeUnit -> SizeUnit
SizeUnit -> SizeUnit -> [SizeUnit]
SizeUnit -> SizeUnit -> SizeUnit -> [SizeUnit]
(SizeUnit -> SizeUnit)
-> (SizeUnit -> SizeUnit)
-> (Int -> SizeUnit)
-> (SizeUnit -> Int)
-> (SizeUnit -> [SizeUnit])
-> (SizeUnit -> SizeUnit -> [SizeUnit])
-> (SizeUnit -> SizeUnit -> [SizeUnit])
-> (SizeUnit -> SizeUnit -> SizeUnit -> [SizeUnit])
-> Enum SizeUnit
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SizeUnit -> SizeUnit -> SizeUnit -> [SizeUnit]
$cenumFromThenTo :: SizeUnit -> SizeUnit -> SizeUnit -> [SizeUnit]
enumFromTo :: SizeUnit -> SizeUnit -> [SizeUnit]
$cenumFromTo :: SizeUnit -> SizeUnit -> [SizeUnit]
enumFromThen :: SizeUnit -> SizeUnit -> [SizeUnit]
$cenumFromThen :: SizeUnit -> SizeUnit -> [SizeUnit]
enumFrom :: SizeUnit -> [SizeUnit]
$cenumFrom :: SizeUnit -> [SizeUnit]
fromEnum :: SizeUnit -> Int
$cfromEnum :: SizeUnit -> Int
toEnum :: Int -> SizeUnit
$ctoEnum :: Int -> SizeUnit
pred :: SizeUnit -> SizeUnit
$cpred :: SizeUnit -> SizeUnit
succ :: SizeUnit -> SizeUnit
$csucc :: SizeUnit -> SizeUnit
Enum, SizeUnit
SizeUnit -> SizeUnit -> Bounded SizeUnit
forall a. a -> a -> Bounded a
maxBound :: SizeUnit
$cmaxBound :: SizeUnit
minBound :: SizeUnit
$cminBound :: SizeUnit
Bounded)
instance Show SizeUnit where
show :: SizeUnit -> String
show Byte = "byte"
show Word = "word"
show DWord = "dword"
newtype Offset = Offset T.Text
instance Show Offset where
show :: Offset -> String
show (Offset s :: Text
s) = "offset " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
s
data Ptr a = Ptr SizeUnit (Ref a)
instance IsOperand a => Show (Ptr a) where
show :: Ptr a -> String
show (Ptr u :: SizeUnit
u s :: Ref a
s) = SizeUnit -> String
forall a. Show a => a -> String
show SizeUnit
u String -> ShowS
forall a. [a] -> [a] -> [a]
++ " ptr " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ref a -> String
forall a. Show a => a -> String
show Ref a
s
byte :: IsOperand a => (SizeUnit -> Ref a -> Ptr a) -> Ref a -> Ptr a
byte :: (SizeUnit -> Ref a -> Ptr a) -> Ref a -> Ptr a
byte = ((SizeUnit -> Ref a -> Ptr a) -> SizeUnit -> Ref a -> Ptr a)
-> SizeUnit -> (SizeUnit -> Ref a -> Ptr a) -> Ref a -> Ptr a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SizeUnit -> Ref a -> Ptr a) -> SizeUnit -> Ref a -> Ptr a
forall a. a -> a
id SizeUnit
Byte
word :: IsOperand a => (SizeUnit -> Ref a -> Ptr a) -> Ref a -> Ptr a
word :: (SizeUnit -> Ref a -> Ptr a) -> Ref a -> Ptr a
word = ((SizeUnit -> Ref a -> Ptr a) -> SizeUnit -> Ref a -> Ptr a)
-> SizeUnit -> (SizeUnit -> Ref a -> Ptr a) -> Ref a -> Ptr a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SizeUnit -> Ref a -> Ptr a) -> SizeUnit -> Ref a -> Ptr a
forall a. a -> a
id SizeUnit
Word
dword :: IsOperand a => (SizeUnit -> Ref a -> Ptr a) -> Ref a -> Ptr a
dword :: (SizeUnit -> Ref a -> Ptr a) -> Ref a -> Ptr a
dword = ((SizeUnit -> Ref a -> Ptr a) -> SizeUnit -> Ref a -> Ptr a)
-> SizeUnit -> (SizeUnit -> Ref a -> Ptr a) -> Ref a -> Ptr a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SizeUnit -> Ref a -> Ptr a) -> SizeUnit -> Ref a -> Ptr a
forall a. a -> a
id SizeUnit
DWord
class Show a => UnaryInstruction a where
push :: a -> I.Asm TextLabelCtx e ()
push = Text -> a -> Asm TextLabelCtx e ()
forall a e. Show a => Text -> a -> Asm TextLabelCtx e ()
intelSyntaxUnary "push"
pop :: a -> I.Asm TextLabelCtx e ()
pop = Text -> a -> Asm TextLabelCtx e ()
forall a e. Show a => Text -> a -> Asm TextLabelCtx e ()
intelSyntaxUnary "pop"
pushl :: a -> I.Asm TextLabelCtx e ()
pushl = Text -> a -> Asm TextLabelCtx e ()
forall a e. Show a => Text -> a -> Asm TextLabelCtx e ()
intelSyntaxUnary "pushl"
popl :: a -> I.Asm TextLabelCtx e ()
popl = Text -> a -> Asm TextLabelCtx e ()
forall a e. Show a => Text -> a -> Asm TextLabelCtx e ()
intelSyntaxUnary "popl"
idiv :: a -> I.Asm TextLabelCtx e ()
idiv = Text -> a -> Asm TextLabelCtx e ()
forall a e. Show a => Text -> a -> Asm TextLabelCtx e ()
intelSyntaxUnary "idiv"
not :: a -> I.Asm TextLabelCtx e ()
not = Text -> a -> Asm TextLabelCtx e ()
forall a e. Show a => Text -> a -> Asm TextLabelCtx e ()
intelSyntaxUnary "not"
sete :: Register -> I.Asm TextLabelCtx e ()
sete :: Register -> Asm TextLabelCtx e ()
sete = Text -> Register -> Asm TextLabelCtx e ()
forall a e. Show a => Text -> a -> Asm TextLabelCtx e ()
intelSyntaxUnary "sete"
setne :: Register -> I.Asm TextLabelCtx e ()
setne :: Register -> Asm TextLabelCtx e ()
setne = Text -> Register -> Asm TextLabelCtx e ()
forall a e. Show a => Text -> a -> Asm TextLabelCtx e ()
intelSyntaxUnary "setne"
setl :: Register -> I.Asm TextLabelCtx e ()
setl :: Register -> Asm TextLabelCtx e ()
setl = Text -> Register -> Asm TextLabelCtx e ()
forall a e. Show a => Text -> a -> Asm TextLabelCtx e ()
intelSyntaxUnary "setl"
setle :: Register -> I.Asm TextLabelCtx e ()
setle :: Register -> Asm TextLabelCtx e ()
setle = Text -> Register -> Asm TextLabelCtx e ()
forall a e. Show a => Text -> a -> Asm TextLabelCtx e ()
intelSyntaxUnary "setle"
setg :: Register -> I.Asm TextLabelCtx e ()
setg :: Register -> Asm TextLabelCtx e ()
setg = Text -> Register -> Asm TextLabelCtx e ()
forall a e. Show a => Text -> a -> Asm TextLabelCtx e ()
intelSyntaxUnary "setg"
setge :: Register -> I.Asm TextLabelCtx e ()
setge :: Register -> Asm TextLabelCtx e ()
setge = Text -> Register -> Asm TextLabelCtx e ()
forall a e. Show a => Text -> a -> Asm TextLabelCtx e ()
intelSyntaxUnary "setge"
instance UnaryInstruction Integer
instance UnaryInstruction Int
instance UnaryInstruction Natural
instance UnaryInstruction Register
instance UnaryInstruction Offset
instance IsOperand a => UnaryInstruction (Ref a)
class Show a => BinaryInstruction a where
mov :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
mov = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "mov"
movl :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
movl = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "movl"
movsx :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
movsx = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "movsx"
movsxd :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
movsxd = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "movsxd"
movabs :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
movabs = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "movabs"
movzb :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
movzb = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "movzb"
cmp :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
cmp = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "cmp"
add :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
add = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "add"
sub :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
sub = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "sub"
imul :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
imul = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "imul"
and :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
and = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "and"
or :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
or = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "or"
xor :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
xor = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "xor"
shl :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
shl = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "shl"
sar :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
sar = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "sar"
lea :: BinaryInstruction b => a -> b -> I.Asm TextLabelCtx e ()
lea = Text -> a -> b -> Asm TextLabelCtx e ()
forall a b e.
(Show a, Show b) =>
Text -> a -> b -> Asm TextLabelCtx e ()
intelSyntaxBinary "lea"
instance BinaryInstruction Integer
instance BinaryInstruction Int
instance BinaryInstruction Natural
instance BinaryInstruction Register
instance BinaryInstruction Offset
instance (IsOperand a, BinaryInstruction a) => BinaryInstruction (Ptr a)
instance IsOperand a => BinaryInstruction (Ref a)
cqo :: I.Asm TextLabelCtx e ()
cqo :: Asm TextLabelCtx e ()
cqo = Text -> Asm TextLabelCtx e ()
forall ctx e. Text -> Asm ctx e ()
I.putStrLnWithIndent "cqo"
ret :: I.Asm TextLabelCtx e ()
ret :: Asm TextLabelCtx e ()
ret = Text -> Asm TextLabelCtx e ()
forall ctx e. Text -> Asm ctx e ()
I.putStrLnWithIndent "ret"
leave :: I.Asm TextLabelCtx e ()
leave :: Asm TextLabelCtx e ()
leave = Text -> Asm TextLabelCtx e ()
forall ctx e. Text -> Asm ctx e ()
I.putStrLnWithIndent "leave"
jmp :: I.Asm TargetLabelCtx e () -> I.Asm TextLabelCtx e ()
jmp :: Asm TargetLabelCtx e () -> Asm TextLabelCtx e ()
jmp asm :: Asm TargetLabelCtx e ()
asm = Text -> Asm TextLabelCtx e ()
forall ctx e. Text -> Asm ctx e ()
I.putStrWithIndent "jmp " Asm TextLabelCtx e ()
-> Asm TextLabelCtx e () -> Asm TextLabelCtx e ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Asm TargetLabelCtx e () -> Asm TextLabelCtx e ()
forall ctx e a ctx'. Asm ctx e a -> Asm ctx' e a
I.unCtx Asm TargetLabelCtx e ()
asm
je :: I.Asm TargetLabelCtx e () -> I.Asm TextLabelCtx e ()
je :: Asm TargetLabelCtx e () -> Asm TextLabelCtx e ()
je asm :: Asm TargetLabelCtx e ()
asm = Text -> Asm TextLabelCtx e ()
forall ctx e. Text -> Asm ctx e ()
I.putStrWithIndent "je " Asm TextLabelCtx e ()
-> Asm TextLabelCtx e () -> Asm TextLabelCtx e ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Asm TargetLabelCtx e () -> Asm TextLabelCtx e ()
forall ctx e a ctx'. Asm ctx e a -> Asm ctx' e a
I.unCtx Asm TargetLabelCtx e ()
asm
jne :: I.Asm TargetLabelCtx e () -> I.Asm TextLabelCtx e ()
jne :: Asm TargetLabelCtx e () -> Asm TextLabelCtx e ()
jne asm :: Asm TargetLabelCtx e ()
asm = Text -> Asm TextLabelCtx e ()
forall ctx e. Text -> Asm ctx e ()
I.putStrWithIndent "jne " Asm TextLabelCtx e ()
-> Asm TextLabelCtx e () -> Asm TextLabelCtx e ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Asm TargetLabelCtx e () -> Asm TextLabelCtx e ()
forall ctx e a ctx'. Asm ctx e a -> Asm ctx' e a
I.unCtx Asm TargetLabelCtx e ()
asm
jnz :: I.Asm TargetLabelCtx e () -> I.Asm TextLabelCtx e ()
jnz :: Asm TargetLabelCtx e () -> Asm TextLabelCtx e ()
jnz asm :: Asm TargetLabelCtx e ()
asm = Text -> Asm TextLabelCtx e ()
forall ctx e. Text -> Asm ctx e ()
I.putStrWithIndent "jnz " Asm TextLabelCtx e ()
-> Asm TextLabelCtx e () -> Asm TextLabelCtx e ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Asm TargetLabelCtx e () -> Asm TextLabelCtx e ()
forall ctx e a ctx'. Asm ctx e a -> Asm ctx' e a
I.unCtx Asm TargetLabelCtx e ()
asm
call :: T.Text -> I.Asm TextLabelCtx e ()
call :: Text -> Asm TextLabelCtx e ()
call = Text -> Text -> Asm TextLabelCtx e ()
forall a e. Show a => Text -> a -> Asm TextLabelCtx e ()
intelSyntaxUnary "call"