{-# LINE 1 "src/Hs/FFI.hsc" #-}
-- https://eli.thegreenplace.net/2013/11/05/how-to-jit-an-introduction
module Hs.FFI ( bsFp
              , allocNear
              , allocExec
              , finish
              , freeFunPtr
              ) where

import Data.Bits ((.|.))
import Data.Functor (void)
import Control.Monad (when)
import Foreign.C.Types (CInt (..), CSize (..), CChar)
import Foreign.Ptr (FunPtr, IntPtr (..), castFunPtrToPtr, castPtrToFunPtr, Ptr, intPtrToPtr, nullPtr)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import System.Posix.Types (COff (..))



allocNear :: Int -> CSize -> IO (Ptr a)
allocNear :: forall a. Int -> CSize -> IO (Ptr a)
allocNear Int
i CSize
sz =
    Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)
forall a.
Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)
mmap (IntPtr -> Ptr a
forall a. IntPtr -> Ptr a
intPtrToPtr (Int -> IntPtr
IntPtr(Int -> IntPtr) -> Int -> IntPtr
forall a b. (a -> b) -> a -> b
$Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
6Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
1024Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
104)) CSize
sz CInt
2 (CInt
2 CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
4096) (-CInt
1) COff
0
{-# LINE 23 "src/Hs/FFI.hsc" #-}
    -- libc.so is 2.1MB, libm is 918kB

allocExec :: CSize -> IO (Ptr a)
allocExec :: forall a. CSize -> IO (Ptr a)
allocExec CSize
sz =
    Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)
forall a.
Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)
mmap Ptr a
forall a. Ptr a
nullPtr CSize
sz CInt
2 (CInt
2 CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
4096) (-CInt
1) COff
0
{-# LINE 28 "src/Hs/FFI.hsc" #-}

finish :: BS.ByteString -> Ptr CChar -> IO (FunPtr a)
finish :: forall a. ByteString -> Ptr CChar -> IO (FunPtr a)
finish ByteString
bs Ptr CChar
fAt = ByteString -> (CStringLen -> IO (FunPtr a)) -> IO (FunPtr a)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (FunPtr a)) -> IO (FunPtr a))
-> (CStringLen -> IO (FunPtr a)) -> IO (FunPtr a)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
b, Int
sz) -> do
    let sz' :: CSize
sz' = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz
    _ <- Ptr CChar -> Ptr CChar -> CSize -> IO (Ptr CChar)
forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
memcpy Ptr CChar
fAt Ptr CChar
b CSize
sz'
    r <- mprotect fAt sz' 4
{-# LINE 34 "src/Hs/FFI.hsc" #-}
    when (r == -1) $ error "call to mprotect failed."
    pure (castPtrToFunPtr fAt)

bsFp :: BS.ByteString -> IO (FunPtr a, CSize)
bsFp :: forall a. ByteString -> IO (FunPtr a, CSize)
bsFp ByteString
bs = ByteString
-> (CStringLen -> IO (FunPtr a, CSize)) -> IO (FunPtr a, CSize)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (FunPtr a, CSize)) -> IO (FunPtr a, CSize))
-> (CStringLen -> IO (FunPtr a, CSize)) -> IO (FunPtr a, CSize)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
bytes, Int
sz) -> do
    let sz' :: CSize
sz' = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz
    fAt <- {-# SCC "mmap" #-} CSize -> IO (Ptr CChar)
forall a. CSize -> IO (Ptr a)
allocExec CSize
sz'
    _ <- {-# SCC "memcpy" #-} memcpy fAt bytes sz'
    _ <- {-# SCC "mprotect" #-} mprotect fAt sz' 4
{-# LINE 43 "src/Hs/FFI.hsc" #-}
    pure (castPtrToFunPtr fAt, sz')

freeFunPtr :: Int -> FunPtr a -> IO ()
freeFunPtr :: forall a. Int -> FunPtr a -> IO ()
freeFunPtr Int
sz FunPtr a
fp = IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Any -> CSize -> IO CInt
forall a. Ptr a -> CSize -> IO CInt
munmap (FunPtr a -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr a
fp) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)

foreign import ccall mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)
foreign import ccall mprotect :: Ptr a -> CSize -> CInt -> IO CInt
foreign import ccall memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)
foreign import ccall munmap :: Ptr a -> CSize -> IO CInt