{-# language CPP #-}
module Vulkan.Extensions.VK_NV_cuda_kernel_launch ( createCudaModuleNV
, withCudaModuleNV
, getCudaModuleCacheNV
, createCudaFunctionNV
, withCudaFunctionNV
, destroyCudaModuleNV
, destroyCudaFunctionNV
, cmdCudaLaunchKernelNV
, CudaModuleCreateInfoNV(..)
, CudaFunctionCreateInfoNV(..)
, CudaLaunchInfoNV(..)
, PhysicalDeviceCudaKernelLaunchFeaturesNV(..)
, PhysicalDeviceCudaKernelLaunchPropertiesNV(..)
, NV_CUDA_KERNEL_LAUNCH_SPEC_VERSION
, pattern NV_CUDA_KERNEL_LAUNCH_SPEC_VERSION
, NV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME
, pattern NV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME
, CudaModuleNV(..)
, CudaFunctionNV(..)
, DebugReportObjectTypeEXT(..)
) where
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.ByteString (packCString)
import Data.ByteString (packCStringLen)
import Data.ByteString (useAsCString)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Foreign.C.Types (CSize(..))
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CSize)
import Foreign.C.Types (CSize(..))
import Foreign.C.Types (CSize(CSize))
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Word (Word64)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (CommandBuffer)
import Vulkan.Core10.Handles (CommandBuffer(..))
import Vulkan.Core10.Handles (CommandBuffer(CommandBuffer))
import Vulkan.Core10.Handles (CommandBuffer_T)
import Vulkan.Extensions.Handles (CudaFunctionNV)
import Vulkan.Extensions.Handles (CudaFunctionNV(..))
import Vulkan.Extensions.Handles (CudaModuleNV)
import Vulkan.Extensions.Handles (CudaModuleNV(..))
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCmdCudaLaunchKernelNV))
import Vulkan.Dynamic (DeviceCmds(pVkCreateCudaFunctionNV))
import Vulkan.Dynamic (DeviceCmds(pVkCreateCudaModuleNV))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyCudaFunctionNV))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyCudaModuleNV))
import Vulkan.Dynamic (DeviceCmds(pVkGetCudaModuleCacheNV))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_CUDA_FUNCTION_CREATE_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_CUDA_LAUNCH_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_CUDA_MODULE_CREATE_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_CUDA_KERNEL_LAUNCH_FEATURES_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_CUDA_KERNEL_LAUNCH_PROPERTIES_NV))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.Handles (CudaFunctionNV(..))
import Vulkan.Extensions.Handles (CudaModuleNV(..))
import Vulkan.Extensions.VK_EXT_debug_report (DebugReportObjectTypeEXT(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateCudaModuleNV
:: FunPtr (Ptr Device_T -> Ptr CudaModuleCreateInfoNV -> Ptr AllocationCallbacks -> Ptr CudaModuleNV -> IO Result) -> Ptr Device_T -> Ptr CudaModuleCreateInfoNV -> Ptr AllocationCallbacks -> Ptr CudaModuleNV -> IO Result
createCudaModuleNV :: forall io
. (MonadIO io)
=>
Device
->
CudaModuleCreateInfoNV
->
("allocator" ::: Maybe AllocationCallbacks)
-> io (CudaModuleNV)
createCudaModuleNV :: forall (io :: * -> *).
MonadIO io =>
Device
-> CudaModuleCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CudaModuleNV
createCudaModuleNV Device
device CudaModuleCreateInfoNV
createInfo "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkCreateCudaModuleNVPtr :: FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CudaModuleNV)
-> IO Result)
vkCreateCudaModuleNVPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CudaModuleNV)
-> IO Result)
pVkCreateCudaModuleNV (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CudaModuleNV)
-> IO Result)
vkCreateCudaModuleNVPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCreateCudaModuleNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkCreateCudaModuleNV' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CudaModuleNV)
-> IO Result
vkCreateCudaModuleNV' = FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CudaModuleNV)
-> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CudaModuleNV)
-> IO Result
mkVkCreateCudaModuleNV FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CudaModuleNV)
-> IO Result)
vkCreateCudaModuleNVPtr
"pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
pCreateInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CudaModuleCreateInfoNV
createInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
"pModule" ::: Ptr CudaModuleNV
pPModule <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @CudaModuleNV Int
8) forall a. Ptr a -> IO ()
free
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreateCudaModuleNV" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CudaModuleNV)
-> IO Result
vkCreateCudaModuleNV'
(Device -> Ptr Device_T
deviceHandle (Device
device))
"pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
pCreateInfo
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator
("pModule" ::: Ptr CudaModuleNV
pPModule))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
CudaModuleNV
pModule <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @CudaModuleNV "pModule" ::: Ptr CudaModuleNV
pPModule
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (CudaModuleNV
pModule)
withCudaModuleNV :: forall io r . MonadIO io => Device -> CudaModuleCreateInfoNV -> Maybe AllocationCallbacks -> (io CudaModuleNV -> (CudaModuleNV -> io ()) -> r) -> r
withCudaModuleNV :: forall (io :: * -> *) r.
MonadIO io =>
Device
-> CudaModuleCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io CudaModuleNV -> (CudaModuleNV -> io ()) -> r)
-> r
withCudaModuleNV Device
device CudaModuleCreateInfoNV
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io CudaModuleNV -> (CudaModuleNV -> io ()) -> r
b =
io CudaModuleNV -> (CudaModuleNV -> io ()) -> r
b (forall (io :: * -> *).
MonadIO io =>
Device
-> CudaModuleCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CudaModuleNV
createCudaModuleNV Device
device CudaModuleCreateInfoNV
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(CudaModuleNV
o0) -> forall (io :: * -> *).
MonadIO io =>
Device
-> CudaModuleNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCudaModuleNV Device
device CudaModuleNV
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetCudaModuleCacheNV
:: FunPtr (Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result) -> Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result
getCudaModuleCacheNV :: forall io
. (MonadIO io)
=>
Device
->
CudaModuleNV
-> io (Result, ("cacheData" ::: ByteString))
getCudaModuleCacheNV :: forall (io :: * -> *).
MonadIO io =>
Device -> CudaModuleNV -> io (Result, "cacheData" ::: ByteString)
getCudaModuleCacheNV Device
device CudaModuleNV
module' = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkGetCudaModuleCacheNVPtr :: FunPtr
(Ptr Device_T
-> CudaModuleNV
-> ("pCacheSize" ::: Ptr CSize)
-> ("pCacheData" ::: Ptr ())
-> IO Result)
vkGetCudaModuleCacheNVPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> CudaModuleNV
-> ("pCacheSize" ::: Ptr CSize)
-> ("pCacheData" ::: Ptr ())
-> IO Result)
pVkGetCudaModuleCacheNV (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> CudaModuleNV
-> ("pCacheSize" ::: Ptr CSize)
-> ("pCacheData" ::: Ptr ())
-> IO Result)
vkGetCudaModuleCacheNVPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetCudaModuleCacheNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetCudaModuleCacheNV' :: Ptr Device_T
-> CudaModuleNV
-> ("pCacheSize" ::: Ptr CSize)
-> ("pCacheData" ::: Ptr ())
-> IO Result
vkGetCudaModuleCacheNV' = FunPtr
(Ptr Device_T
-> CudaModuleNV
-> ("pCacheSize" ::: Ptr CSize)
-> ("pCacheData" ::: Ptr ())
-> IO Result)
-> Ptr Device_T
-> CudaModuleNV
-> ("pCacheSize" ::: Ptr CSize)
-> ("pCacheData" ::: Ptr ())
-> IO Result
mkVkGetCudaModuleCacheNV FunPtr
(Ptr Device_T
-> CudaModuleNV
-> ("pCacheSize" ::: Ptr CSize)
-> ("pCacheData" ::: Ptr ())
-> IO Result)
vkGetCudaModuleCacheNVPtr
let device' :: Ptr Device_T
device' = Device -> Ptr Device_T
deviceHandle (Device
device)
"pCacheSize" ::: Ptr CSize
pPCacheSize <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @CSize Int
8) forall a. Ptr a -> IO ()
free
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetCudaModuleCacheNV" (Ptr Device_T
-> CudaModuleNV
-> ("pCacheSize" ::: Ptr CSize)
-> ("pCacheData" ::: Ptr ())
-> IO Result
vkGetCudaModuleCacheNV'
Ptr Device_T
device'
(CudaModuleNV
module')
("pCacheSize" ::: Ptr CSize
pPCacheSize)
(forall a. Ptr a
nullPtr))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
CSize
pCacheSize <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @CSize "pCacheSize" ::: Ptr CSize
pPCacheSize
"pCacheData" ::: Ptr ()
pPCacheData <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @(()) (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
pCacheSize)))) forall a. Ptr a -> IO ()
free
Result
r' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetCudaModuleCacheNV" (Ptr Device_T
-> CudaModuleNV
-> ("pCacheSize" ::: Ptr CSize)
-> ("pCacheData" ::: Ptr ())
-> IO Result
vkGetCudaModuleCacheNV'
Ptr Device_T
device'
(CudaModuleNV
module')
("pCacheSize" ::: Ptr CSize
pPCacheSize)
("pCacheData" ::: Ptr ()
pPCacheData))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
CSize
pCacheSize'' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @CSize "pCacheSize" ::: Ptr CSize
pPCacheSize
"cacheData" ::: ByteString
pCacheData' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ("cacheData" ::: ByteString)
packCStringLen ( forall a b. Ptr a -> Ptr b
castPtr @() @CChar "pCacheData" ::: Ptr ()
pPCacheData
, (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
pCacheSize''))) )
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "cacheData" ::: ByteString
pCacheData')
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateCudaFunctionNV
:: FunPtr (Ptr Device_T -> Ptr CudaFunctionCreateInfoNV -> Ptr AllocationCallbacks -> Ptr CudaFunctionNV -> IO Result) -> Ptr Device_T -> Ptr CudaFunctionCreateInfoNV -> Ptr AllocationCallbacks -> Ptr CudaFunctionNV -> IO Result
createCudaFunctionNV :: forall io
. (MonadIO io)
=>
Device
->
CudaFunctionCreateInfoNV
->
("allocator" ::: Maybe AllocationCallbacks)
-> io (CudaFunctionNV)
createCudaFunctionNV :: forall (io :: * -> *).
MonadIO io =>
Device
-> CudaFunctionCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CudaFunctionNV
createCudaFunctionNV Device
device CudaFunctionCreateInfoNV
createInfo "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkCreateCudaFunctionNVPtr :: FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CudaFunctionNV)
-> IO Result)
vkCreateCudaFunctionNVPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CudaFunctionNV)
-> IO Result)
pVkCreateCudaFunctionNV (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CudaFunctionNV)
-> IO Result)
vkCreateCudaFunctionNVPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCreateCudaFunctionNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkCreateCudaFunctionNV' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CudaFunctionNV)
-> IO Result
vkCreateCudaFunctionNV' = FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CudaFunctionNV)
-> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CudaFunctionNV)
-> IO Result
mkVkCreateCudaFunctionNV FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CudaFunctionNV)
-> IO Result)
vkCreateCudaFunctionNVPtr
"pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
pCreateInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CudaFunctionCreateInfoNV
createInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
"pFunction" ::: Ptr CudaFunctionNV
pPFunction <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @CudaFunctionNV Int
8) forall a. Ptr a -> IO ()
free
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreateCudaFunctionNV" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CudaFunctionNV)
-> IO Result
vkCreateCudaFunctionNV'
(Device -> Ptr Device_T
deviceHandle (Device
device))
"pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
pCreateInfo
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator
("pFunction" ::: Ptr CudaFunctionNV
pPFunction))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
CudaFunctionNV
pFunction <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @CudaFunctionNV "pFunction" ::: Ptr CudaFunctionNV
pPFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (CudaFunctionNV
pFunction)
withCudaFunctionNV :: forall io r . MonadIO io => Device -> CudaFunctionCreateInfoNV -> Maybe AllocationCallbacks -> (io CudaFunctionNV -> (CudaFunctionNV -> io ()) -> r) -> r
withCudaFunctionNV :: forall (io :: * -> *) r.
MonadIO io =>
Device
-> CudaFunctionCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io CudaFunctionNV -> (CudaFunctionNV -> io ()) -> r)
-> r
withCudaFunctionNV Device
device CudaFunctionCreateInfoNV
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io CudaFunctionNV -> (CudaFunctionNV -> io ()) -> r
b =
io CudaFunctionNV -> (CudaFunctionNV -> io ()) -> r
b (forall (io :: * -> *).
MonadIO io =>
Device
-> CudaFunctionCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CudaFunctionNV
createCudaFunctionNV Device
device CudaFunctionCreateInfoNV
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(CudaFunctionNV
o0) -> forall (io :: * -> *).
MonadIO io =>
Device
-> CudaFunctionNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCudaFunctionNV Device
device CudaFunctionNV
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkDestroyCudaModuleNV
:: FunPtr (Ptr Device_T -> CudaModuleNV -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> CudaModuleNV -> Ptr AllocationCallbacks -> IO ()
destroyCudaModuleNV :: forall io
. (MonadIO io)
=>
Device
->
CudaModuleNV
->
("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCudaModuleNV :: forall (io :: * -> *).
MonadIO io =>
Device
-> CudaModuleNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCudaModuleNV Device
device CudaModuleNV
module' "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkDestroyCudaModuleNVPtr :: FunPtr
(Ptr Device_T
-> CudaModuleNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyCudaModuleNVPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> CudaModuleNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
pVkDestroyCudaModuleNV (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> CudaModuleNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyCudaModuleNVPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkDestroyCudaModuleNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkDestroyCudaModuleNV' :: Ptr Device_T
-> CudaModuleNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCudaModuleNV' = FunPtr
(Ptr Device_T
-> CudaModuleNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
-> Ptr Device_T
-> CudaModuleNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyCudaModuleNV FunPtr
(Ptr Device_T
-> CudaModuleNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyCudaModuleNVPtr
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkDestroyCudaModuleNV" (Ptr Device_T
-> CudaModuleNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCudaModuleNV'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(CudaModuleNV
module')
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkDestroyCudaFunctionNV
:: FunPtr (Ptr Device_T -> CudaFunctionNV -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> CudaFunctionNV -> Ptr AllocationCallbacks -> IO ()
destroyCudaFunctionNV :: forall io
. (MonadIO io)
=>
Device
->
CudaFunctionNV
->
("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCudaFunctionNV :: forall (io :: * -> *).
MonadIO io =>
Device
-> CudaFunctionNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCudaFunctionNV Device
device CudaFunctionNV
function "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkDestroyCudaFunctionNVPtr :: FunPtr
(Ptr Device_T
-> CudaFunctionNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyCudaFunctionNVPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> CudaFunctionNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
pVkDestroyCudaFunctionNV (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> CudaFunctionNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyCudaFunctionNVPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkDestroyCudaFunctionNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkDestroyCudaFunctionNV' :: Ptr Device_T
-> CudaFunctionNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCudaFunctionNV' = FunPtr
(Ptr Device_T
-> CudaFunctionNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
-> Ptr Device_T
-> CudaFunctionNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyCudaFunctionNV FunPtr
(Ptr Device_T
-> CudaFunctionNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyCudaFunctionNVPtr
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkDestroyCudaFunctionNV" (Ptr Device_T
-> CudaFunctionNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCudaFunctionNV'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(CudaFunctionNV
function)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCmdCudaLaunchKernelNV
:: FunPtr (Ptr CommandBuffer_T -> Ptr CudaLaunchInfoNV -> IO ()) -> Ptr CommandBuffer_T -> Ptr CudaLaunchInfoNV -> IO ()
cmdCudaLaunchKernelNV :: forall io
. (MonadIO io)
=>
CommandBuffer
->
CudaLaunchInfoNV
-> io ()
cmdCudaLaunchKernelNV :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> CudaLaunchInfoNV -> io ()
cmdCudaLaunchKernelNV CommandBuffer
commandBuffer CudaLaunchInfoNV
launchInfo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkCmdCudaLaunchKernelNVPtr :: FunPtr
(Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO ())
vkCmdCudaLaunchKernelNVPtr = DeviceCmds
-> FunPtr
(Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO ())
pVkCmdCudaLaunchKernelNV (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO ())
vkCmdCudaLaunchKernelNVPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCmdCudaLaunchKernelNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkCmdCudaLaunchKernelNV' :: Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO ()
vkCmdCudaLaunchKernelNV' = FunPtr
(Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO ())
-> Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV)
-> IO ()
mkVkCmdCudaLaunchKernelNV FunPtr
(Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO ())
vkCmdCudaLaunchKernelNVPtr
"pLaunchInfo" ::: Ptr CudaLaunchInfoNV
pLaunchInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CudaLaunchInfoNV
launchInfo)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdCudaLaunchKernelNV" (Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO ()
vkCmdCudaLaunchKernelNV'
(CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
"pLaunchInfo" ::: Ptr CudaLaunchInfoNV
pLaunchInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()
data CudaModuleCreateInfoNV = CudaModuleCreateInfoNV
{
CudaModuleCreateInfoNV -> Word64
dataSize :: Word64
,
CudaModuleCreateInfoNV -> "pCacheData" ::: Ptr ()
data' :: Ptr ()
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CudaModuleCreateInfoNV)
#endif
deriving instance Show CudaModuleCreateInfoNV
instance ToCStruct CudaModuleCreateInfoNV where
withCStruct :: forall b.
CudaModuleCreateInfoNV
-> (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV) -> IO b) -> IO b
withCStruct CudaModuleCreateInfoNV
x ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p CudaModuleCreateInfoNV
x (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV) -> IO b
f "pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p)
pokeCStruct :: forall b.
("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> CudaModuleCreateInfoNV -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p CudaModuleCreateInfoNV{Word64
"pCacheData" ::: Ptr ()
data' :: "pCacheData" ::: Ptr ()
dataSize :: Word64
$sel:data':CudaModuleCreateInfoNV :: CudaModuleCreateInfoNV -> "pCacheData" ::: Ptr ()
$sel:dataSize:CudaModuleCreateInfoNV :: CudaModuleCreateInfoNV -> Word64
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_MODULE_CREATE_INFO_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CSize)) (Word64 -> CSize
CSize (Word64
dataSize))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ()))) ("pCacheData" ::: Ptr ()
data')
IO b
f
cStructSize :: Int
cStructSize = Int
32
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV) -> IO b -> IO b
pokeZeroCStruct "pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_MODULE_CREATE_INFO_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CSize)) (Word64 -> CSize
CSize (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ()))) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct CudaModuleCreateInfoNV where
peekCStruct :: ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> IO CudaModuleCreateInfoNV
peekCStruct "pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p = do
CSize
dataSize <- forall a. Storable a => Ptr a -> IO a
peek @CSize (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CSize))
"pCacheData" ::: Ptr ()
pData <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ())))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word64 -> ("pCacheData" ::: Ptr ()) -> CudaModuleCreateInfoNV
CudaModuleCreateInfoNV
(coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
dataSize) "pCacheData" ::: Ptr ()
pData
instance Storable CudaModuleCreateInfoNV where
sizeOf :: CudaModuleCreateInfoNV -> Int
sizeOf ~CudaModuleCreateInfoNV
_ = Int
32
alignment :: CudaModuleCreateInfoNV -> Int
alignment ~CudaModuleCreateInfoNV
_ = Int
8
peek :: ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> IO CudaModuleCreateInfoNV
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> CudaModuleCreateInfoNV -> IO ()
poke "pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
ptr CudaModuleCreateInfoNV
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
ptr CudaModuleCreateInfoNV
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero CudaModuleCreateInfoNV where
zero :: CudaModuleCreateInfoNV
zero = Word64 -> ("pCacheData" ::: Ptr ()) -> CudaModuleCreateInfoNV
CudaModuleCreateInfoNV
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data CudaFunctionCreateInfoNV = CudaFunctionCreateInfoNV
{
CudaFunctionCreateInfoNV -> CudaModuleNV
module' :: CudaModuleNV
,
CudaFunctionCreateInfoNV -> "cacheData" ::: ByteString
name :: ByteString
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CudaFunctionCreateInfoNV)
#endif
deriving instance Show CudaFunctionCreateInfoNV
instance ToCStruct CudaFunctionCreateInfoNV where
withCStruct :: forall b.
CudaFunctionCreateInfoNV
-> (("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV) -> IO b)
-> IO b
withCStruct CudaFunctionCreateInfoNV
x ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p CudaFunctionCreateInfoNV
x (("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV) -> IO b
f "pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p)
pokeCStruct :: forall b.
("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
-> CudaFunctionCreateInfoNV -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p CudaFunctionCreateInfoNV{"cacheData" ::: ByteString
CudaModuleNV
name :: "cacheData" ::: ByteString
module' :: CudaModuleNV
$sel:name:CudaFunctionCreateInfoNV :: CudaFunctionCreateInfoNV -> "cacheData" ::: ByteString
$sel:module':CudaFunctionCreateInfoNV :: CudaFunctionCreateInfoNV -> CudaModuleNV
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_FUNCTION_CREATE_INFO_NV)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaModuleNV)) (CudaModuleNV
module')
Ptr CChar
pName'' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a.
("cacheData" ::: ByteString) -> (Ptr CChar -> IO a) -> IO a
useAsCString ("cacheData" ::: ByteString
name)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr CChar))) Ptr CChar
pName''
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = Int
32
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV) -> IO b -> IO b
pokeZeroCStruct "pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_FUNCTION_CREATE_INFO_NV)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaModuleNV)) (forall a. Zero a => a
zero)
Ptr CChar
pName'' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a.
("cacheData" ::: ByteString) -> (Ptr CChar -> IO a) -> IO a
useAsCString (forall a. Monoid a => a
mempty)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr CChar))) Ptr CChar
pName''
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
instance FromCStruct CudaFunctionCreateInfoNV where
peekCStruct :: ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
-> IO CudaFunctionCreateInfoNV
peekCStruct "pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p = do
CudaModuleNV
module' <- forall a. Storable a => Ptr a -> IO a
peek @CudaModuleNV (("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaModuleNV))
"cacheData" ::: ByteString
pName <- Ptr CChar -> IO ("cacheData" ::: ByteString)
packCString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek (("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr CChar)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ CudaModuleNV
-> ("cacheData" ::: ByteString) -> CudaFunctionCreateInfoNV
CudaFunctionCreateInfoNV
CudaModuleNV
module' "cacheData" ::: ByteString
pName
instance Zero CudaFunctionCreateInfoNV where
zero :: CudaFunctionCreateInfoNV
zero = CudaModuleNV
-> ("cacheData" ::: ByteString) -> CudaFunctionCreateInfoNV
CudaFunctionCreateInfoNV
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty
data CudaLaunchInfoNV = CudaLaunchInfoNV
{
CudaLaunchInfoNV -> CudaFunctionNV
function :: CudaFunctionNV
,
CudaLaunchInfoNV -> Word32
gridDimX :: Word32
,
CudaLaunchInfoNV -> Word32
gridDimY :: Word32
,
CudaLaunchInfoNV -> Word32
gridDimZ :: Word32
,
CudaLaunchInfoNV -> Word32
blockDimX :: Word32
,
CudaLaunchInfoNV -> Word32
blockDimY :: Word32
,
CudaLaunchInfoNV -> Word32
blockDimZ :: Word32
,
CudaLaunchInfoNV -> Word32
sharedMemBytes :: Word32
,
CudaLaunchInfoNV -> Vector ("pCacheData" ::: Ptr ())
params :: Vector (Ptr ())
,
:: Vector (Ptr ())
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CudaLaunchInfoNV)
#endif
deriving instance Show CudaLaunchInfoNV
instance ToCStruct CudaLaunchInfoNV where
withCStruct :: forall b.
CudaLaunchInfoNV
-> (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO b) -> IO b
withCStruct CudaLaunchInfoNV
x ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
88 forall a b. (a -> b) -> a -> b
$ \"pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p CudaLaunchInfoNV
x (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO b
f "pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p)
pokeCStruct :: forall b.
("pLaunchInfo" ::: Ptr CudaLaunchInfoNV)
-> CudaLaunchInfoNV -> IO b -> IO b
pokeCStruct "pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p CudaLaunchInfoNV{Word32
Vector ("pCacheData" ::: Ptr ())
CudaFunctionNV
extras :: Vector ("pCacheData" ::: Ptr ())
params :: Vector ("pCacheData" ::: Ptr ())
sharedMemBytes :: Word32
blockDimZ :: Word32
blockDimY :: Word32
blockDimX :: Word32
gridDimZ :: Word32
gridDimY :: Word32
gridDimX :: Word32
function :: CudaFunctionNV
$sel:extras:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Vector ("pCacheData" ::: Ptr ())
$sel:params:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Vector ("pCacheData" ::: Ptr ())
$sel:sharedMemBytes:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:blockDimZ:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:blockDimY:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:blockDimX:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:gridDimZ:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:gridDimY:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:gridDimX:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:function:CudaLaunchInfoNV :: CudaLaunchInfoNV -> CudaFunctionNV
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_LAUNCH_INFO_NV)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaFunctionNV)) (CudaFunctionNV
function)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
gridDimX)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Word32
gridDimY)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (Word32
gridDimZ)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (Word32
blockDimX)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) (Word32
blockDimY)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32)) (Word32
blockDimZ)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32)) (Word32
sharedMemBytes)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr CSize)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector ("pCacheData" ::: Ptr ())
params)) :: CSize))
Ptr ("pCacheData" ::: Ptr ())
pPParams' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(Ptr ()) ((forall a. Vector a -> Int
Data.Vector.length (Vector ("pCacheData" ::: Ptr ())
params)) forall a. Num a => a -> a -> a
* Int
8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i "pCacheData" ::: Ptr ()
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("pCacheData" ::: Ptr ())
pPParams' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ())) ("pCacheData" ::: Ptr ()
e)) (Vector ("pCacheData" ::: Ptr ())
params)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr (Ptr (Ptr ())))) (Ptr ("pCacheData" ::: Ptr ())
pPParams')
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr CSize)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector ("pCacheData" ::: Ptr ())
extras)) :: CSize))
Ptr ("pCacheData" ::: Ptr ())
pPExtras' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(Ptr ()) ((forall a. Vector a -> Int
Data.Vector.length (Vector ("pCacheData" ::: Ptr ())
extras)) forall a. Num a => a -> a -> a
* Int
8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i "pCacheData" ::: Ptr ()
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("pCacheData" ::: Ptr ())
pPExtras' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ())) ("pCacheData" ::: Ptr ()
e)) (Vector ("pCacheData" ::: Ptr ())
extras)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr (Ptr (Ptr ())))) (Ptr ("pCacheData" ::: Ptr ())
pPExtras')
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = Int
88
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO b -> IO b
pokeZeroCStruct "pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_LAUNCH_INFO_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaFunctionNV)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct CudaLaunchInfoNV where
peekCStruct :: ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO CudaLaunchInfoNV
peekCStruct "pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p = do
CudaFunctionNV
function <- forall a. Storable a => Ptr a -> IO a
peek @CudaFunctionNV (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaFunctionNV))
Word32
gridDimX <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
Word32
gridDimY <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32))
Word32
gridDimZ <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
Word32
blockDimX <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32))
Word32
blockDimY <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32))
Word32
blockDimZ <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32))
Word32
sharedMemBytes <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32))
CSize
paramCount <- forall a. Storable a => Ptr a -> IO a
peek @CSize (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr CSize))
Ptr ("pCacheData" ::: Ptr ())
pParams <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr ())) (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr (Ptr (Ptr ()))))
Vector ("pCacheData" ::: Ptr ())
pParams' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
paramCount)) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr ("pCacheData" ::: Ptr ())
pParams forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ()))))
CSize
extraCount <- forall a. Storable a => Ptr a -> IO a
peek @CSize (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr CSize))
Ptr ("pCacheData" ::: Ptr ())
pExtras <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr ())) (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr (Ptr (Ptr ()))))
Vector ("pCacheData" ::: Ptr ())
pExtras' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
extraCount)) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr ("pCacheData" ::: Ptr ())
pExtras forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ()))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ CudaFunctionNV
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Vector ("pCacheData" ::: Ptr ())
-> Vector ("pCacheData" ::: Ptr ())
-> CudaLaunchInfoNV
CudaLaunchInfoNV
CudaFunctionNV
function
Word32
gridDimX
Word32
gridDimY
Word32
gridDimZ
Word32
blockDimX
Word32
blockDimY
Word32
blockDimZ
Word32
sharedMemBytes
Vector ("pCacheData" ::: Ptr ())
pParams'
Vector ("pCacheData" ::: Ptr ())
pExtras'
instance Zero CudaLaunchInfoNV where
zero :: CudaLaunchInfoNV
zero = CudaFunctionNV
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Vector ("pCacheData" ::: Ptr ())
-> Vector ("pCacheData" ::: Ptr ())
-> CudaLaunchInfoNV
CudaLaunchInfoNV
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty
forall a. Monoid a => a
mempty
data PhysicalDeviceCudaKernelLaunchFeaturesNV = PhysicalDeviceCudaKernelLaunchFeaturesNV
{
PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
cudaKernelLaunchFeatures :: Bool }
deriving (Typeable, PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
$c/= :: PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
== :: PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
$c== :: PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceCudaKernelLaunchFeaturesNV)
#endif
deriving instance Show PhysicalDeviceCudaKernelLaunchFeaturesNV
instance ToCStruct PhysicalDeviceCudaKernelLaunchFeaturesNV where
withCStruct :: forall b.
PhysicalDeviceCudaKernelLaunchFeaturesNV
-> (Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV -> IO b) -> IO b
withCStruct PhysicalDeviceCudaKernelLaunchFeaturesNV
x Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p PhysicalDeviceCudaKernelLaunchFeaturesNV
x (Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV -> IO b
f Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p PhysicalDeviceCudaKernelLaunchFeaturesNV{Bool
cudaKernelLaunchFeatures :: Bool
$sel:cudaKernelLaunchFeatures:PhysicalDeviceCudaKernelLaunchFeaturesNV :: PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_CUDA_KERNEL_LAUNCH_FEATURES_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
cudaKernelLaunchFeatures))
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_CUDA_KERNEL_LAUNCH_FEATURES_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PhysicalDeviceCudaKernelLaunchFeaturesNV where
peekCStruct :: Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
-> IO PhysicalDeviceCudaKernelLaunchFeaturesNV
peekCStruct Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p = do
Bool32
cudaKernelLaunchFeatures <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDeviceCudaKernelLaunchFeaturesNV
PhysicalDeviceCudaKernelLaunchFeaturesNV
(Bool32 -> Bool
bool32ToBool Bool32
cudaKernelLaunchFeatures)
instance Storable PhysicalDeviceCudaKernelLaunchFeaturesNV where
sizeOf :: PhysicalDeviceCudaKernelLaunchFeaturesNV -> Int
sizeOf ~PhysicalDeviceCudaKernelLaunchFeaturesNV
_ = Int
24
alignment :: PhysicalDeviceCudaKernelLaunchFeaturesNV -> Int
alignment ~PhysicalDeviceCudaKernelLaunchFeaturesNV
_ = Int
8
peek :: Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
-> IO PhysicalDeviceCudaKernelLaunchFeaturesNV
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> IO ()
poke Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceCudaKernelLaunchFeaturesNV where
zero :: PhysicalDeviceCudaKernelLaunchFeaturesNV
zero = Bool -> PhysicalDeviceCudaKernelLaunchFeaturesNV
PhysicalDeviceCudaKernelLaunchFeaturesNV
forall a. Zero a => a
zero
data PhysicalDeviceCudaKernelLaunchPropertiesNV = PhysicalDeviceCudaKernelLaunchPropertiesNV
{
PhysicalDeviceCudaKernelLaunchPropertiesNV -> Word32
computeCapabilityMinor :: Word32
,
PhysicalDeviceCudaKernelLaunchPropertiesNV -> Word32
computeCapabilityMajor :: Word32
}
deriving (Typeable, PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool
$c/= :: PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool
== :: PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool
$c== :: PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceCudaKernelLaunchPropertiesNV)
#endif
deriving instance Show PhysicalDeviceCudaKernelLaunchPropertiesNV
instance ToCStruct PhysicalDeviceCudaKernelLaunchPropertiesNV where
withCStruct :: forall b.
PhysicalDeviceCudaKernelLaunchPropertiesNV
-> (Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV -> IO b) -> IO b
withCStruct PhysicalDeviceCudaKernelLaunchPropertiesNV
x Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p PhysicalDeviceCudaKernelLaunchPropertiesNV
x (Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV -> IO b
f Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p PhysicalDeviceCudaKernelLaunchPropertiesNV{Word32
computeCapabilityMajor :: Word32
computeCapabilityMinor :: Word32
$sel:computeCapabilityMajor:PhysicalDeviceCudaKernelLaunchPropertiesNV :: PhysicalDeviceCudaKernelLaunchPropertiesNV -> Word32
$sel:computeCapabilityMinor:PhysicalDeviceCudaKernelLaunchPropertiesNV :: PhysicalDeviceCudaKernelLaunchPropertiesNV -> Word32
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_CUDA_KERNEL_LAUNCH_PROPERTIES_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
computeCapabilityMinor)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
computeCapabilityMajor)
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_CUDA_KERNEL_LAUNCH_PROPERTIES_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct PhysicalDeviceCudaKernelLaunchPropertiesNV where
peekCStruct :: Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
-> IO PhysicalDeviceCudaKernelLaunchPropertiesNV
peekCStruct Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p = do
Word32
computeCapabilityMinor <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
Word32
computeCapabilityMajor <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> PhysicalDeviceCudaKernelLaunchPropertiesNV
PhysicalDeviceCudaKernelLaunchPropertiesNV
Word32
computeCapabilityMinor Word32
computeCapabilityMajor
instance Storable PhysicalDeviceCudaKernelLaunchPropertiesNV where
sizeOf :: PhysicalDeviceCudaKernelLaunchPropertiesNV -> Int
sizeOf ~PhysicalDeviceCudaKernelLaunchPropertiesNV
_ = Int
24
alignment :: PhysicalDeviceCudaKernelLaunchPropertiesNV -> Int
alignment ~PhysicalDeviceCudaKernelLaunchPropertiesNV
_ = Int
8
peek :: Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
-> IO PhysicalDeviceCudaKernelLaunchPropertiesNV
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> IO ()
poke Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceCudaKernelLaunchPropertiesNV where
zero :: PhysicalDeviceCudaKernelLaunchPropertiesNV
zero = Word32 -> Word32 -> PhysicalDeviceCudaKernelLaunchPropertiesNV
PhysicalDeviceCudaKernelLaunchPropertiesNV
forall a. Zero a => a
zero
forall a. Zero a => a
zero
type NV_CUDA_KERNEL_LAUNCH_SPEC_VERSION = 2
pattern NV_CUDA_KERNEL_LAUNCH_SPEC_VERSION :: forall a . Integral a => a
pattern $bNV_CUDA_KERNEL_LAUNCH_SPEC_VERSION :: forall a. Integral a => a
$mNV_CUDA_KERNEL_LAUNCH_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_CUDA_KERNEL_LAUNCH_SPEC_VERSION = 2
type NV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME = "VK_NV_cuda_kernel_launch"
pattern NV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bNV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mNV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME = "VK_NV_cuda_kernel_launch"