{-# LINE 1 "src/Foreign/CUDA/Driver/Module/Query.chs" #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module Foreign.CUDA.Driver.Module.Query (
getFun, getPtr, getTex,
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
{-# LINE 23 "src/Foreign/CUDA/Driver/Module/Query.chs" #-}
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Driver.Exec
import Foreign.CUDA.Driver.Marshal ( peekDeviceHandle )
import Foreign.CUDA.Driver.Module.Base
import Foreign.CUDA.Driver.Texture
import Foreign.CUDA.Internal.C2HS
import Foreign.CUDA.Ptr
import Foreign
import Foreign.C
import Control.Exception ( throwIO )
import Control.Monad ( liftM )
import Data.ByteString.Short ( ShortByteString )
import qualified Data.ByteString.Short as BS
import qualified Data.ByteString.Short.Internal as BI
import qualified Data.ByteString.Internal as BI
import Prelude as P
import GHC.Exts
import GHC.Base ( IO(..) )
{-# INLINEABLE getFun #-}
getFun :: Module -> ShortByteString -> IO Fun
getFun !mdl !fn = resultIfFound "function" fn =<< cuModuleGetFunction mdl fn
{-# INLINE cuModuleGetFunction #-}
cuModuleGetFunction :: (Module) -> (ShortByteString) -> IO ((Status), (Fun))
cuModuleGetFunction a2 a3 =
alloca $ \a1' ->
let {a2' = useModule a2} in
useAsCString a3 $ \a3' ->
cuModuleGetFunction'_ a1' a2' a3' >>= \res ->
let {res' = cToEnum res} in
peekFun a1'>>= \a1'' ->
return (res', a1'')
{-# LINE 68 "src/Foreign/CUDA/Driver/Module/Query.chs" #-}
where
peekFun = liftM Fun . peek
{-# INLINEABLE getPtr #-}
getPtr :: Module -> ShortByteString -> IO (DevicePtr a, Int)
getPtr !mdl !name = do
(!status,!dptr,!bytes) <- cuModuleGetGlobal mdl name
resultIfFound "global" name (status,(dptr,bytes))
{-# INLINE cuModuleGetGlobal #-}
cuModuleGetGlobal :: (Module) -> (ShortByteString) -> IO ((Status), (DevicePtr a), (Int))
cuModuleGetGlobal a3 a4 =
alloca $ \a1' ->
alloca $ \a2' ->
let {a3' = useModule a3} in
useAsCString a4 $ \a4' ->
cuModuleGetGlobal'_ a1' a2' a3' a4' >>= \res ->
let {res' = cToEnum res} in
peekDeviceHandle a1'>>= \a1'' ->
peekIntConv a2'>>= \a2'' ->
return (res', a1'', a2'')
{-# LINE 91 "src/Foreign/CUDA/Driver/Module/Query.chs" #-}
{-# INLINEABLE getTex #-}
getTex :: Module -> ShortByteString -> IO Texture
getTex !mdl !name = resultIfFound "texture" name =<< cuModuleGetTexRef mdl name
{-# INLINE cuModuleGetTexRef #-}
cuModuleGetTexRef :: (Module) -> (ShortByteString) -> IO ((Status), (Texture))
cuModuleGetTexRef a2 a3 =
alloca $ \a1' ->
let {a2' = useModule a2} in
useAsCString a3 $ \a3' ->
cuModuleGetTexRef'_ a1' a2' a3' >>= \res ->
let {res' = cToEnum res} in
peekTex a1'>>= \a1'' ->
return (res', a1'')
{-# LINE 111 "src/Foreign/CUDA/Driver/Module/Query.chs" #-}
{-# INLINE resultIfFound #-}
resultIfFound :: String -> ShortByteString -> (Status, a) -> IO a
resultIfFound kind name (!status,!result) =
case status of
Success -> return result
NotFound -> cudaErrorIO (kind ++ ' ' : describe status ++ ": " ++ unpack name)
_ -> throwIO (ExitCode status)
{-# INLINE useAsCString #-}
useAsCString :: ShortByteString -> (CString -> IO a) -> IO a
useAsCString (BI.SBS ba#) action = IO $ \s0 ->
case sizeofByteArray# ba# of { n# ->
case newPinnedByteArray# (n# +# 1#) s0 of { (# s1, mba# #) ->
case byteArrayContents# (unsafeCoerce# mba#) of { addr# ->
case copyByteArrayToAddr# ba# 0# addr# n# s1 of { s2 ->
case writeWord8OffAddr# addr# n# 0## s2 of { s3 ->
case action (Ptr addr#) of { IO action' ->
case action' s3 of { (# s4, r #) ->
case touch# mba# s4 of { s5 ->
(# s5, r #)
}}}}}}}}
{-# INLINE unpack #-}
unpack :: ShortByteString -> [Char]
unpack = P.map BI.w2c . BS.unpack
foreign import ccall unsafe "Foreign/CUDA/Driver/Module/Query.chs.h cuModuleGetFunction"
cuModuleGetFunction'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))))
foreign import ccall unsafe "Foreign/CUDA/Driver/Module/Query.chs.h cuModuleGetGlobal"
cuModuleGetGlobal'_ :: ((C2HSImp.Ptr C2HSImp.CULLong) -> ((C2HSImp.Ptr C2HSImp.CULong) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))))
foreign import ccall unsafe "Foreign/CUDA/Driver/Module/Query.chs.h cuModuleGetTexRef"
cuModuleGetTexRef'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))))