-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Foreign/CUDA/Driver/Module/Query.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash                #-}
{-# LANGUAGE UnboxedTuples            #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Module.Query
-- Copyright : [2009..2023] Trevor L. McDonell
-- License   : BSD
--
-- Querying module attributes for low-level driver interface
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Module.Query (

  -- ** Querying module inhabitants
  getFun, getPtr, getTex,

) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp





{-# LINE 24 "src/Foreign/CUDA/Driver/Module/Query.chs" #-}


-- Friends
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

-- System
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(..) )


--------------------------------------------------------------------------------
-- Querying module attributes
--------------------------------------------------------------------------------

-- |
-- Returns a function handle.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1ga52be009b0d4045811b30c965e1cb2cf>
--
{-# INLINEABLE getFun #-}
getFun :: Module -> ShortByteString -> IO Fun
getFun :: Module -> ShortByteString -> IO Fun
getFun !Module
mdl !ShortByteString
fn = String -> ShortByteString -> (Status, Fun) -> IO Fun
forall a. String -> ShortByteString -> (Status, a) -> IO a
resultIfFound String
"function" ShortByteString
fn ((Status, Fun) -> IO Fun) -> IO (Status, Fun) -> IO Fun
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> ShortByteString -> IO (Status, Fun)
cuModuleGetFunction Module
mdl ShortByteString
fn

{-# INLINE cuModuleGetFunction #-}
cuModuleGetFunction :: (Module) -> (ShortByteString) -> IO ((Status), (Fun))
cuModuleGetFunction :: Module -> ShortByteString -> IO (Status, Fun)
cuModuleGetFunction Module
a2 ShortByteString
a3 =
  (Ptr (Ptr ()) -> IO (Status, Fun)) -> IO (Status, Fun)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr ()) -> IO (Status, Fun)) -> IO (Status, Fun))
-> (Ptr (Ptr ()) -> IO (Status, Fun)) -> IO (Status, Fun)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
a1' -> 
  let {a2' :: Ptr ()
a2' = Module -> Ptr ()
useModule Module
a2} in 
  ShortByteString
-> (CString -> IO (Status, Fun)) -> IO (Status, Fun)
forall a. ShortByteString -> (CString -> IO a) -> IO a
useAsCString ShortByteString
a3 ((CString -> IO (Status, Fun)) -> IO (Status, Fun))
-> (CString -> IO (Status, Fun)) -> IO (Status, Fun)
forall a b. (a -> b) -> a -> b
$ \CString
a3' -> 
  Ptr (Ptr ()) -> Ptr () -> CString -> IO CInt
cuModuleGetFunction'_ Ptr (Ptr ())
a1' Ptr ()
a2' CString
a3' IO CInt -> (CInt -> IO (Status, Fun)) -> IO (Status, Fun)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
  Ptr (Ptr ()) -> IO Fun
peekFun  Ptr (Ptr ())
a1'IO Fun -> (Fun -> IO (Status, Fun)) -> IO (Status, Fun)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Fun
a1'' -> 
  (Status, Fun) -> IO (Status, Fun)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Fun
a1'')

{-# LINE 69 "src/Foreign/CUDA/Driver/Module/Query.chs" #-}

  where
    peekFun = liftM Fun . peek


-- |
-- Return a global pointer, and size of the global (in bytes).
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1gf3e43672e26073b1081476dbf47a86ab>
--
{-# INLINEABLE getPtr #-}
getPtr :: Module -> ShortByteString -> IO (DevicePtr a, Int)
getPtr :: forall a. Module -> ShortByteString -> IO (DevicePtr a, Int)
getPtr !Module
mdl !ShortByteString
name = do
  (!Status
status,!DevicePtr a
dptr,!Int
bytes) <- Module -> ShortByteString -> IO (Status, DevicePtr a, Int)
forall a.
Module -> ShortByteString -> IO (Status, DevicePtr a, Int)
cuModuleGetGlobal Module
mdl ShortByteString
name
  String
-> ShortByteString
-> (Status, (DevicePtr a, Int))
-> IO (DevicePtr a, Int)
forall a. String -> ShortByteString -> (Status, a) -> IO a
resultIfFound String
"global" ShortByteString
name (Status
status,(DevicePtr a
dptr,Int
bytes))

{-# INLINE cuModuleGetGlobal #-}
cuModuleGetGlobal :: (Module) -> (ShortByteString) -> IO ((Status), (DevicePtr a), (Int))
cuModuleGetGlobal :: forall a.
Module -> ShortByteString -> IO (Status, DevicePtr a, Int)
cuModuleGetGlobal Module
a3 ShortByteString
a4 =
  (Ptr CULLong -> IO (Status, DevicePtr a, Int))
-> IO (Status, DevicePtr a, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CULLong -> IO (Status, DevicePtr a, Int))
 -> IO (Status, DevicePtr a, Int))
-> (Ptr CULLong -> IO (Status, DevicePtr a, Int))
-> IO (Status, DevicePtr a, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CULLong
a1' -> 
  (Ptr CULong -> IO (Status, DevicePtr a, Int))
-> IO (Status, DevicePtr a, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CULong -> IO (Status, DevicePtr a, Int))
 -> IO (Status, DevicePtr a, Int))
-> (Ptr CULong -> IO (Status, DevicePtr a, Int))
-> IO (Status, DevicePtr a, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CULong
a2' -> 
  let {a3' :: Ptr ()
a3' = Module -> Ptr ()
useModule Module
a3} in 
  ShortByteString
-> (CString -> IO (Status, DevicePtr a, Int))
-> IO (Status, DevicePtr a, Int)
forall a. ShortByteString -> (CString -> IO a) -> IO a
useAsCString ShortByteString
a4 ((CString -> IO (Status, DevicePtr a, Int))
 -> IO (Status, DevicePtr a, Int))
-> (CString -> IO (Status, DevicePtr a, Int))
-> IO (Status, DevicePtr a, Int)
forall a b. (a -> b) -> a -> b
$ \CString
a4' -> 
  Ptr CULLong -> Ptr CULong -> Ptr () -> CString -> IO CInt
cuModuleGetGlobal'_ Ptr CULLong
a1' Ptr CULong
a2' Ptr ()
a3' CString
a4' IO CInt
-> (CInt -> IO (Status, DevicePtr a, Int))
-> IO (Status, DevicePtr a, Int)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
  Ptr CULLong -> IO (DevicePtr a)
forall a. Ptr CULLong -> IO (DevicePtr a)
peekDeviceHandle  Ptr CULLong
a1'IO (DevicePtr a)
-> (DevicePtr a -> IO (Status, DevicePtr a, Int))
-> IO (Status, DevicePtr a, Int)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DevicePtr a
a1'' -> 
  Ptr CULong -> IO Int
forall a b. (Storable a, Integral a, Integral b) => Ptr a -> IO b
peekIntConv  Ptr CULong
a2'IO Int
-> (Int -> IO (Status, DevicePtr a, Int))
-> IO (Status, DevicePtr a, Int)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
a2'' -> 
  (Status, DevicePtr a, Int) -> IO (Status, DevicePtr a, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', DevicePtr a
a1'', Int
a2'')

{-# LINE 92 "src/Foreign/CUDA/Driver/Module/Query.chs" #-}



-- |
-- Return a handle to a texture reference. This texture reference handle
-- should not be destroyed, as the texture will be destroyed automatically
-- when the module is unloaded.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g9607dcbf911c16420d5264273f2b5608>
--
{-# INLINEABLE getTex #-}
getTex :: Module -> ShortByteString -> IO Texture
getTex :: Module -> ShortByteString -> IO Texture
getTex !Module
mdl !ShortByteString
name = String -> ShortByteString -> (Status, Texture) -> IO Texture
forall a. String -> ShortByteString -> (Status, a) -> IO a
resultIfFound String
"texture" ShortByteString
name ((Status, Texture) -> IO Texture)
-> IO (Status, Texture) -> IO Texture
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> ShortByteString -> IO (Status, Texture)
cuModuleGetTexRef Module
mdl ShortByteString
name

{-# INLINE cuModuleGetTexRef #-}
cuModuleGetTexRef :: (Module) -> (ShortByteString) -> IO ((Status), (Texture))
cuModuleGetTexRef :: Module -> ShortByteString -> IO (Status, Texture)
cuModuleGetTexRef Module
a2 ShortByteString
a3 =
  (Ptr (Ptr ()) -> IO (Status, Texture)) -> IO (Status, Texture)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr ()) -> IO (Status, Texture)) -> IO (Status, Texture))
-> (Ptr (Ptr ()) -> IO (Status, Texture)) -> IO (Status, Texture)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
a1' -> 
  let {a2' :: Ptr ()
a2' = Module -> Ptr ()
useModule Module
a2} in 
  ShortByteString
-> (CString -> IO (Status, Texture)) -> IO (Status, Texture)
forall a. ShortByteString -> (CString -> IO a) -> IO a
useAsCString ShortByteString
a3 ((CString -> IO (Status, Texture)) -> IO (Status, Texture))
-> (CString -> IO (Status, Texture)) -> IO (Status, Texture)
forall a b. (a -> b) -> a -> b
$ \CString
a3' -> 
  Ptr (Ptr ()) -> Ptr () -> CString -> IO CInt
cuModuleGetTexRef'_ Ptr (Ptr ())
a1' Ptr ()
a2' CString
a3' IO CInt -> (CInt -> IO (Status, Texture)) -> IO (Status, Texture)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
  Ptr (Ptr ()) -> IO Texture
peekTex  Ptr (Ptr ())
a1'IO Texture
-> (Texture -> IO (Status, Texture)) -> IO (Status, Texture)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Texture
a1'' -> 
  (Status, Texture) -> IO (Status, Texture)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Texture
a1'')

{-# LINE 112 "src/Foreign/CUDA/Driver/Module/Query.chs" #-}



--------------------------------------------------------------------------------
-- Internal
--------------------------------------------------------------------------------

{-# INLINE resultIfFound #-}
resultIfFound :: String -> ShortByteString -> (Status, a) -> IO a
resultIfFound :: forall a. String -> ShortByteString -> (Status, a) -> IO a
resultIfFound String
kind ShortByteString
name (!Status
status,!a
result) =
  case Status
status of
       Status
Success  -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
       Status
NotFound -> String -> IO a
forall a. String -> IO a
cudaErrorIO (String
kind String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: Status -> String
forall a. Describe a => a -> String
describe Status
status String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ShortByteString -> String
unpack ShortByteString
name)
       Status
_        -> CUDAException -> IO a
forall e a. Exception e => e -> IO a
throwIO (Status -> CUDAException
ExitCode Status
status)


-- Utilities
-- ---------

-- [Short]ByteStrings are not null-terminated, so can't be passed directly to C.
--
-- unsafeUseAsCString :: ShortByteString -> CString
-- unsafeUseAsCString (BI.SBS ba#) = Ptr (byteArrayContents# ba#)

{-# INLINE useAsCString #-}
useAsCString :: ShortByteString -> (CString -> IO a) -> IO a
useAsCString :: forall a. ShortByteString -> (CString -> IO a) -> IO a
useAsCString (BI.SBS ByteArray#
ba#) CString -> IO a
action = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 ->
  case ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#                              of { Int#
n# ->
  case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newPinnedByteArray# (Int#
n# Int# -> Int# -> Int#
+# Int#
1#) State# RealWorld
s0                 of { (# State# RealWorld
s1, MutableByteArray# RealWorld
mba# #) ->
  case ByteArray# -> Addr#
byteArrayContents# (MutableByteArray# RealWorld -> ByteArray#
forall a b. a -> b
unsafeCoerce# MutableByteArray# RealWorld
mba#)           of { Addr#
addr# ->
  case ByteArray#
-> Int# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
ba# Int#
0# Addr#
addr# Int#
n# State# RealWorld
s1           of { State# RealWorld
s2 ->
  case Addr# -> Int# -> Word8# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Word8# -> State# d -> State# d
writeWord8OffAddr# Addr#
addr# Int#
n# (Word# -> Word8#
wordToWord8# Word#
0##) State# RealWorld
s2 of { State# RealWorld
s3 ->
  case CString -> IO a
action (Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
addr#)                                of { IO State# RealWorld -> (# State# RealWorld, a #)
action' ->
  case State# RealWorld -> (# State# RealWorld, a #)
action' State# RealWorld
s3                                        of { (# State# RealWorld
s4, a
r  #) ->
  case MutableByteArray# RealWorld -> State# RealWorld -> State# RealWorld
forall a. a -> State# RealWorld -> State# RealWorld
touch# MutableByteArray# RealWorld
mba# State# RealWorld
s4                                    of { State# RealWorld
s5 ->
  (# State# RealWorld
s5, a
r #)
 }}}}}}}}


{-# INLINE unpack #-}
unpack :: ShortByteString -> [Char]
unpack :: ShortByteString -> String
unpack = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
P.map Word8 -> Char
BI.w2c ([Word8] -> String)
-> (ShortByteString -> [Word8]) -> ShortByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> [Word8]
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))))