{-# LANGUAGE CPP             #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies    #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module      : Data.Array.Accelerate.LLVM.Native.Link
-- Copyright   : [2017..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

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


-- | Load the generated object file into the target address space
--
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


-- | Execute some operation with the supplied executable functions
--
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