{-# language CPP #-}
-- | = Name
--
-- VK_KHR_external_memory_fd - device extension
--
-- == VK_KHR_external_memory_fd
--
-- [__Name String__]
--     @VK_KHR_external_memory_fd@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     75
--
-- [__Revision__]
--     1
--
-- [__Ratification Status__]
--     Ratified
--
-- [__Extension and Version Dependencies__]
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory VK_KHR_external_memory>
--     or
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#versions-1.1 Version 1.1>
--
-- [__Contact__]
--
--     -   James Jones
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_KHR_external_memory_fd] @cubanismo%0A*Here describe the issue or question you have about the VK_KHR_external_memory_fd extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2016-10-21
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   James Jones, NVIDIA
--
--     -   Jeff Juliano, NVIDIA
--
-- == Description
--
-- An application may wish to reference device memory in multiple Vulkan
-- logical devices or instances, in multiple processes, and\/or in multiple
-- APIs. This extension enables an application to export POSIX file
-- descriptor handles from Vulkan memory objects and to import Vulkan
-- memory objects from POSIX file descriptor handles exported from other
-- Vulkan memory objects or from similar resources in other APIs.
--
-- == New Commands
--
-- -   'getMemoryFdKHR'
--
-- -   'getMemoryFdPropertiesKHR'
--
-- == New Structures
--
-- -   'MemoryFdPropertiesKHR'
--
-- -   'MemoryGetFdInfoKHR'
--
-- -   Extending 'Vulkan.Core10.Memory.MemoryAllocateInfo':
--
--     -   'ImportMemoryFdInfoKHR'
--
-- == New Enum Constants
--
-- -   'KHR_EXTERNAL_MEMORY_FD_EXTENSION_NAME'
--
-- -   'KHR_EXTERNAL_MEMORY_FD_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMPORT_MEMORY_FD_INFO_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MEMORY_FD_PROPERTIES_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MEMORY_GET_FD_INFO_KHR'
--
-- == Issues
--
-- 1) Does the application need to close the file descriptor returned by
-- 'getMemoryFdKHR'?
--
-- __RESOLVED__: Yes, unless it is passed back in to a driver instance to
-- import the memory. A successful get call transfers ownership of the file
-- descriptor to the application, and a successful import transfers it back
-- to the driver. Destroying the original memory object will not close the
-- file descriptor or remove its reference to the underlying memory
-- resource associated with it.
--
-- 2) Do drivers ever need to expose multiple file descriptors per memory
-- object?
--
-- __RESOLVED__: No. This would indicate there are actually multiple memory
-- objects, rather than a single memory object.
--
-- 3) How should the valid size and memory type for POSIX file descriptor
-- memory handles created outside of Vulkan be specified?
--
-- __RESOLVED__: The valid memory types are queried directly from the
-- external handle. The size will be specified by future extensions that
-- introduce such external memory handle types.
--
-- == Version History
--
-- -   Revision 1, 2016-10-21 (James Jones)
--
--     -   Initial revision
--
-- == See Also
--
-- 'ImportMemoryFdInfoKHR', 'MemoryFdPropertiesKHR', 'MemoryGetFdInfoKHR',
-- 'getMemoryFdKHR', 'getMemoryFdPropertiesKHR'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_KHR_external_memory_fd Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_KHR_external_memory_fd  ( getMemoryFdKHR
                                                    , getMemoryFdPropertiesKHR
                                                    , ImportMemoryFdInfoKHR(..)
                                                    , MemoryFdPropertiesKHR(..)
                                                    , MemoryGetFdInfoKHR(..)
                                                    , KHR_EXTERNAL_MEMORY_FD_SPEC_VERSION
                                                    , pattern KHR_EXTERNAL_MEMORY_FD_SPEC_VERSION
                                                    , KHR_EXTERNAL_MEMORY_FD_EXTENSION_NAME
                                                    , pattern KHR_EXTERNAL_MEMORY_FD_EXTENSION_NAME
                                                    ) 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 (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Foreign.C.Types (CInt(..))
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 (CInt)
import Foreign.C.Types (CInt(..))
import Foreign.C.Types (CInt(CInt))
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 Data.Int (Int32)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.NamedType ((:::))
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkGetMemoryFdKHR))
import Vulkan.Dynamic (DeviceCmds(pVkGetMemoryFdPropertiesKHR))
import Vulkan.Core10.Handles (DeviceMemory)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits (ExternalMemoryHandleTypeFlagBits)
import Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits (ExternalMemoryHandleTypeFlagBits(..))
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_IMPORT_MEMORY_FD_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MEMORY_FD_PROPERTIES_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MEMORY_GET_FD_INFO_KHR))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetMemoryFdKHR
  :: FunPtr (Ptr Device_T -> Ptr MemoryGetFdInfoKHR -> Ptr CInt -> IO Result) -> Ptr Device_T -> Ptr MemoryGetFdInfoKHR -> Ptr CInt -> IO Result

-- | vkGetMemoryFdKHR - Get a POSIX file descriptor for a memory object
--
-- = Description
--
-- Each call to 'getMemoryFdKHR' /must/ create a new file descriptor
-- holding a reference to the memory object’s payload and transfer
-- ownership of the file descriptor to the application. To avoid leaking
-- resources, the application /must/ release ownership of the file
-- descriptor using the @close@ system call when it is no longer needed, or
-- by importing a Vulkan memory object from it. Where supported by the
-- operating system, the implementation /must/ set the file descriptor to
-- be closed automatically when an @execve@ system call is made.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_TOO_MANY_OBJECTS'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory_fd VK_KHR_external_memory_fd>,
-- 'Vulkan.Core10.Handles.Device', 'MemoryGetFdInfoKHR'
getMemoryFdKHR :: forall io
                . (MonadIO io)
               => -- | @device@ is the logical device that created the device memory being
                  -- exported.
                  --
                  -- #VUID-vkGetMemoryFdKHR-device-parameter# @device@ /must/ be a valid
                  -- 'Vulkan.Core10.Handles.Device' handle
                  Device
               -> -- | @pGetFdInfo@ is a pointer to a 'MemoryGetFdInfoKHR' structure containing
                  -- parameters of the export operation.
                  --
                  -- #VUID-vkGetMemoryFdKHR-pGetFdInfo-parameter# @pGetFdInfo@ /must/ be a
                  -- valid pointer to a valid 'MemoryGetFdInfoKHR' structure
                  MemoryGetFdInfoKHR
               -> io (("fd" ::: Int32))
getMemoryFdKHR :: forall (io :: * -> *).
MonadIO io =>
Device -> MemoryGetFdInfoKHR -> io ("fd" ::: Int32)
getMemoryFdKHR Device
device MemoryGetFdInfoKHR
getFdInfo = 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 vkGetMemoryFdKHRPtr :: FunPtr
  (Ptr Device_T
   -> ("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR)
   -> ("pFd" ::: Ptr CInt)
   -> IO Result)
vkGetMemoryFdKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR)
      -> ("pFd" ::: Ptr CInt)
      -> IO Result)
pVkGetMemoryFdKHR (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
   -> ("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR)
   -> ("pFd" ::: Ptr CInt)
   -> IO Result)
vkGetMemoryFdKHRPtr 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 vkGetMemoryFdKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetMemoryFdKHR' :: Ptr Device_T
-> ("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR)
-> ("pFd" ::: Ptr CInt)
-> IO Result
vkGetMemoryFdKHR' = FunPtr
  (Ptr Device_T
   -> ("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR)
   -> ("pFd" ::: Ptr CInt)
   -> IO Result)
-> Ptr Device_T
-> ("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR)
-> ("pFd" ::: Ptr CInt)
-> IO Result
mkVkGetMemoryFdKHR FunPtr
  (Ptr Device_T
   -> ("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR)
   -> ("pFd" ::: Ptr CInt)
   -> IO Result)
vkGetMemoryFdKHRPtr
  "pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
pGetFdInfo <- 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 (MemoryGetFdInfoKHR
getFdInfo)
  "pFd" ::: Ptr CInt
pPFd <- 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 @CInt Int
4) 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
"vkGetMemoryFdKHR" (Ptr Device_T
-> ("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR)
-> ("pFd" ::: Ptr CInt)
-> IO Result
vkGetMemoryFdKHR'
                                                     (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                     "pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
pGetFdInfo
                                                     ("pFd" ::: Ptr CInt
pPFd))
  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))
  CInt
pFd <- 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 @CInt "pFd" ::: Ptr CInt
pPFd
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((coerce :: forall a b. Coercible a b => a -> b
coerce @CInt @Int32 CInt
pFd))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetMemoryFdPropertiesKHR
  :: FunPtr (Ptr Device_T -> ExternalMemoryHandleTypeFlagBits -> CInt -> Ptr MemoryFdPropertiesKHR -> IO Result) -> Ptr Device_T -> ExternalMemoryHandleTypeFlagBits -> CInt -> Ptr MemoryFdPropertiesKHR -> IO Result

-- | vkGetMemoryFdPropertiesKHR - Get Properties of External Memory File
-- Descriptors
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INVALID_EXTERNAL_HANDLE'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory_fd VK_KHR_external_memory_fd>,
-- 'Vulkan.Core10.Handles.Device',
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits',
-- 'MemoryFdPropertiesKHR'
getMemoryFdPropertiesKHR :: forall io
                          . (MonadIO io)
                         => -- | @device@ is the logical device that will be importing @fd@.
                            --
                            -- #VUID-vkGetMemoryFdPropertiesKHR-device-parameter# @device@ /must/ be a
                            -- valid 'Vulkan.Core10.Handles.Device' handle
                            Device
                         -> -- | @handleType@ is a
                            -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
                            -- value specifying the type of the handle @fd@.
                            --
                            -- #VUID-vkGetMemoryFdPropertiesKHR-handleType-00674# @handleType@ /must/
                            -- not be
                            -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_FD_BIT'
                            --
                            -- #VUID-vkGetMemoryFdPropertiesKHR-handleType-parameter# @handleType@
                            -- /must/ be a valid
                            -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
                            -- value
                            ExternalMemoryHandleTypeFlagBits
                         -> -- | @fd@ is the handle which will be imported.
                            --
                            -- #VUID-vkGetMemoryFdPropertiesKHR-fd-00673# @fd@ /must/ point to a valid
                            -- POSIX file descriptor memory handle
                            ("fd" ::: Int32)
                         -> io (MemoryFdPropertiesKHR)
getMemoryFdPropertiesKHR :: forall (io :: * -> *).
MonadIO io =>
Device
-> ExternalMemoryHandleTypeFlagBits
-> ("fd" ::: Int32)
-> io MemoryFdPropertiesKHR
getMemoryFdPropertiesKHR Device
device ExternalMemoryHandleTypeFlagBits
handleType "fd" ::: Int32
fd = 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 vkGetMemoryFdPropertiesKHRPtr :: FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> CInt
   -> ("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR)
   -> IO Result)
vkGetMemoryFdPropertiesKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ExternalMemoryHandleTypeFlagBits
      -> CInt
      -> ("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR)
      -> IO Result)
pVkGetMemoryFdPropertiesKHR (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
   -> ExternalMemoryHandleTypeFlagBits
   -> CInt
   -> ("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR)
   -> IO Result)
vkGetMemoryFdPropertiesKHRPtr 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 vkGetMemoryFdPropertiesKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetMemoryFdPropertiesKHR' :: Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> CInt
-> ("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR)
-> IO Result
vkGetMemoryFdPropertiesKHR' = FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> CInt
   -> ("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR)
   -> IO Result)
-> Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> CInt
-> ("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR)
-> IO Result
mkVkGetMemoryFdPropertiesKHR FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> CInt
   -> ("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR)
   -> IO Result)
vkGetMemoryFdPropertiesKHRPtr
  "pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
pPMemoryFdProperties <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @MemoryFdPropertiesKHR)
  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
"vkGetMemoryFdPropertiesKHR" (Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> CInt
-> ("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR)
-> IO Result
vkGetMemoryFdPropertiesKHR'
                                                               (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                               (ExternalMemoryHandleTypeFlagBits
handleType)
                                                               (("fd" ::: Int32) -> CInt
CInt ("fd" ::: Int32
fd))
                                                               ("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
pPMemoryFdProperties))
  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))
  MemoryFdPropertiesKHR
pMemoryFdProperties <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @MemoryFdPropertiesKHR "pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
pPMemoryFdProperties
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (MemoryFdPropertiesKHR
pMemoryFdProperties)


-- | VkImportMemoryFdInfoKHR - Import memory created on the same physical
-- device from a file descriptor
--
-- = Description
--
-- Importing memory from a file descriptor transfers ownership of the file
-- descriptor from the application to the Vulkan implementation. The
-- application /must/ not perform any operations on the file descriptor
-- after a successful import. The imported memory object holds a reference
-- to its payload.
--
-- Applications /can/ import the same payload into multiple instances of
-- Vulkan, into the same instance from which it was exported, and multiple
-- times into a given Vulkan instance. In all cases, each import operation
-- /must/ create a distinct 'Vulkan.Core10.Handles.DeviceMemory' object.
--
-- == Valid Usage
--
-- -   #VUID-VkImportMemoryFdInfoKHR-handleType-00667# If @handleType@ is
--     not @0@, it /must/ be supported for import, as reported by
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.ExternalImageFormatProperties'
--     or
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.ExternalBufferProperties'
--
-- -   #VUID-VkImportMemoryFdInfoKHR-fd-00668# The memory from which @fd@
--     was exported /must/ have been created on the same underlying
--     physical device as @device@
--
-- -   #VUID-VkImportMemoryFdInfoKHR-handleType-00669# If @handleType@ is
--     not @0@, it /must/ be
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_FD_BIT'
--     or
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_DMA_BUF_BIT_EXT'
--
-- -   #VUID-VkImportMemoryFdInfoKHR-handleType-00670# If @handleType@ is
--     not @0@, @fd@ /must/ be a valid handle of the type specified by
--     @handleType@
--
-- -   #VUID-VkImportMemoryFdInfoKHR-fd-01746# The memory represented by
--     @fd@ /must/ have been created from a physical device and driver that
--     is compatible with @device@ and @handleType@, as described in
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#external-memory-handle-types-compatibility>
--
-- -   #VUID-VkImportMemoryFdInfoKHR-fd-01520# @fd@ /must/ obey any
--     requirements listed for @handleType@ in
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#external-memory-handle-types-compatibility external memory handle types compatibility>
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkImportMemoryFdInfoKHR-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMPORT_MEMORY_FD_INFO_KHR'
--
-- -   #VUID-VkImportMemoryFdInfoKHR-handleType-parameter# If @handleType@
--     is not @0@, @handleType@ /must/ be a valid
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
--     value
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory_fd VK_KHR_external_memory_fd>,
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ImportMemoryFdInfoKHR = ImportMemoryFdInfoKHR
  { -- | @handleType@ is a
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
    -- value specifying the handle type of @fd@.
    ImportMemoryFdInfoKHR -> ExternalMemoryHandleTypeFlagBits
handleType :: ExternalMemoryHandleTypeFlagBits
  , -- | @fd@ is the external handle to import.
    ImportMemoryFdInfoKHR -> "fd" ::: Int32
fd :: Int32
  }
  deriving (Typeable, ImportMemoryFdInfoKHR -> ImportMemoryFdInfoKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportMemoryFdInfoKHR -> ImportMemoryFdInfoKHR -> Bool
$c/= :: ImportMemoryFdInfoKHR -> ImportMemoryFdInfoKHR -> Bool
== :: ImportMemoryFdInfoKHR -> ImportMemoryFdInfoKHR -> Bool
$c== :: ImportMemoryFdInfoKHR -> ImportMemoryFdInfoKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImportMemoryFdInfoKHR)
#endif
deriving instance Show ImportMemoryFdInfoKHR

instance ToCStruct ImportMemoryFdInfoKHR where
  withCStruct :: forall b.
ImportMemoryFdInfoKHR
-> (Ptr ImportMemoryFdInfoKHR -> IO b) -> IO b
withCStruct ImportMemoryFdInfoKHR
x Ptr ImportMemoryFdInfoKHR -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr ImportMemoryFdInfoKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImportMemoryFdInfoKHR
p ImportMemoryFdInfoKHR
x (Ptr ImportMemoryFdInfoKHR -> IO b
f Ptr ImportMemoryFdInfoKHR
p)
  pokeCStruct :: forall b.
Ptr ImportMemoryFdInfoKHR -> ImportMemoryFdInfoKHR -> IO b -> IO b
pokeCStruct Ptr ImportMemoryFdInfoKHR
p ImportMemoryFdInfoKHR{"fd" ::: Int32
ExternalMemoryHandleTypeFlagBits
fd :: "fd" ::: Int32
handleType :: ExternalMemoryHandleTypeFlagBits
$sel:fd:ImportMemoryFdInfoKHR :: ImportMemoryFdInfoKHR -> "fd" ::: Int32
$sel:handleType:ImportMemoryFdInfoKHR :: ImportMemoryFdInfoKHR -> ExternalMemoryHandleTypeFlagBits
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryFdInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMPORT_MEMORY_FD_INFO_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryFdInfoKHR
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 ImportMemoryFdInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlagBits)) (ExternalMemoryHandleTypeFlagBits
handleType)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryFdInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr CInt)) (("fd" ::: Int32) -> CInt
CInt ("fd" ::: Int32
fd))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr ImportMemoryFdInfoKHR -> IO b -> IO b
pokeZeroCStruct Ptr ImportMemoryFdInfoKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryFdInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMPORT_MEMORY_FD_INFO_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryFdInfoKHR
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 ImportMemoryFdInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr CInt)) (("fd" ::: Int32) -> CInt
CInt (forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct ImportMemoryFdInfoKHR where
  peekCStruct :: Ptr ImportMemoryFdInfoKHR -> IO ImportMemoryFdInfoKHR
peekCStruct Ptr ImportMemoryFdInfoKHR
p = do
    ExternalMemoryHandleTypeFlagBits
handleType <- forall a. Storable a => Ptr a -> IO a
peek @ExternalMemoryHandleTypeFlagBits ((Ptr ImportMemoryFdInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlagBits))
    CInt
fd <- forall a. Storable a => Ptr a -> IO a
peek @CInt ((Ptr ImportMemoryFdInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr CInt))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ExternalMemoryHandleTypeFlagBits
-> ("fd" ::: Int32) -> ImportMemoryFdInfoKHR
ImportMemoryFdInfoKHR
             ExternalMemoryHandleTypeFlagBits
handleType (coerce :: forall a b. Coercible a b => a -> b
coerce @CInt @Int32 CInt
fd)

instance Storable ImportMemoryFdInfoKHR where
  sizeOf :: ImportMemoryFdInfoKHR -> Int
sizeOf ~ImportMemoryFdInfoKHR
_ = Int
24
  alignment :: ImportMemoryFdInfoKHR -> Int
alignment ~ImportMemoryFdInfoKHR
_ = Int
8
  peek :: Ptr ImportMemoryFdInfoKHR -> IO ImportMemoryFdInfoKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr ImportMemoryFdInfoKHR -> ImportMemoryFdInfoKHR -> IO ()
poke Ptr ImportMemoryFdInfoKHR
ptr ImportMemoryFdInfoKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImportMemoryFdInfoKHR
ptr ImportMemoryFdInfoKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero ImportMemoryFdInfoKHR where
  zero :: ImportMemoryFdInfoKHR
zero = ExternalMemoryHandleTypeFlagBits
-> ("fd" ::: Int32) -> ImportMemoryFdInfoKHR
ImportMemoryFdInfoKHR
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkMemoryFdPropertiesKHR - Properties of External Memory File Descriptors
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory_fd VK_KHR_external_memory_fd>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getMemoryFdPropertiesKHR'
data MemoryFdPropertiesKHR = MemoryFdPropertiesKHR
  { -- | @memoryTypeBits@ is a bitmask containing one bit set for every memory
    -- type which the specified file descriptor /can/ be imported as.
    MemoryFdPropertiesKHR -> Word32
memoryTypeBits :: Word32 }
  deriving (Typeable, MemoryFdPropertiesKHR -> MemoryFdPropertiesKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryFdPropertiesKHR -> MemoryFdPropertiesKHR -> Bool
$c/= :: MemoryFdPropertiesKHR -> MemoryFdPropertiesKHR -> Bool
== :: MemoryFdPropertiesKHR -> MemoryFdPropertiesKHR -> Bool
$c== :: MemoryFdPropertiesKHR -> MemoryFdPropertiesKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryFdPropertiesKHR)
#endif
deriving instance Show MemoryFdPropertiesKHR

instance ToCStruct MemoryFdPropertiesKHR where
  withCStruct :: forall b.
MemoryFdPropertiesKHR
-> (("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR) -> IO b)
-> IO b
withCStruct MemoryFdPropertiesKHR
x ("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \"pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
p MemoryFdPropertiesKHR
x (("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR) -> IO b
f "pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
p)
  pokeCStruct :: forall b.
("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR)
-> MemoryFdPropertiesKHR -> IO b -> IO b
pokeCStruct "pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
p MemoryFdPropertiesKHR{Word32
memoryTypeBits :: Word32
$sel:memoryTypeBits:MemoryFdPropertiesKHR :: MemoryFdPropertiesKHR -> Word32
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_FD_PROPERTIES_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
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 (("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
memoryTypeBits)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR)
-> IO b -> IO b
pokeZeroCStruct "pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_FD_PROPERTIES_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
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 (("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct MemoryFdPropertiesKHR where
  peekCStruct :: ("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR)
-> IO MemoryFdPropertiesKHR
peekCStruct "pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
p = do
    Word32
memoryTypeBits <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32 -> MemoryFdPropertiesKHR
MemoryFdPropertiesKHR
             Word32
memoryTypeBits

instance Storable MemoryFdPropertiesKHR where
  sizeOf :: MemoryFdPropertiesKHR -> Int
sizeOf ~MemoryFdPropertiesKHR
_ = Int
24
  alignment :: MemoryFdPropertiesKHR -> Int
alignment ~MemoryFdPropertiesKHR
_ = Int
8
  peek :: ("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR)
-> IO MemoryFdPropertiesKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: ("pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR)
-> MemoryFdPropertiesKHR -> IO ()
poke "pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
ptr MemoryFdPropertiesKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pMemoryFdProperties" ::: Ptr MemoryFdPropertiesKHR
ptr MemoryFdPropertiesKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero MemoryFdPropertiesKHR where
  zero :: MemoryFdPropertiesKHR
zero = Word32 -> MemoryFdPropertiesKHR
MemoryFdPropertiesKHR
           forall a. Zero a => a
zero


-- | VkMemoryGetFdInfoKHR - Structure describing a POSIX FD memory export
-- operation
--
-- = Description
--
-- The properties of the file descriptor exported depend on the value of
-- @handleType@. See
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
-- for a description of the properties of the defined external memory
-- handle types.
--
-- Note
--
-- The size of the exported file /may/ be larger than the size requested by
-- 'Vulkan.Core10.Memory.MemoryAllocateInfo'::@allocationSize@. If
-- @handleType@ is
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_DMA_BUF_BIT_EXT',
-- then the application /can/ query the file’s actual size with
-- <https://man7.org/linux/man-pages/man2/lseek.2.html lseek>.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory_fd VK_KHR_external_memory_fd>,
-- 'Vulkan.Core10.Handles.DeviceMemory',
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'getMemoryFdKHR'
data MemoryGetFdInfoKHR = MemoryGetFdInfoKHR
  { -- | @memory@ is the memory object from which the handle will be exported.
    --
    -- #VUID-VkMemoryGetFdInfoKHR-memory-parameter# @memory@ /must/ be a valid
    -- 'Vulkan.Core10.Handles.DeviceMemory' handle
    MemoryGetFdInfoKHR -> DeviceMemory
memory :: DeviceMemory
  , -- | @handleType@ is a
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
    -- value specifying the type of handle requested.
    --
    -- #VUID-VkMemoryGetFdInfoKHR-handleType-00671# @handleType@ /must/ have
    -- been included in
    -- 'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExportMemoryAllocateInfo'::@handleTypes@
    -- when @memory@ was created
    --
    -- #VUID-VkMemoryGetFdInfoKHR-handleType-00672# @handleType@ /must/ be
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_FD_BIT'
    -- or
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_DMA_BUF_BIT_EXT'
    --
    -- #VUID-VkMemoryGetFdInfoKHR-handleType-parameter# @handleType@ /must/ be
    -- a valid
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
    -- value
    MemoryGetFdInfoKHR -> ExternalMemoryHandleTypeFlagBits
handleType :: ExternalMemoryHandleTypeFlagBits
  }
  deriving (Typeable, MemoryGetFdInfoKHR -> MemoryGetFdInfoKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryGetFdInfoKHR -> MemoryGetFdInfoKHR -> Bool
$c/= :: MemoryGetFdInfoKHR -> MemoryGetFdInfoKHR -> Bool
== :: MemoryGetFdInfoKHR -> MemoryGetFdInfoKHR -> Bool
$c== :: MemoryGetFdInfoKHR -> MemoryGetFdInfoKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryGetFdInfoKHR)
#endif
deriving instance Show MemoryGetFdInfoKHR

instance ToCStruct MemoryGetFdInfoKHR where
  withCStruct :: forall b.
MemoryGetFdInfoKHR
-> (("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR) -> IO b) -> IO b
withCStruct MemoryGetFdInfoKHR
x ("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
p MemoryGetFdInfoKHR
x (("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR) -> IO b
f "pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
p)
  pokeCStruct :: forall b.
("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR)
-> MemoryGetFdInfoKHR -> IO b -> IO b
pokeCStruct "pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
p MemoryGetFdInfoKHR{DeviceMemory
ExternalMemoryHandleTypeFlagBits
handleType :: ExternalMemoryHandleTypeFlagBits
memory :: DeviceMemory
$sel:handleType:MemoryGetFdInfoKHR :: MemoryGetFdInfoKHR -> ExternalMemoryHandleTypeFlagBits
$sel:memory:MemoryGetFdInfoKHR :: MemoryGetFdInfoKHR -> DeviceMemory
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_GET_FD_INFO_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
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 (("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceMemory)) (DeviceMemory
memory)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ExternalMemoryHandleTypeFlagBits)) (ExternalMemoryHandleTypeFlagBits
handleType)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. ("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR) -> IO b -> IO b
pokeZeroCStruct "pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_GET_FD_INFO_KHR)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
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 (("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceMemory)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ExternalMemoryHandleTypeFlagBits)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct MemoryGetFdInfoKHR where
  peekCStruct :: ("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR) -> IO MemoryGetFdInfoKHR
peekCStruct "pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
p = do
    DeviceMemory
memory <- forall a. Storable a => Ptr a -> IO a
peek @DeviceMemory (("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceMemory))
    ExternalMemoryHandleTypeFlagBits
handleType <- forall a. Storable a => Ptr a -> IO a
peek @ExternalMemoryHandleTypeFlagBits (("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ExternalMemoryHandleTypeFlagBits))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeviceMemory
-> ExternalMemoryHandleTypeFlagBits -> MemoryGetFdInfoKHR
MemoryGetFdInfoKHR
             DeviceMemory
memory ExternalMemoryHandleTypeFlagBits
handleType

instance Storable MemoryGetFdInfoKHR where
  sizeOf :: MemoryGetFdInfoKHR -> Int
sizeOf ~MemoryGetFdInfoKHR
_ = Int
32
  alignment :: MemoryGetFdInfoKHR -> Int
alignment ~MemoryGetFdInfoKHR
_ = Int
8
  peek :: ("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR) -> IO MemoryGetFdInfoKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: ("pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR)
-> MemoryGetFdInfoKHR -> IO ()
poke "pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
ptr MemoryGetFdInfoKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pGetFdInfo" ::: Ptr MemoryGetFdInfoKHR
ptr MemoryGetFdInfoKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero MemoryGetFdInfoKHR where
  zero :: MemoryGetFdInfoKHR
zero = DeviceMemory
-> ExternalMemoryHandleTypeFlagBits -> MemoryGetFdInfoKHR
MemoryGetFdInfoKHR
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


type KHR_EXTERNAL_MEMORY_FD_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_KHR_EXTERNAL_MEMORY_FD_SPEC_VERSION"
pattern KHR_EXTERNAL_MEMORY_FD_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_EXTERNAL_MEMORY_FD_SPEC_VERSION :: forall a. Integral a => a
$mKHR_EXTERNAL_MEMORY_FD_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_EXTERNAL_MEMORY_FD_SPEC_VERSION = 1


type KHR_EXTERNAL_MEMORY_FD_EXTENSION_NAME = "VK_KHR_external_memory_fd"

-- No documentation found for TopLevel "VK_KHR_EXTERNAL_MEMORY_FD_EXTENSION_NAME"
pattern KHR_EXTERNAL_MEMORY_FD_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_EXTERNAL_MEMORY_FD_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mKHR_EXTERNAL_MEMORY_FD_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_EXTERNAL_MEMORY_FD_EXTENSION_NAME = "VK_KHR_external_memory_fd"