{-# language CPP #-}
module Vulkan.Extensions.VK_FUCHSIA_external_memory ( getMemoryZirconHandleFUCHSIA
, getMemoryZirconHandlePropertiesFUCHSIA
, ImportMemoryZirconHandleInfoFUCHSIA(..)
, MemoryZirconHandlePropertiesFUCHSIA(..)
, MemoryGetZirconHandleInfoFUCHSIA(..)
, FUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION
, pattern FUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION
, FUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME
, pattern FUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME
, Zx_handle_t
) 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 Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
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.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.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(pVkGetMemoryZirconHandleFUCHSIA))
import Vulkan.Dynamic (DeviceCmds(pVkGetMemoryZirconHandlePropertiesFUCHSIA))
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.Extensions.VK_FUCHSIA_imagepipe_surface (Zx_handle_t)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMPORT_MEMORY_ZIRCON_HANDLE_INFO_FUCHSIA))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MEMORY_GET_ZIRCON_HANDLE_INFO_FUCHSIA))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MEMORY_ZIRCON_HANDLE_PROPERTIES_FUCHSIA))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.VK_FUCHSIA_imagepipe_surface (Zx_handle_t)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetMemoryZirconHandleFUCHSIA
:: FunPtr (Ptr Device_T -> Ptr MemoryGetZirconHandleInfoFUCHSIA -> Ptr Zx_handle_t -> IO Result) -> Ptr Device_T -> Ptr MemoryGetZirconHandleInfoFUCHSIA -> Ptr Zx_handle_t -> IO Result
getMemoryZirconHandleFUCHSIA :: forall io
. (MonadIO io)
=>
Device
->
MemoryGetZirconHandleInfoFUCHSIA
-> io (("zirconHandle" ::: Zx_handle_t))
getMemoryZirconHandleFUCHSIA :: forall (io :: * -> *).
MonadIO io =>
Device
-> MemoryGetZirconHandleInfoFUCHSIA
-> io ("zirconHandle" ::: Zx_handle_t)
getMemoryZirconHandleFUCHSIA Device
device
MemoryGetZirconHandleInfoFUCHSIA
getZirconHandleInfo = 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 vkGetMemoryZirconHandleFUCHSIAPtr :: FunPtr
(Ptr Device_T
-> ("pGetZirconHandleInfo"
::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> IO Result)
vkGetMemoryZirconHandleFUCHSIAPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pGetZirconHandleInfo"
::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> IO Result)
pVkGetMemoryZirconHandleFUCHSIA (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
-> ("pGetZirconHandleInfo"
::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> IO Result)
vkGetMemoryZirconHandleFUCHSIAPtr 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 vkGetMemoryZirconHandleFUCHSIA is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetMemoryZirconHandleFUCHSIA' :: Ptr Device_T
-> ("pGetZirconHandleInfo"
::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> IO Result
vkGetMemoryZirconHandleFUCHSIA' = FunPtr
(Ptr Device_T
-> ("pGetZirconHandleInfo"
::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> IO Result)
-> Ptr Device_T
-> ("pGetZirconHandleInfo"
::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> IO Result
mkVkGetMemoryZirconHandleFUCHSIA FunPtr
(Ptr Device_T
-> ("pGetZirconHandleInfo"
::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> IO Result)
vkGetMemoryZirconHandleFUCHSIAPtr
"pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
pGetZirconHandleInfo <- 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 (MemoryGetZirconHandleInfoFUCHSIA
getZirconHandleInfo)
"pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t)
pPZirconHandle <- 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 @Zx_handle_t 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
"vkGetMemoryZirconHandleFUCHSIA" (Ptr Device_T
-> ("pGetZirconHandleInfo"
::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> ("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t))
-> IO Result
vkGetMemoryZirconHandleFUCHSIA'
(Device -> Ptr Device_T
deviceHandle (Device
device))
"pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
pGetZirconHandleInfo
("pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t)
pPZirconHandle))
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))
"zirconHandle" ::: Zx_handle_t
pZirconHandle <- 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 @Zx_handle_t "pZirconHandle" ::: Ptr ("zirconHandle" ::: Zx_handle_t)
pPZirconHandle
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ("zirconHandle" ::: Zx_handle_t
pZirconHandle)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetMemoryZirconHandlePropertiesFUCHSIA
:: FunPtr (Ptr Device_T -> ExternalMemoryHandleTypeFlagBits -> Zx_handle_t -> Ptr MemoryZirconHandlePropertiesFUCHSIA -> IO Result) -> Ptr Device_T -> ExternalMemoryHandleTypeFlagBits -> Zx_handle_t -> Ptr MemoryZirconHandlePropertiesFUCHSIA -> IO Result
getMemoryZirconHandlePropertiesFUCHSIA :: forall io
. (MonadIO io)
=>
Device
->
ExternalMemoryHandleTypeFlagBits
->
("zirconHandle" ::: Zx_handle_t)
-> io (MemoryZirconHandlePropertiesFUCHSIA)
getMemoryZirconHandlePropertiesFUCHSIA :: forall (io :: * -> *).
MonadIO io =>
Device
-> ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> io MemoryZirconHandlePropertiesFUCHSIA
getMemoryZirconHandlePropertiesFUCHSIA Device
device
ExternalMemoryHandleTypeFlagBits
handleType
"zirconHandle" ::: Zx_handle_t
zirconHandle = 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 vkGetMemoryZirconHandlePropertiesFUCHSIAPtr :: FunPtr
(Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> ("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO Result)
vkGetMemoryZirconHandlePropertiesFUCHSIAPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> ("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO Result)
pVkGetMemoryZirconHandlePropertiesFUCHSIA (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
-> ("zirconHandle" ::: Zx_handle_t)
-> ("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO Result)
vkGetMemoryZirconHandlePropertiesFUCHSIAPtr 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 vkGetMemoryZirconHandlePropertiesFUCHSIA is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetMemoryZirconHandlePropertiesFUCHSIA' :: Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> ("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO Result
vkGetMemoryZirconHandlePropertiesFUCHSIA' = FunPtr
(Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> ("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO Result)
-> Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> ("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO Result
mkVkGetMemoryZirconHandlePropertiesFUCHSIA FunPtr
(Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> ("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO Result)
vkGetMemoryZirconHandlePropertiesFUCHSIAPtr
"pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
pPMemoryZirconHandleProperties <- 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 @MemoryZirconHandlePropertiesFUCHSIA)
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
"vkGetMemoryZirconHandlePropertiesFUCHSIA" (Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> ("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO Result
vkGetMemoryZirconHandlePropertiesFUCHSIA'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(ExternalMemoryHandleTypeFlagBits
handleType)
("zirconHandle" ::: Zx_handle_t
zirconHandle)
("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
pPMemoryZirconHandleProperties))
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))
MemoryZirconHandlePropertiesFUCHSIA
pMemoryZirconHandleProperties <- 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 @MemoryZirconHandlePropertiesFUCHSIA "pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
pPMemoryZirconHandleProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (MemoryZirconHandlePropertiesFUCHSIA
pMemoryZirconHandleProperties)
data ImportMemoryZirconHandleInfoFUCHSIA = ImportMemoryZirconHandleInfoFUCHSIA
{
ImportMemoryZirconHandleInfoFUCHSIA
-> ExternalMemoryHandleTypeFlagBits
handleType :: ExternalMemoryHandleTypeFlagBits
,
ImportMemoryZirconHandleInfoFUCHSIA
-> "zirconHandle" ::: Zx_handle_t
handle :: Zx_handle_t
}
deriving (Typeable, ImportMemoryZirconHandleInfoFUCHSIA
-> ImportMemoryZirconHandleInfoFUCHSIA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportMemoryZirconHandleInfoFUCHSIA
-> ImportMemoryZirconHandleInfoFUCHSIA -> Bool
$c/= :: ImportMemoryZirconHandleInfoFUCHSIA
-> ImportMemoryZirconHandleInfoFUCHSIA -> Bool
== :: ImportMemoryZirconHandleInfoFUCHSIA
-> ImportMemoryZirconHandleInfoFUCHSIA -> Bool
$c== :: ImportMemoryZirconHandleInfoFUCHSIA
-> ImportMemoryZirconHandleInfoFUCHSIA -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImportMemoryZirconHandleInfoFUCHSIA)
#endif
deriving instance Show ImportMemoryZirconHandleInfoFUCHSIA
instance ToCStruct ImportMemoryZirconHandleInfoFUCHSIA where
withCStruct :: forall b.
ImportMemoryZirconHandleInfoFUCHSIA
-> (Ptr ImportMemoryZirconHandleInfoFUCHSIA -> IO b) -> IO b
withCStruct ImportMemoryZirconHandleInfoFUCHSIA
x Ptr ImportMemoryZirconHandleInfoFUCHSIA -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr ImportMemoryZirconHandleInfoFUCHSIA
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImportMemoryZirconHandleInfoFUCHSIA
p ImportMemoryZirconHandleInfoFUCHSIA
x (Ptr ImportMemoryZirconHandleInfoFUCHSIA -> IO b
f Ptr ImportMemoryZirconHandleInfoFUCHSIA
p)
pokeCStruct :: forall b.
Ptr ImportMemoryZirconHandleInfoFUCHSIA
-> ImportMemoryZirconHandleInfoFUCHSIA -> IO b -> IO b
pokeCStruct Ptr ImportMemoryZirconHandleInfoFUCHSIA
p ImportMemoryZirconHandleInfoFUCHSIA{"zirconHandle" ::: Zx_handle_t
ExternalMemoryHandleTypeFlagBits
handle :: "zirconHandle" ::: Zx_handle_t
handleType :: ExternalMemoryHandleTypeFlagBits
$sel:handle:ImportMemoryZirconHandleInfoFUCHSIA :: ImportMemoryZirconHandleInfoFUCHSIA
-> "zirconHandle" ::: Zx_handle_t
$sel:handleType:ImportMemoryZirconHandleInfoFUCHSIA :: ImportMemoryZirconHandleInfoFUCHSIA
-> ExternalMemoryHandleTypeFlagBits
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryZirconHandleInfoFUCHSIA
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMPORT_MEMORY_ZIRCON_HANDLE_INFO_FUCHSIA)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryZirconHandleInfoFUCHSIA
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 ImportMemoryZirconHandleInfoFUCHSIA
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 ImportMemoryZirconHandleInfoFUCHSIA
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Zx_handle_t)) ("zirconHandle" ::: Zx_handle_t
handle)
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr ImportMemoryZirconHandleInfoFUCHSIA -> IO b -> IO b
pokeZeroCStruct Ptr ImportMemoryZirconHandleInfoFUCHSIA
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryZirconHandleInfoFUCHSIA
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMPORT_MEMORY_ZIRCON_HANDLE_INFO_FUCHSIA)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryZirconHandleInfoFUCHSIA
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
IO b
f
instance FromCStruct ImportMemoryZirconHandleInfoFUCHSIA where
peekCStruct :: Ptr ImportMemoryZirconHandleInfoFUCHSIA
-> IO ImportMemoryZirconHandleInfoFUCHSIA
peekCStruct Ptr ImportMemoryZirconHandleInfoFUCHSIA
p = do
ExternalMemoryHandleTypeFlagBits
handleType <- forall a. Storable a => Ptr a -> IO a
peek @ExternalMemoryHandleTypeFlagBits ((Ptr ImportMemoryZirconHandleInfoFUCHSIA
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlagBits))
"zirconHandle" ::: Zx_handle_t
handle <- forall a. Storable a => Ptr a -> IO a
peek @Zx_handle_t ((Ptr ImportMemoryZirconHandleInfoFUCHSIA
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Zx_handle_t))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> ImportMemoryZirconHandleInfoFUCHSIA
ImportMemoryZirconHandleInfoFUCHSIA
ExternalMemoryHandleTypeFlagBits
handleType "zirconHandle" ::: Zx_handle_t
handle
instance Storable ImportMemoryZirconHandleInfoFUCHSIA where
sizeOf :: ImportMemoryZirconHandleInfoFUCHSIA -> Int
sizeOf ~ImportMemoryZirconHandleInfoFUCHSIA
_ = Int
24
alignment :: ImportMemoryZirconHandleInfoFUCHSIA -> Int
alignment ~ImportMemoryZirconHandleInfoFUCHSIA
_ = Int
8
peek :: Ptr ImportMemoryZirconHandleInfoFUCHSIA
-> IO ImportMemoryZirconHandleInfoFUCHSIA
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr ImportMemoryZirconHandleInfoFUCHSIA
-> ImportMemoryZirconHandleInfoFUCHSIA -> IO ()
poke Ptr ImportMemoryZirconHandleInfoFUCHSIA
ptr ImportMemoryZirconHandleInfoFUCHSIA
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImportMemoryZirconHandleInfoFUCHSIA
ptr ImportMemoryZirconHandleInfoFUCHSIA
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero ImportMemoryZirconHandleInfoFUCHSIA where
zero :: ImportMemoryZirconHandleInfoFUCHSIA
zero = ExternalMemoryHandleTypeFlagBits
-> ("zirconHandle" ::: Zx_handle_t)
-> ImportMemoryZirconHandleInfoFUCHSIA
ImportMemoryZirconHandleInfoFUCHSIA
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data MemoryZirconHandlePropertiesFUCHSIA = MemoryZirconHandlePropertiesFUCHSIA
{
MemoryZirconHandlePropertiesFUCHSIA
-> "zirconHandle" ::: Zx_handle_t
memoryTypeBits :: Word32 }
deriving (Typeable, MemoryZirconHandlePropertiesFUCHSIA
-> MemoryZirconHandlePropertiesFUCHSIA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryZirconHandlePropertiesFUCHSIA
-> MemoryZirconHandlePropertiesFUCHSIA -> Bool
$c/= :: MemoryZirconHandlePropertiesFUCHSIA
-> MemoryZirconHandlePropertiesFUCHSIA -> Bool
== :: MemoryZirconHandlePropertiesFUCHSIA
-> MemoryZirconHandlePropertiesFUCHSIA -> Bool
$c== :: MemoryZirconHandlePropertiesFUCHSIA
-> MemoryZirconHandlePropertiesFUCHSIA -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryZirconHandlePropertiesFUCHSIA)
#endif
deriving instance Show MemoryZirconHandlePropertiesFUCHSIA
instance ToCStruct MemoryZirconHandlePropertiesFUCHSIA where
withCStruct :: forall b.
MemoryZirconHandlePropertiesFUCHSIA
-> (("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO b)
-> IO b
withCStruct MemoryZirconHandlePropertiesFUCHSIA
x ("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \"pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p MemoryZirconHandlePropertiesFUCHSIA
x (("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO b
f "pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p)
pokeCStruct :: forall b.
("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> MemoryZirconHandlePropertiesFUCHSIA -> IO b -> IO b
pokeCStruct "pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p MemoryZirconHandlePropertiesFUCHSIA{"zirconHandle" ::: Zx_handle_t
memoryTypeBits :: "zirconHandle" ::: Zx_handle_t
$sel:memoryTypeBits:MemoryZirconHandlePropertiesFUCHSIA :: MemoryZirconHandlePropertiesFUCHSIA
-> "zirconHandle" ::: Zx_handle_t
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_ZIRCON_HANDLE_PROPERTIES_FUCHSIA)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
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 (("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ("zirconHandle" ::: Zx_handle_t
memoryTypeBits)
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO b -> IO b
pokeZeroCStruct "pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_ZIRCON_HANDLE_PROPERTIES_FUCHSIA)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
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 (("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
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 MemoryZirconHandlePropertiesFUCHSIA where
peekCStruct :: ("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO MemoryZirconHandlePropertiesFUCHSIA
peekCStruct "pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
p = do
"zirconHandle" ::: Zx_handle_t
memoryTypeBits <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
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
$ ("zirconHandle" ::: Zx_handle_t)
-> MemoryZirconHandlePropertiesFUCHSIA
MemoryZirconHandlePropertiesFUCHSIA
"zirconHandle" ::: Zx_handle_t
memoryTypeBits
instance Storable MemoryZirconHandlePropertiesFUCHSIA where
sizeOf :: MemoryZirconHandlePropertiesFUCHSIA -> Int
sizeOf ~MemoryZirconHandlePropertiesFUCHSIA
_ = Int
24
alignment :: MemoryZirconHandlePropertiesFUCHSIA -> Int
alignment ~MemoryZirconHandlePropertiesFUCHSIA
_ = Int
8
peek :: ("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> IO MemoryZirconHandlePropertiesFUCHSIA
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA)
-> MemoryZirconHandlePropertiesFUCHSIA -> IO ()
poke "pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
ptr MemoryZirconHandlePropertiesFUCHSIA
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pMemoryZirconHandleProperties"
::: Ptr MemoryZirconHandlePropertiesFUCHSIA
ptr MemoryZirconHandlePropertiesFUCHSIA
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero MemoryZirconHandlePropertiesFUCHSIA where
zero :: MemoryZirconHandlePropertiesFUCHSIA
zero = ("zirconHandle" ::: Zx_handle_t)
-> MemoryZirconHandlePropertiesFUCHSIA
MemoryZirconHandlePropertiesFUCHSIA
forall a. Zero a => a
zero
data MemoryGetZirconHandleInfoFUCHSIA = MemoryGetZirconHandleInfoFUCHSIA
{
MemoryGetZirconHandleInfoFUCHSIA -> DeviceMemory
memory :: DeviceMemory
,
MemoryGetZirconHandleInfoFUCHSIA
-> ExternalMemoryHandleTypeFlagBits
handleType :: ExternalMemoryHandleTypeFlagBits
}
deriving (Typeable, MemoryGetZirconHandleInfoFUCHSIA
-> MemoryGetZirconHandleInfoFUCHSIA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryGetZirconHandleInfoFUCHSIA
-> MemoryGetZirconHandleInfoFUCHSIA -> Bool
$c/= :: MemoryGetZirconHandleInfoFUCHSIA
-> MemoryGetZirconHandleInfoFUCHSIA -> Bool
== :: MemoryGetZirconHandleInfoFUCHSIA
-> MemoryGetZirconHandleInfoFUCHSIA -> Bool
$c== :: MemoryGetZirconHandleInfoFUCHSIA
-> MemoryGetZirconHandleInfoFUCHSIA -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryGetZirconHandleInfoFUCHSIA)
#endif
deriving instance Show MemoryGetZirconHandleInfoFUCHSIA
instance ToCStruct MemoryGetZirconHandleInfoFUCHSIA where
withCStruct :: forall b.
MemoryGetZirconHandleInfoFUCHSIA
-> (("pGetZirconHandleInfo"
::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> IO b)
-> IO b
withCStruct MemoryGetZirconHandleInfoFUCHSIA
x ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p MemoryGetZirconHandleInfoFUCHSIA
x (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> IO b
f "pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p)
pokeCStruct :: forall b.
("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> MemoryGetZirconHandleInfoFUCHSIA -> IO b -> IO b
pokeCStruct "pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p MemoryGetZirconHandleInfoFUCHSIA{DeviceMemory
ExternalMemoryHandleTypeFlagBits
handleType :: ExternalMemoryHandleTypeFlagBits
memory :: DeviceMemory
$sel:handleType:MemoryGetZirconHandleInfoFUCHSIA :: MemoryGetZirconHandleInfoFUCHSIA
-> ExternalMemoryHandleTypeFlagBits
$sel:memory:MemoryGetZirconHandleInfoFUCHSIA :: MemoryGetZirconHandleInfoFUCHSIA -> DeviceMemory
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_GET_ZIRCON_HANDLE_INFO_FUCHSIA)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
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 (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
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 (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
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.
("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> IO b -> IO b
pokeZeroCStruct "pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_GET_ZIRCON_HANDLE_INFO_FUCHSIA)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
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 (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
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 (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
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 MemoryGetZirconHandleInfoFUCHSIA where
peekCStruct :: ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> IO MemoryGetZirconHandleInfoFUCHSIA
peekCStruct "pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
p = do
DeviceMemory
memory <- forall a. Storable a => Ptr a -> IO a
peek @DeviceMemory (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
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 (("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
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
-> MemoryGetZirconHandleInfoFUCHSIA
MemoryGetZirconHandleInfoFUCHSIA
DeviceMemory
memory ExternalMemoryHandleTypeFlagBits
handleType
instance Storable MemoryGetZirconHandleInfoFUCHSIA where
sizeOf :: MemoryGetZirconHandleInfoFUCHSIA -> Int
sizeOf ~MemoryGetZirconHandleInfoFUCHSIA
_ = Int
32
alignment :: MemoryGetZirconHandleInfoFUCHSIA -> Int
alignment ~MemoryGetZirconHandleInfoFUCHSIA
_ = Int
8
peek :: ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> IO MemoryGetZirconHandleInfoFUCHSIA
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA)
-> MemoryGetZirconHandleInfoFUCHSIA -> IO ()
poke "pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
ptr MemoryGetZirconHandleInfoFUCHSIA
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pGetZirconHandleInfo" ::: Ptr MemoryGetZirconHandleInfoFUCHSIA
ptr MemoryGetZirconHandleInfoFUCHSIA
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero MemoryGetZirconHandleInfoFUCHSIA where
zero :: MemoryGetZirconHandleInfoFUCHSIA
zero = DeviceMemory
-> ExternalMemoryHandleTypeFlagBits
-> MemoryGetZirconHandleInfoFUCHSIA
MemoryGetZirconHandleInfoFUCHSIA
forall a. Zero a => a
zero
forall a. Zero a => a
zero
type FUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION = 1
pattern FUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION :: forall a . Integral a => a
pattern $bFUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION :: forall a. Integral a => a
$mFUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
FUCHSIA_EXTERNAL_MEMORY_SPEC_VERSION = 1
type FUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME = "VK_FUCHSIA_external_memory"
pattern FUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bFUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mFUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
FUCHSIA_EXTERNAL_MEMORY_EXTENSION_NAME = "VK_FUCHSIA_external_memory"