{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}

module Kempe.Asm.X86.Type ( X86 (..)
                          , Addr (..)
                          , AbsReg (..)
                          , X86Reg (..)
                          , ControlAnn (..)
                          , Liveness (..)
                          , Label
                          , prettyAsm
                          , prettyDebugAsm
                          ) where

import           Control.DeepSeq         (NFData)
import qualified Data.ByteString         as BS
import qualified Data.ByteString.Lazy    as BSL
import           Data.Foldable           (toList)
import           Data.Int                (Int64, Int8)
import           Data.Semigroup          ((<>))
import qualified Data.Set                as S
import           Data.Text.Encoding      (decodeUtf8)
import qualified Data.Text.Lazy.Encoding as TL
import           Data.Word               (Word8)
import           GHC.Generics            (Generic)
import           Prettyprinter           (Doc, Pretty (pretty), braces, brackets, colon, concatWith, hardline, indent, punctuate, (<+>))
import           Prettyprinter.Ext

type Label = Word

data Liveness = Liveness { Liveness -> Set AbsReg
ins :: !(S.Set AbsReg), Liveness -> Set AbsReg
out :: !(S.Set AbsReg) } -- strictness annotations make it perform better
    deriving (Liveness -> Liveness -> Bool
(Liveness -> Liveness -> Bool)
-> (Liveness -> Liveness -> Bool) -> Eq Liveness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Liveness -> Liveness -> Bool
$c/= :: Liveness -> Liveness -> Bool
== :: Liveness -> Liveness -> Bool
$c== :: Liveness -> Liveness -> Bool
Eq, (forall x. Liveness -> Rep Liveness x)
-> (forall x. Rep Liveness x -> Liveness) -> Generic Liveness
forall x. Rep Liveness x -> Liveness
forall x. Liveness -> Rep Liveness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Liveness x -> Liveness
$cfrom :: forall x. Liveness -> Rep Liveness x
Generic, Liveness -> ()
(Liveness -> ()) -> NFData Liveness
forall a. (a -> ()) -> NFData a
rnf :: Liveness -> ()
$crnf :: Liveness -> ()
NFData)

instance Pretty Liveness where
    pretty :: Liveness -> Doc ann
pretty (Liveness Set AbsReg
is Set AbsReg
os) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Set AbsReg -> Doc ann
forall ann. Set AbsReg -> Doc ann
pp Set AbsReg
is Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
";" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Set AbsReg -> Doc ann
forall ann. Set AbsReg -> Doc ann
pp Set AbsReg
os)
        where pp :: Set AbsReg -> Doc ann
pp = [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ([Doc ann] -> Doc ann)
-> (Set AbsReg -> [Doc ann]) -> Set AbsReg -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
"," ([Doc ann] -> [Doc ann])
-> (Set AbsReg -> [Doc ann]) -> Set AbsReg -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbsReg -> Doc ann) -> [AbsReg] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AbsReg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([AbsReg] -> [Doc ann])
-> (Set AbsReg -> [AbsReg]) -> Set AbsReg -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set AbsReg -> [AbsReg]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

data ControlAnn = ControlAnn { ControlAnn -> Int
node     :: !Int
                             , ControlAnn -> [Int]
conn     :: [Int]
                             , ControlAnn -> Set AbsReg
usesNode :: S.Set AbsReg
                             , ControlAnn -> Set AbsReg
defsNode :: S.Set AbsReg
                             } deriving ((forall x. ControlAnn -> Rep ControlAnn x)
-> (forall x. Rep ControlAnn x -> ControlAnn) -> Generic ControlAnn
forall x. Rep ControlAnn x -> ControlAnn
forall x. ControlAnn -> Rep ControlAnn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ControlAnn x -> ControlAnn
$cfrom :: forall x. ControlAnn -> Rep ControlAnn x
Generic, ControlAnn -> ()
(ControlAnn -> ()) -> NFData ControlAnn
forall a. (a -> ()) -> NFData a
rnf :: ControlAnn -> ()
$crnf :: ControlAnn -> ()
NFData)

-- currently just has 64-bit and 8-bit registers
data X86Reg = R8
            | R9
            | R10
            | R11
            | R12
            | R13
            | R14
            | R15
            | Rdi -- can I use rsi/rdi??
            | Rsi
            -- -- | BH
            -- -- | BL
            | R8b
            | R9b
            | R10b
            | R11b
            | R12b
            | R13b
            | R14b
            | R15b
            | Sil
            | Dil
            | Rsp
            | Rbp
            | Rbx
            -- cl is reserved in this implementation which it really shouldn't be
            -- rax and rdx (and friends) are reserved for unsigned mult.
            | Rcx
            | CH
            | CL
            -- Rax, Rdx and friends are reserved for integer division (and
            -- unsigned multiplication lol)
            | Rax
            | Rdx
            | AH
            | AL
            | DH
            | DL
            deriving (X86Reg -> X86Reg -> Bool
(X86Reg -> X86Reg -> Bool)
-> (X86Reg -> X86Reg -> Bool) -> Eq X86Reg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: X86Reg -> X86Reg -> Bool
$c/= :: X86Reg -> X86Reg -> Bool
== :: X86Reg -> X86Reg -> Bool
$c== :: X86Reg -> X86Reg -> Bool
Eq, Eq X86Reg
Eq X86Reg
-> (X86Reg -> X86Reg -> Ordering)
-> (X86Reg -> X86Reg -> Bool)
-> (X86Reg -> X86Reg -> Bool)
-> (X86Reg -> X86Reg -> Bool)
-> (X86Reg -> X86Reg -> Bool)
-> (X86Reg -> X86Reg -> X86Reg)
-> (X86Reg -> X86Reg -> X86Reg)
-> Ord X86Reg
X86Reg -> X86Reg -> Bool
X86Reg -> X86Reg -> Ordering
X86Reg -> X86Reg -> X86Reg
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 :: X86Reg -> X86Reg -> X86Reg
$cmin :: X86Reg -> X86Reg -> X86Reg
max :: X86Reg -> X86Reg -> X86Reg
$cmax :: X86Reg -> X86Reg -> X86Reg
>= :: X86Reg -> X86Reg -> Bool
$c>= :: X86Reg -> X86Reg -> Bool
> :: X86Reg -> X86Reg -> Bool
$c> :: X86Reg -> X86Reg -> Bool
<= :: X86Reg -> X86Reg -> Bool
$c<= :: X86Reg -> X86Reg -> Bool
< :: X86Reg -> X86Reg -> Bool
$c< :: X86Reg -> X86Reg -> Bool
compare :: X86Reg -> X86Reg -> Ordering
$ccompare :: X86Reg -> X86Reg -> Ordering
$cp1Ord :: Eq X86Reg
Ord, Int -> X86Reg
X86Reg -> Int
X86Reg -> [X86Reg]
X86Reg -> X86Reg
X86Reg -> X86Reg -> [X86Reg]
X86Reg -> X86Reg -> X86Reg -> [X86Reg]
(X86Reg -> X86Reg)
-> (X86Reg -> X86Reg)
-> (Int -> X86Reg)
-> (X86Reg -> Int)
-> (X86Reg -> [X86Reg])
-> (X86Reg -> X86Reg -> [X86Reg])
-> (X86Reg -> X86Reg -> [X86Reg])
-> (X86Reg -> X86Reg -> X86Reg -> [X86Reg])
-> Enum X86Reg
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 :: X86Reg -> X86Reg -> X86Reg -> [X86Reg]
$cenumFromThenTo :: X86Reg -> X86Reg -> X86Reg -> [X86Reg]
enumFromTo :: X86Reg -> X86Reg -> [X86Reg]
$cenumFromTo :: X86Reg -> X86Reg -> [X86Reg]
enumFromThen :: X86Reg -> X86Reg -> [X86Reg]
$cenumFromThen :: X86Reg -> X86Reg -> [X86Reg]
enumFrom :: X86Reg -> [X86Reg]
$cenumFrom :: X86Reg -> [X86Reg]
fromEnum :: X86Reg -> Int
$cfromEnum :: X86Reg -> Int
toEnum :: Int -> X86Reg
$ctoEnum :: Int -> X86Reg
pred :: X86Reg -> X86Reg
$cpred :: X86Reg -> X86Reg
succ :: X86Reg -> X86Reg
$csucc :: X86Reg -> X86Reg
Enum, X86Reg
X86Reg -> X86Reg -> Bounded X86Reg
forall a. a -> a -> Bounded a
maxBound :: X86Reg
$cmaxBound :: X86Reg
minBound :: X86Reg
$cminBound :: X86Reg
Bounded, (forall x. X86Reg -> Rep X86Reg x)
-> (forall x. Rep X86Reg x -> X86Reg) -> Generic X86Reg
forall x. Rep X86Reg x -> X86Reg
forall x. X86Reg -> Rep X86Reg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep X86Reg x -> X86Reg
$cfrom :: forall x. X86Reg -> Rep X86Reg x
Generic, X86Reg -> ()
(X86Reg -> ()) -> NFData X86Reg
forall a. (a -> ()) -> NFData a
rnf :: X86Reg -> ()
$crnf :: X86Reg -> ()
NFData)

instance Pretty X86Reg where
    pretty :: X86Reg -> Doc ann
pretty X86Reg
Rax  = Doc ann
"rax"
    pretty X86Reg
Rcx  = Doc ann
"rcx"
    pretty X86Reg
Rdx  = Doc ann
"rdx"
    pretty X86Reg
Rsp  = Doc ann
"rsp"
    pretty X86Reg
Rbp  = Doc ann
"rbp"
    pretty X86Reg
AH   = Doc ann
"ah"
    pretty X86Reg
AL   = Doc ann
"al"
    pretty X86Reg
CH   = Doc ann
"ch"
    pretty X86Reg
CL   = Doc ann
"cl"
    pretty X86Reg
DH   = Doc ann
"dh"
    pretty X86Reg
DL   = Doc ann
"dl"
    pretty X86Reg
Rbx  = Doc ann
"rbx"
    pretty X86Reg
R8   = Doc ann
"r8"
    pretty X86Reg
R9   = Doc ann
"r9"
    pretty X86Reg
R10  = Doc ann
"r10"
    pretty X86Reg
R11  = Doc ann
"r11"
    pretty X86Reg
R12  = Doc ann
"r12"
    pretty X86Reg
R13  = Doc ann
"r13"
    pretty X86Reg
R14  = Doc ann
"r14"
    pretty X86Reg
R15  = Doc ann
"r15"
    pretty X86Reg
R8b  = Doc ann
"r8b"
    pretty X86Reg
R9b  = Doc ann
"r9b"
    pretty X86Reg
R10b = Doc ann
"r10b"
    pretty X86Reg
R11b = Doc ann
"r11b"
    pretty X86Reg
R12b = Doc ann
"r12b"
    pretty X86Reg
R13b = Doc ann
"r13b"
    pretty X86Reg
R14b = Doc ann
"r14b"
    pretty X86Reg
R15b = Doc ann
"r15b"
    pretty X86Reg
Rsi  = Doc ann
"rsi"
    pretty X86Reg
Rdi  = Doc ann
"rdi"
    pretty X86Reg
Sil  = Doc ann
"sil"
    pretty X86Reg
Dil  = Doc ann
"dil"

data AbsReg = DataPointer
            | AllocReg64 !Int -- TODO: register by size
            | AllocReg8 !Int
            | CArg1
            | CArg2
            | CArg3
            | CArg4
            | CArg5
            | CArg6
            | CRet -- x0 on aarch64
            | ShiftExponent
            | QuotRes -- quotient register for idiv, rax
            | RemRes -- remainder register for idiv, rdx
            deriving (AbsReg -> AbsReg -> Bool
(AbsReg -> AbsReg -> Bool)
-> (AbsReg -> AbsReg -> Bool) -> Eq AbsReg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbsReg -> AbsReg -> Bool
$c/= :: AbsReg -> AbsReg -> Bool
== :: AbsReg -> AbsReg -> Bool
$c== :: AbsReg -> AbsReg -> Bool
Eq, Eq AbsReg
Eq AbsReg
-> (AbsReg -> AbsReg -> Ordering)
-> (AbsReg -> AbsReg -> Bool)
-> (AbsReg -> AbsReg -> Bool)
-> (AbsReg -> AbsReg -> Bool)
-> (AbsReg -> AbsReg -> Bool)
-> (AbsReg -> AbsReg -> AbsReg)
-> (AbsReg -> AbsReg -> AbsReg)
-> Ord AbsReg
AbsReg -> AbsReg -> Bool
AbsReg -> AbsReg -> Ordering
AbsReg -> AbsReg -> AbsReg
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 :: AbsReg -> AbsReg -> AbsReg
$cmin :: AbsReg -> AbsReg -> AbsReg
max :: AbsReg -> AbsReg -> AbsReg
$cmax :: AbsReg -> AbsReg -> AbsReg
>= :: AbsReg -> AbsReg -> Bool
$c>= :: AbsReg -> AbsReg -> Bool
> :: AbsReg -> AbsReg -> Bool
$c> :: AbsReg -> AbsReg -> Bool
<= :: AbsReg -> AbsReg -> Bool
$c<= :: AbsReg -> AbsReg -> Bool
< :: AbsReg -> AbsReg -> Bool
$c< :: AbsReg -> AbsReg -> Bool
compare :: AbsReg -> AbsReg -> Ordering
$ccompare :: AbsReg -> AbsReg -> Ordering
$cp1Ord :: Eq AbsReg
Ord, (forall x. AbsReg -> Rep AbsReg x)
-> (forall x. Rep AbsReg x -> AbsReg) -> Generic AbsReg
forall x. Rep AbsReg x -> AbsReg
forall x. AbsReg -> Rep AbsReg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AbsReg x -> AbsReg
$cfrom :: forall x. AbsReg -> Rep AbsReg x
Generic, AbsReg -> ()
(AbsReg -> ()) -> NFData AbsReg
forall a. (a -> ()) -> NFData a
rnf :: AbsReg -> ()
$crnf :: AbsReg -> ()
NFData)

instance Pretty AbsReg where
    pretty :: AbsReg -> Doc ann
pretty AbsReg
DataPointer    = Doc ann
"datapointer"
    pretty (AllocReg64 Int
i) = Doc ann
"r" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i
    pretty (AllocReg8 Int
i)  = Doc ann
"HL" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i
    pretty AbsReg
CRet           = Doc ann
"rax"
    pretty AbsReg
CArg1          = Doc ann
"rdi"
    pretty AbsReg
CArg2          = Doc ann
"rsi"
    pretty AbsReg
CArg3          = Doc ann
"rdx"
    pretty AbsReg
CArg4          = Doc ann
"rcx"
    pretty AbsReg
CArg5          = Doc ann
"r8"
    pretty AbsReg
CArg6          = Doc ann
"r9"
    pretty AbsReg
ShiftExponent  = Doc ann
"cl"
    pretty AbsReg
QuotRes        = Doc ann
"rax"
    pretty AbsReg
RemRes         = Doc ann
"rdx"

-- [ebx+ecx*4h-20h]
data Addr reg = Reg reg
              | AddrRRPlus reg reg
              | AddrRCPlus reg Int64
              | AddrRCMinus reg Int64
              | AddrRRScale reg reg Int64
              deriving ((forall x. Addr reg -> Rep (Addr reg) x)
-> (forall x. Rep (Addr reg) x -> Addr reg) -> Generic (Addr reg)
forall x. Rep (Addr reg) x -> Addr reg
forall x. Addr reg -> Rep (Addr reg) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall reg x. Rep (Addr reg) x -> Addr reg
forall reg x. Addr reg -> Rep (Addr reg) x
$cto :: forall reg x. Rep (Addr reg) x -> Addr reg
$cfrom :: forall reg x. Addr reg -> Rep (Addr reg) x
Generic, Addr reg -> ()
(Addr reg -> ()) -> NFData (Addr reg)
forall reg. NFData reg => Addr reg -> ()
forall a. (a -> ()) -> NFData a
rnf :: Addr reg -> ()
$crnf :: forall reg. NFData reg => Addr reg -> ()
NFData)

-- TODO: sanity-check pass to make sure no Reg8's are in e.g. MovRCBool

-- parametric in @reg@; we do register allocation second
data X86 reg a = PushReg { X86 reg a -> a
ann :: a, X86 reg a -> reg
rSrc :: reg }
               | PushMem { ann :: a, X86 reg a -> Addr reg
addr :: Addr reg }
               | PopMem { ann :: a, addr :: Addr reg }
               | PopReg { ann :: a, X86 reg a -> reg
reg :: reg }
               | PushConst { ann :: a, X86 reg a -> Int64
iSrc :: Int64 }
               | Jump { ann :: a, X86 reg a -> Label
label :: Label }
               | Call { ann :: a, label :: Label }
               | CallBS { ann :: a, X86 reg a -> ByteString
bslLabel :: BSL.ByteString }
               | Ret { ann :: a }
               -- intel-ish syntax; destination first
               | MovRA { ann :: a, X86 reg a -> reg
rDest :: reg, X86 reg a -> Addr reg
addrSrc :: Addr reg }
               | MovAR { ann :: a, X86 reg a -> Addr reg
addrDest :: Addr reg, rSrc :: reg }
               | MovABool { ann :: a, addrDest :: Addr reg, X86 reg a -> Word8
boolSrc :: Word8 }
               | MovRR { ann :: a, rDest :: reg, rSrc :: reg } -- for convenience
               | MovRC { ann :: a, rDest :: reg, iSrc :: Int64 }
               | MovRL { ann :: a, rDest :: reg, X86 reg a -> ByteString
bsLabel :: BS.ByteString }
               | MovAC { ann :: a, addrDest :: Addr reg, iSrc :: Int64 }
               | MovACi8 { ann :: a, addrDest :: Addr reg, X86 reg a -> Int8
i8Src :: Int8 }
               | MovACTag { ann :: a, addrDest :: Addr reg, X86 reg a -> Word8
tagSrc :: Word8 }
               | MovRCBool { ann :: a, rDest :: reg, boolSrc :: Word8 }
               | MovRCi8 { ann :: a, rDest :: reg, i8Src :: Int8 }
               | MovRCTag { ann :: a, rDest :: reg, tagSrc :: Word8 }
               | MovRWord { ann :: a, rDest :: reg, X86 reg a -> Label
wSrc :: Word }
               | AddRR { ann :: a, X86 reg a -> reg
rAdd1 :: reg, X86 reg a -> reg
rAdd2 :: reg }
               | SubRR { ann :: a, X86 reg a -> reg
rSub1 :: reg, X86 reg a -> reg
rSub2 :: reg }
               | XorRR { ann :: a, X86 reg a -> reg
rXor1 :: reg, X86 reg a -> reg
rXor2 :: reg }
               | ImulRR { ann :: a, X86 reg a -> reg
rMul1 :: reg, X86 reg a -> reg
rMul2 :: reg }
               | AddAC { ann :: a, X86 reg a -> Addr reg
addrAdd1 :: Addr reg, X86 reg a -> Int64
iAdd2 :: Int64 }
               | AddRC { ann :: a, rAdd1 :: reg, iAdd2 :: Int64 }
               | SubRC { ann :: a, rSub1 :: reg, X86 reg a -> Int64
iSub2 :: Int64 }
               | ShiftLRR { ann :: a, rDest :: reg, rSrc :: reg }
               | ShiftRRR { ann :: a, rDest :: reg, rSrc :: reg }
               | Label { ann :: a, label :: Label }
               | BSLabel { ann :: a, bsLabel :: BS.ByteString }
               | Je { ann :: a, X86 reg a -> Label
jLabel :: Label }
               | Jne { ann :: a, jLabel :: Label }
               | Jg { ann :: a, jLabel :: Label }
               | Jge { ann :: a, jLabel :: Label }
               | Jl { ann :: a, jLabel :: Label }
               | Jle { ann :: a, jLabel :: Label }
               | CmpAddrReg { ann :: a, X86 reg a -> Addr reg
addrCmp :: Addr reg, X86 reg a -> reg
rCmp :: reg }
               | CmpRegReg { ann :: a, rCmp :: reg, X86 reg a -> reg
rCmp' :: reg } -- for simplicity
               | CmpAddrBool { ann :: a, addrCmp :: Addr reg, X86 reg a -> Word8
bCmp :: Word8 }
               | CmpRegBool { ann :: a, rCmp :: reg, bCmp :: Word8 }
               | IdivR { ann :: a, X86 reg a -> reg
rDiv :: reg }
               | DivR { ann :: a, rDiv :: reg }
               | Cqo { ann :: a }
               | AndRR { ann :: a, rDest :: reg, rSrc :: reg }
               | OrRR { ann :: a, rDest :: reg, rSrc :: reg }
               | PopcountRR { ann :: a, rDest :: reg, rSrc :: reg }
               | NegR { ann :: a, rSrc :: reg }
               | NasmMacro0 { ann :: a, X86 reg a -> ByteString
macroName :: BS.ByteString }
               deriving ((forall x. X86 reg a -> Rep (X86 reg a) x)
-> (forall x. Rep (X86 reg a) x -> X86 reg a)
-> Generic (X86 reg a)
forall x. Rep (X86 reg a) x -> X86 reg a
forall x. X86 reg a -> Rep (X86 reg a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall reg a x. Rep (X86 reg a) x -> X86 reg a
forall reg a x. X86 reg a -> Rep (X86 reg a) x
$cto :: forall reg a x. Rep (X86 reg a) x -> X86 reg a
$cfrom :: forall reg a x. X86 reg a -> Rep (X86 reg a) x
Generic, X86 reg a -> ()
(X86 reg a -> ()) -> NFData (X86 reg a)
forall a. (a -> ()) -> NFData a
forall reg a. (NFData a, NFData reg) => X86 reg a -> ()
rnf :: X86 reg a -> ()
$crnf :: forall reg a. (NFData a, NFData reg) => X86 reg a -> ()
NFData, a -> X86 reg b -> X86 reg a
(a -> b) -> X86 reg a -> X86 reg b
(forall a b. (a -> b) -> X86 reg a -> X86 reg b)
-> (forall a b. a -> X86 reg b -> X86 reg a) -> Functor (X86 reg)
forall a b. a -> X86 reg b -> X86 reg a
forall a b. (a -> b) -> X86 reg a -> X86 reg b
forall reg a b. a -> X86 reg b -> X86 reg a
forall reg a b. (a -> b) -> X86 reg a -> X86 reg b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> X86 reg b -> X86 reg a
$c<$ :: forall reg a b. a -> X86 reg b -> X86 reg a
fmap :: (a -> b) -> X86 reg a -> X86 reg b
$cfmap :: forall reg a b. (a -> b) -> X86 reg a -> X86 reg b
Functor)

i4 :: Doc ann -> Doc ann
i4 :: Doc ann -> Doc ann
i4 = Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
4

instance Pretty reg => Pretty (Addr reg) where
    pretty :: Addr reg -> Doc ann
pretty (Reg reg
r)               = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r)
    pretty (AddrRRPlus reg
r0 reg
r1)    = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"+" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (AddrRCPlus reg
r Int64
c)      = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"+" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
c)
    pretty (AddrRCMinus reg
r Int64
c)     = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"-" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
c)
    pretty (AddrRRScale reg
r0 reg
r1 Int64
c) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"+" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"*" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
c)

prettyLabel :: Label -> Doc ann
prettyLabel :: Label -> Doc ann
prettyLabel Label
l = Doc ann
"kmp_" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Label -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Label
l

prettyLive :: Pretty reg => X86 reg Liveness -> Doc ann
prettyLive :: X86 reg Liveness -> Doc ann
prettyLive X86 reg Liveness
r = X86 reg Liveness -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty X86 reg Liveness
r Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Liveness -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (X86 reg Liveness -> Liveness
forall reg a. X86 reg a -> a
ann X86 reg Liveness
r)

-- intel syntax
instance Pretty reg => Pretty (X86 reg a) where
    pretty :: X86 reg a -> Doc ann
pretty (PushReg a
_ reg
r)        = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"push" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r)
    pretty (PushMem a
_ Addr reg
a)        = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"push" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Addr reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Addr reg
a)
    pretty (PopMem a
_ Addr reg
a)         = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"pop qword" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Addr reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Addr reg
a)
    pretty (PopReg a
_ reg
r)         = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"pop" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r)
    pretty (PushConst a
_ Int64
i)      = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"push" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
i)
    pretty (Jump a
_ Label
l)           = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"jmp" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Label -> Doc ann
forall ann. Label -> Doc ann
prettyLabel Label
l)
    pretty (Call a
_ Label
l)           = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"call" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Label -> Doc ann
forall ann. Label -> Doc ann
prettyLabel Label
l)
    pretty Ret{}                = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 Doc ann
"ret"
    pretty (MovRA a
_ reg
r Addr reg
a)        = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Addr reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Addr reg
a)
    pretty (MovAR a
_ Addr reg
a reg
r)        = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Addr reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Addr reg
a Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r)
    pretty (MovABool a
_ Addr reg
a Word8
b)     = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov byte" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Addr reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Addr reg
a Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Word8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word8
b)
    pretty (MovACi8 a
_ Addr reg
a Int8
i)      = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov byte" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Addr reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Addr reg
a Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int8
i)
    pretty (MovRCi8 a
_ reg
r Int8
i)      = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov byte" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int8
i)
    pretty (MovRWord a
_ reg
r Label
w)     = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov qword" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Label -> Doc ann
forall a ann. (Integral a, Show a) => a -> Doc ann
prettyHex Label
w)
    pretty (MovRR a
_ reg
r0 reg
r1)      = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (MovRC a
_ reg
r Int64
i)        = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
i)
    pretty (MovAC a
_ Addr reg
a Int64
i)        = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov qword" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Addr reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Addr reg
a Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
i)
    pretty (MovRCBool a
_ reg
r Word8
b)    = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Word8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word8
b)
    pretty (MovRL a
_ reg
r ByteString
bl)       = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> Text
decodeUtf8 ByteString
bl))
    pretty (AddRR a
_ reg
r0 reg
r1)      = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"add" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (AddAC a
_ Addr reg
a Int64
c)        = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"add" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Addr reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Addr reg
a Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
c)
    pretty (SubRR a
_ reg
r0 reg
r1)      = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"sub" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (ImulRR a
_ reg
r0 reg
r1)     = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"imul" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (XorRR a
_ reg
r0 reg
r1)      = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"xor" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (AddRC a
_ reg
r0 Int64
c)       = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"add" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
c)
    pretty (SubRC a
_ reg
r0 Int64
c)       = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"sub" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
c)
    pretty (Label a
_ Label
l)          = Label -> Doc ann
forall ann. Label -> Doc ann
prettyLabel Label
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon
    pretty (BSLabel a
_ ByteString
b)        = let pl :: Doc ann
pl = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> Text
decodeUtf8 ByteString
b) in Doc ann
"global" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
pl Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
pl Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon
    pretty (Je a
_ Label
l)             = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"je" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Label -> Doc ann
forall ann. Label -> Doc ann
prettyLabel Label
l)
    pretty (Jl a
_ Label
l)             = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"jl" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Label -> Doc ann
forall ann. Label -> Doc ann
prettyLabel Label
l)
    pretty (CmpAddrReg a
_ Addr reg
a reg
r)   = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"cmp" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Addr reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Addr reg
a Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r)
    pretty (CmpRegReg a
_ reg
r0 reg
r1)  = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"cmp" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (CmpAddrBool a
_ Addr reg
a Word8
b)  = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"cmp byte" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Addr reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Addr reg
a Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Word8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word8
b)
    pretty (CmpRegBool a
_ reg
r Word8
b)   = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"cmp" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Word8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word8
b)
    pretty (ShiftRRR a
_ reg
r0 reg
r1)   = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"shr" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (ShiftLRR a
_ reg
r0 reg
r1)   = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"shl" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (IdivR a
_ reg
r)          = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"idiv" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r)
    pretty (DivR a
_ reg
r)           = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"div" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r)
    pretty Cqo{}                = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 Doc ann
"cqo"
    pretty (MovACTag a
_ Addr reg
a Word8
t)     = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Addr reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Addr reg
a Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Word8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word8
t)
    pretty (AndRR a
_ reg
r0 reg
r1)      = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"and" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (OrRR a
_ reg
r0 reg
r1)       = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"or" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (PopcountRR a
_ reg
r0 reg
r1) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"popcnt" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (NegR a
_ reg
r)           = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"neg" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r)
    pretty (Jne a
_ Label
l)            = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"jne" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Label -> Doc ann
forall ann. Label -> Doc ann
prettyLabel Label
l)
    pretty (Jg a
_ Label
l)             = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"jg" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Label -> Doc ann
forall ann. Label -> Doc ann
prettyLabel Label
l)
    pretty (Jge a
_ Label
l)            = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"jge" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Label -> Doc ann
forall ann. Label -> Doc ann
prettyLabel Label
l)
    pretty (Jle a
_ Label
l)            = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"jle" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Label -> Doc ann
forall ann. Label -> Doc ann
prettyLabel Label
l)
    pretty (MovRCTag a
_ reg
r Word8
b)     = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Word8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word8
b)
    pretty (NasmMacro0 a
_ ByteString
b)     = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> Text
decodeUtf8 ByteString
b))
    pretty (CallBS a
_ ByteString
b)         = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"call" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> Text
TL.decodeUtf8 ByteString
b))

prettyAsm :: Pretty reg => [X86 reg a] -> Doc ann
prettyAsm :: [X86 reg a] -> Doc ann
prettyAsm = ((Doc ann
forall ann. Doc ann
prolegomena Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<#> Doc ann
forall ann. Doc ann
macros Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<#> Doc ann
"section .text" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>) (Doc ann -> Doc ann)
-> ([X86 reg a] -> Doc ann) -> [X86 reg a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyLines ([Doc ann] -> Doc ann)
-> ([X86 reg a] -> [Doc ann]) -> [X86 reg a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (X86 reg a -> Doc ann) -> [X86 reg a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap X86 reg a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty

prettyDebugAsm :: Pretty reg => [X86 reg Liveness] -> Doc ann
prettyDebugAsm :: [X86 reg Liveness] -> Doc ann
prettyDebugAsm = (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (\Doc ann
x Doc ann
y -> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
y) ([Doc ann] -> Doc ann)
-> ([X86 reg Liveness] -> [Doc ann])
-> [X86 reg Liveness]
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (X86 reg Liveness -> Doc ann) -> [X86 reg Liveness] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap X86 reg Liveness -> Doc ann
forall reg ann. Pretty reg => X86 reg Liveness -> Doc ann
prettyLive

prolegomena :: Doc ann
prolegomena :: Doc ann
prolegomena = Doc ann
"section .bss" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"kempe_data: resb 0x8012" -- 32 kb

macros :: Doc ann
macros :: Doc ann
macros = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyLines
    [ Doc ann
forall ann. Doc ann
calleeSave
    , Doc ann
forall ann. Doc ann
calleeRestore
    , Doc ann
forall ann. Doc ann
callerSave
    , Doc ann
forall ann. Doc ann
callerRestore
    ]

-- rbx, rbp, r12-r15 callee-saved (non-volatile)
-- rest caller-saved (volatile)

-- | Save non-volatile registers
calleeSave :: Doc ann
calleeSave :: Doc ann
calleeSave =
    Doc ann
"%macro calleesave 0"
    Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<#> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyLines ((X86 X86Reg () -> Doc ann) -> [X86 X86Reg ()] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap X86 X86Reg () -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [X86 X86Reg ()]
toPush)
    Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<#> Doc ann
"%endmacro"
    where toPush :: [X86 X86Reg ()]
toPush = () -> X86Reg -> X86 X86Reg ()
forall reg a. a -> reg -> X86 reg a
PushReg () (X86Reg -> X86 X86Reg ()) -> [X86Reg] -> [X86 X86Reg ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [X86Reg
Rbx, X86Reg
Rbp, X86Reg
R12, X86Reg
R13, X86Reg
R14, X86Reg
R15]

calleeRestore :: Doc ann
calleeRestore :: Doc ann
calleeRestore =
    Doc ann
"%macro calleerestore 0"
    Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<#> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyLines ((X86 X86Reg () -> Doc ann) -> [X86 X86Reg ()] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap X86 X86Reg () -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [X86 X86Reg ()]
toPop)
    Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<#> Doc ann
"%endmacro"
    where toPop :: [X86 X86Reg ()]
toPop = () -> X86Reg -> X86 X86Reg ()
forall reg a. a -> reg -> X86 reg a
PopReg () (X86Reg -> X86 X86Reg ()) -> [X86Reg] -> [X86 X86Reg ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [X86Reg
R15, X86Reg
R14, X86Reg
R13, X86Reg
R12, X86Reg
Rbp, X86Reg
Rbx]

callerSave :: Doc ann
callerSave :: Doc ann
callerSave =
    Doc ann
"%macro callersave 0"
    Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<#> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyLines ((X86 X86Reg () -> Doc ann) -> [X86 X86Reg ()] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap X86 X86Reg () -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [X86 X86Reg ()]
toPush)
    Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<#> Doc ann
"%endmacro"
    where toPush :: [X86 X86Reg ()]
toPush = () -> X86Reg -> X86 X86Reg ()
forall reg a. a -> reg -> X86 reg a
PushReg () (X86Reg -> X86 X86Reg ()) -> [X86Reg] -> [X86 X86Reg ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [X86Reg
Rax, X86Reg
Rcx, X86Reg
Rdx, X86Reg
Rsi, X86Reg
Rdi, X86Reg
R8, X86Reg
R9, X86Reg
R10, X86Reg
R11]

callerRestore :: Doc ann
callerRestore :: Doc ann
callerRestore =
    Doc ann
"%macro callerrestore 0"
    Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<#> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyLines ((X86 X86Reg () -> Doc ann) -> [X86 X86Reg ()] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap X86 X86Reg () -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [X86 X86Reg ()]
toPop)
    Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<#> Doc ann
"%endmacro"
    where toPop :: [X86 X86Reg ()]
toPop = () -> X86Reg -> X86 X86Reg ()
forall reg a. a -> reg -> X86 reg a
PopReg () (X86Reg -> X86 X86Reg ()) -> [X86Reg] -> [X86 X86Reg ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [X86Reg
R11, X86Reg
R10, X86Reg
R9, X86Reg
R8, X86Reg
Rdi, X86Reg
Rsi, X86Reg
Rdx, X86Reg
Rcx, X86Reg
Rax]