module Heystone
(
Assembler
, Engine
, Architecture(..)
, Mode(..)
, OptionType(..)
, OptionValue(..)
, runAssembler
, open
, option
, assemble
, Error(..)
, errno
, strerror
, version
) where
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (runExceptT, throwE)
import Data.ByteString (ByteString, packCStringLen)
import Data.List (intercalate)
import Foreign
import Heystone.Internal.Core
import Heystone.Internal.Keystone
runAssembler :: Assembler a
-> IO (Either Error a)
runAssembler :: forall a. Assembler a -> IO (Either Error a)
runAssembler =
ExceptT Error IO a -> IO (Either Error a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
open :: Architecture
-> [Mode]
-> Assembler Engine
open :: Architecture -> [Mode] -> Assembler Engine
open Architecture
arch [Mode]
mode = do
(Error
err, EnginePtr
ksPtr) <- IO (Error, EnginePtr) -> ExceptT Error IO (Error, EnginePtr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Error, EnginePtr) -> ExceptT Error IO (Error, EnginePtr))
-> IO (Error, EnginePtr) -> ExceptT Error IO (Error, EnginePtr)
forall a b. (a -> b) -> a -> b
$ Architecture -> [Mode] -> IO (Error, EnginePtr)
ksOpen Architecture
arch [Mode]
mode
if Error
err Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
ErrOk then
IO Engine -> Assembler Engine
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Engine -> Assembler Engine) -> IO Engine -> Assembler Engine
forall a b. (a -> b) -> a -> b
$ EnginePtr -> IO Engine
mkEngine EnginePtr
ksPtr
else
Error -> Assembler Engine
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Error
err
option :: Engine
-> OptionType
-> OptionValue
-> Assembler ()
option :: Engine -> OptionType -> OptionValue -> Assembler ()
option Engine
ks OptionType
optType OptionValue
optValue = do
Error
err <- IO Error -> ExceptT Error IO Error
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Error -> ExceptT Error IO Error)
-> IO Error -> ExceptT Error IO Error
forall a b. (a -> b) -> a -> b
$ Engine -> OptionType -> OptionValue -> IO Error
ksOption Engine
ks OptionType
optType OptionValue
optValue
if Error
err Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
ErrOk then
() -> Assembler ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else
Error -> Assembler ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Error
err
assemble :: Engine
-> [String]
-> Maybe Word64
-> Assembler (ByteString, Int)
assemble :: Engine -> [String] -> Maybe Word64 -> Assembler (ByteString, Int)
assemble Engine
ks [String]
stmts Maybe Word64
addr = do
let string :: String
string = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
";" [String]
stmts
(Int
res, Ptr CUChar
encPtr, Int
encSize, Int
statCount) <- IO (Int, Ptr CUChar, Int, Int)
-> ExceptT Error IO (Int, Ptr CUChar, Int, Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Int, Ptr CUChar, Int, Int)
-> ExceptT Error IO (Int, Ptr CUChar, Int, Int))
-> IO (Int, Ptr CUChar, Int, Int)
-> ExceptT Error IO (Int, Ptr CUChar, Int, Int)
forall a b. (a -> b) -> a -> b
$ Engine -> String -> Word64 -> IO (Int, Ptr CUChar, Int, Int)
ksAsm Engine
ks String
string (Maybe Word64 -> Word64
maybeZ Maybe Word64
addr)
if Int
res Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then do
ByteString
bs <- IO ByteString -> ExceptT Error IO ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ByteString -> ExceptT Error IO ByteString)
-> IO ByteString -> ExceptT Error IO ByteString
forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ByteString
packCStringLen (Ptr CUChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
encPtr, Int
encSize)
IO () -> Assembler ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Assembler ()) -> IO () -> Assembler ()
forall a b. (a -> b) -> a -> b
$ Ptr CUChar -> IO ()
ksFree Ptr CUChar
encPtr
(ByteString, Int) -> Assembler (ByteString, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs, Int
statCount)
else do
Error
err <- Engine -> ExceptT Error IO Error
errno Engine
ks
Error -> Assembler (ByteString, Int)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Error
err
where maybeZ :: Maybe Word64 -> Word64
maybeZ = Word64 -> (Word64 -> Word64) -> Maybe Word64 -> Word64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word64
0 Word64 -> Word64
forall a. a -> a
id
version :: Int
version :: Int
version =
Ptr CUInt -> Ptr CUInt -> Int
ksVersion Ptr CUInt
forall a. Ptr a
nullPtr Ptr CUInt
forall a. Ptr a
nullPtr
errno :: Engine
-> Assembler Error
errno :: Engine -> ExceptT Error IO Error
errno =
IO Error -> ExceptT Error IO Error
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Error -> ExceptT Error IO Error)
-> (Engine -> IO Error) -> Engine -> ExceptT Error IO Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Engine -> IO Error
ksErrno
strerror :: Error
-> String
strerror :: Error -> String
strerror =
Error -> String
ksStrerror