{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Array.Accelerate.LLVM.Native.Link (
module Data.Array.Accelerate.LLVM.Link,
module Data.Array.Accelerate.LLVM.Native.Link,
ExecutableR(..), FunctionTable(..), Function, ObjectCode,
) where
import Data.Array.Accelerate.Lifetime
import Data.Array.Accelerate.LLVM.Compile
import Data.Array.Accelerate.LLVM.Link
import Data.Array.Accelerate.LLVM.State
import Data.Array.Accelerate.LLVM.Native.Target
import Data.Array.Accelerate.LLVM.Native.Compile
import Data.Array.Accelerate.LLVM.Native.Link.Object
import Data.Array.Accelerate.LLVM.Native.Link.Cache
#if defined(darwin_HOST_OS)
import Data.Array.Accelerate.LLVM.Native.Link.MachO
#elif defined(linux_HOST_OS)
import Data.Array.Accelerate.LLVM.Native.Link.ELF
#elif defined(mingw32_HOST_OS)
import Data.Array.Accelerate.LLVM.Native.Link.COFF
#else
#error "Runtime linking not supported on this platform"
#endif
import Control.Monad.State
import Prelude hiding ( lookup )
instance Link Native where
data ExecutableR Native = NativeR { ExecutableR Native -> Lifetime FunctionTable
nativeExecutable :: {-# UNPACK #-} !(Lifetime FunctionTable)
}
linkForTarget :: ObjectR Native -> LLVM Native (ExecutableR Native)
linkForTarget = ObjectR Native -> LLVM Native (ExecutableR Native)
link
link :: ObjectR Native -> LLVM Native (ExecutableR Native)
link :: ObjectR Native -> LLVM Native (ExecutableR Native)
link (ObjectR uid _ obj) = do
LinkCache
cache <- (Native -> LinkCache) -> LLVM Native LinkCache
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Native -> LinkCache
linkCache
Lifetime FunctionTable
funs <- IO (Lifetime FunctionTable) -> LLVM Native (Lifetime FunctionTable)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Lifetime FunctionTable)
-> LLVM Native (Lifetime FunctionTable))
-> IO (Lifetime FunctionTable)
-> LLVM Native (Lifetime FunctionTable)
forall a b. (a -> b) -> a -> b
$ UID
-> LinkCache
-> IO (FunctionTable, ObjectCode)
-> IO (Lifetime FunctionTable)
forall f o. UID -> LinkCache f o -> IO (f, o) -> IO (Lifetime f)
dlsym UID
uid LinkCache
cache (HasCallStack => ByteString -> IO (FunctionTable, ObjectCode)
ByteString -> IO (FunctionTable, ObjectCode)
loadObject ByteString
obj)
ExecutableR Native -> LLVM Native (ExecutableR Native)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExecutableR Native -> LLVM Native (ExecutableR Native))
-> ExecutableR Native -> LLVM Native (ExecutableR Native)
forall a b. (a -> b) -> a -> b
$! Lifetime FunctionTable -> ExecutableR Native
NativeR Lifetime FunctionTable
funs
withExecutable :: MonadIO m => ExecutableR Native -> (FunctionTable -> m b) -> m b
withExecutable :: ExecutableR Native -> (FunctionTable -> m b) -> m b
withExecutable NativeR{..} FunctionTable -> m b
f = do
b
r <- FunctionTable -> m b
f (Lifetime FunctionTable -> FunctionTable
forall a. Lifetime a -> a
unsafeGetValue Lifetime FunctionTable
nativeExecutable)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Lifetime FunctionTable -> IO ()
forall a. Lifetime a -> IO ()
touchLifetime Lifetime FunctionTable
nativeExecutable
b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r