{-# language NoMonomorphismRestriction #-}
{-# language ScopedTypeVariables #-}
{-# language DataKinds #-}
{-# language ForeignFunctionInterface #-}
{-# language RecursiveDo #-}
module CodeGen.X86.Utils where

import           Data.Char
import           Data.Monoid
import           Control.Monad
import           Foreign
import           System.Environment
import           Debug.Trace

import           CodeGen.X86.Asm
import           CodeGen.X86.CodeGen
import           CodeGen.X86.CallConv

-------------------------------------------------------------- derived constructs

-- | execute code unless condition is true
unless :: Condition -> CodeM a -> CodeM ()
unless Condition
cc CodeM a
x = mdo
  Condition -> Label -> CodeM ()
j Condition
cc Label
l
  CodeM a
x
  Label
l <- CodeM Label
label
  () -> CodeM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | do while loop construction
doWhile :: Condition -> CodeM a -> CodeM ()
doWhile Condition
cc CodeM a
x = do
  Label
l <- CodeM Label
label
  CodeM a
x
  Condition -> Label -> CodeM ()
j Condition
cc Label
l

-- | if-then-else
if_ :: Condition -> CodeM a -> CodeM a -> CodeM ()
if_ Condition
cc CodeM a
a CodeM a
b = mdo
  Condition -> Label -> CodeM ()
j (Condition -> Condition
N Condition
cc) Label
l1
  CodeM a
a
  Label -> CodeM ()
jmp Label
l2
  Label
l1 <- CodeM Label
label
  CodeM a
b
  Label
l2 <- CodeM Label
label
  () -> CodeM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

leaData :: Operand 'RW s -> a -> CodeM ()
leaData Operand 'RW s
r a
d = mdo
  Operand 'RW s -> Operand 'RW 'S8 -> CodeM ()
forall (s :: Size) (s' :: Size).
(IsSize s, IsSize s') =>
Operand 'RW s -> Operand 'RW s' -> CodeM ()
lea Operand 'RW s
r (Operand 'RW 'S8 -> CodeM ()) -> Operand 'RW 'S8 -> CodeM ()
forall a b. (a -> b) -> a -> b
$ Label -> Operand 'RW 'S8
forall (rw :: Access). Label -> Operand rw 'S8
ipRel8 Label
l1
  Label -> CodeM ()
jmp Label
l2
  Label
l1 <- CodeM Label
label
  Bytes -> CodeM ()
db (Bytes -> CodeM ()) -> Bytes -> CodeM ()
forall a b. (a -> b) -> a -> b
$ a -> Bytes
forall a. HasBytes a => a -> Bytes
toBytes a
d
  Label
l2 <- CodeM Label
label
  () -> CodeM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

foreign import ccall "static stdio.h &printf" printf :: FunPtr a

------------------------------------------------------------------------------ 
-- * utils

mov' :: forall s s' r . IsSize s' => Operand RW s -> Operand r s' -> Code
mov' :: Operand 'RW s -> Operand r s' -> CodeM ()
mov' Operand 'RW s
a = Operand 'RW s' -> Operand r s' -> CodeM ()
forall (s :: Size) (r :: Access).
IsSize s =>
Operand 'RW s -> Operand r s -> CodeM ()
mov (Operand 'RW s -> Operand 'RW s'
forall (s' :: Size) (s :: Size).
IsSize s' =>
Operand 'RW s -> Operand 'RW s'
resizeOperand Operand 'RW s
a :: Operand RW s')

newtype CString = CString String

instance HasBytes CString where
  toBytes :: CString -> Bytes
toBytes (CString String
cs) = [Bytes] -> Bytes
forall a. Monoid a => [a] -> a
mconcat ([Bytes] -> Bytes) -> [Bytes] -> Bytes
forall a b. (a -> b) -> a -> b
$ Word8 -> Bytes
forall a. HasBytes a => a -> Bytes
toBytes (Word8 -> Bytes) -> (Char -> Word8) -> Char -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word8) (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum (Char -> Bytes) -> String -> [Bytes]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\0")

-- | we should implement PUSHA and POPA later
{- HLINT ignore all_regs_except_rsp -}
all_regs_except_rsp :: [Operand rw S64]
all_regs_except_rsp :: [Operand rw 'S64]
all_regs_except_rsp =
  [ Operand rw 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rax
  , Operand rw 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rcx
  , Operand rw 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rdx
  , Operand rw 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rbx
  , {- rsp, -}
    Operand rw 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rbp
  , Operand rw 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rsi
  , Operand rw 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rdi
  , Operand rw 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r8
  , Operand rw 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r9
  , Operand rw 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r10
  , Operand rw 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r11
  , Operand rw 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r12
  , Operand rw 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r13
  , Operand rw 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r14
  , Operand rw 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r15
  ]

{- HLINT ignore push_all -}
push_all :: CodeM ()
push_all = [CodeM ()] -> CodeM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ Operand Any 'S64 -> CodeM ()
forall (r :: Access). Operand r 'S64 -> CodeM ()
push Operand Any 'S64
r | Operand Any 'S64
r <- [Operand Any 'S64]
forall (rw :: Access). [Operand rw 'S64]
all_regs_except_rsp ]

{- HLINT ignore pop_all -}
pop_all :: CodeM ()
pop_all = [CodeM ()] -> CodeM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ Operand 'RW 'S64 -> CodeM ()
pop Operand 'RW 'S64
r | Operand 'RW 'S64
r <- [Operand 'RW 'S64] -> [Operand 'RW 'S64]
forall a. [a] -> [a]
reverse [Operand 'RW 'S64]
forall (rw :: Access). [Operand rw 'S64]
all_regs_except_rsp ]

traceReg :: IsSize s => String -> Operand RW s -> Code
traceReg :: String -> Operand 'RW s -> CodeM ()
traceReg String
d Operand 'RW s
r = do
  CodeM ()
pushf
  CodeM ()
push_all
  Operand 'RW 'S64 -> Operand 'RW s -> CodeM ()
forall (s :: Size) (s' :: Size) (r :: Access).
IsSize s' =>
Operand 'RW s -> Operand r s' -> CodeM ()
mov' Operand 'RW 'S64
forall (c :: Size -> *). FromReg c => c 'S64
arg2 Operand 'RW s
r
  Operand 'RW 'S64 -> CString -> CodeM ()
forall (s :: Size) a.
(IsSize s, HasBytes a) =>
Operand 'RW s -> a -> CodeM ()
leaData Operand 'RW 'S64
forall (c :: Size -> *). FromReg c => c 'S64
arg1 (String -> CString
CString (String -> CString) -> String -> CString
forall a b. (a -> b) -> a -> b
$ Operand 'RW s -> String
forall a. Show a => a -> String
show Operand 'RW s
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = %" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n")
  Operand 'RW 'S64 -> Operand Any 'S64 -> CodeM ()
forall (s :: Size) (r :: Access).
IsSize s =>
Operand 'RW s -> Operand r s -> CodeM ()
xor_ Operand 'RW 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rax Operand Any 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rax
  Operand 'RW 'S64 -> FunPtr Any -> CodeM ()
forall a. Operand 'RW 'S64 -> FunPtr a -> CodeM ()
callFun Operand 'RW 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r11 FunPtr Any
forall a. FunPtr a
printf
  CodeM ()
pop_all
  CodeM ()
popf
 where
  s :: String
s = case Operand 'RW s -> Size
forall a. HasSize a => a -> Size
size Operand 'RW s
r of
    Size
S8  -> String
"hh"
    Size
S16 -> String
"h"
    Size
S32 -> String
""
    Size
S64 -> String
"l"