{-# language CPP #-}
-- | = Name
--
-- VK_EXT_external_memory_acquire_unmodified - device extension
--
-- == VK_EXT_external_memory_acquire_unmodified
--
-- [__Name String__]
--     @VK_EXT_external_memory_acquire_unmodified@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     454
--
-- [__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>
--
-- [__Contact__]
--
--     -   Lina Versace
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_EXT_external_memory_acquire_unmodified] @versalinyaa%0A*Here describe the issue or question you have about the VK_EXT_external_memory_acquire_unmodified extension* >
--
-- [__Extension Proposal__]
--     <https://github.com/KhronosGroup/Vulkan-Docs/tree/main/proposals/VK_EXT_external_memory_acquire_unmodified.adoc VK_EXT_external_memory_acquire_unmodified>
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2023-03-09
--
-- [__Contributors__]
--
--     -   Lina Versace, Google
--
--     -   Chia-I Wu, Google
--
--     -   James Jones, NVIDIA
--
--     -   Yiwei Zhang, Google
--
-- == Description
--
-- A memory barrier /may/ have a performance penalty when acquiring
-- ownership of a subresource range from an external queue family. This
-- extension provides API that /may/ reduce the performance penalty if
-- ownership of the subresource range was previously released to the
-- external queue family and if the resource’s memory has remained
-- unmodified between the release and acquire operations.
--
-- == New Structures
--
-- -   Extending 'Vulkan.Core10.OtherTypes.BufferMemoryBarrier',
--     'Vulkan.Core13.Promoted_From_VK_KHR_synchronization2.BufferMemoryBarrier2',
--     'Vulkan.Core10.OtherTypes.ImageMemoryBarrier',
--     'Vulkan.Core13.Promoted_From_VK_KHR_synchronization2.ImageMemoryBarrier2':
--
--     -   'ExternalMemoryAcquireUnmodifiedEXT'
--
-- == New Enum Constants
--
-- -   'EXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_EXTENSION_NAME'
--
-- -   'EXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_EXT'
--
-- == Version History
--
-- -   Revision 1, 2023-03-09 (Lina Versace)
--
--     -   Initial revision
--
-- == See Also
--
-- 'ExternalMemoryAcquireUnmodifiedEXT'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_EXT_external_memory_acquire_unmodified Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_EXT_external_memory_acquire_unmodified  ( ExternalMemoryAcquireUnmodifiedEXT(..)
                                                                    , EXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_SPEC_VERSION
                                                                    , pattern EXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_SPEC_VERSION
                                                                    , EXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_EXTENSION_NAME
                                                                    , pattern EXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_EXTENSION_NAME
                                                                    ) where

import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
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 Foreign.Ptr (Ptr)
import Data.Kind (Type)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_EXT))
-- | VkExternalMemoryAcquireUnmodifiedEXT - Structure specifying that
-- external memory has remained unmodified since releasing ownership
--
-- = Description
--
-- If the application releases ownership of the subresource range to one of
-- the special queue families reserved for external memory ownership
-- transfers with a memory barrier structure, and later re-acquires
-- ownership from the same queue family with a memory barrier structure,
-- and if no range of 'Vulkan.Core10.Handles.DeviceMemory' bound to the
-- resource was modified at any time between the /release operation/ and
-- the /acquire operation/, then the application /should/ add a
-- 'ExternalMemoryAcquireUnmodifiedEXT' structure to the @pNext@ chain of
-- the /acquire operation/\'s memory barrier structure because this /may/
-- reduce the performance penalty.
--
-- This struct is ignored if @acquireUnmodifiedMemory@ is
-- 'Vulkan.Core10.FundamentalTypes.FALSE'. In particular,
-- 'Vulkan.Core10.FundamentalTypes.FALSE' does /not/ specify that memory
-- was modified.
--
-- This struct is ignored if the memory barrier’s @srcQueueFamilyIndex@ is
-- not a special queue family reserved for external memory ownership
-- transfers.
--
-- Note
--
-- The method by which the application determines whether memory was
-- modified between the /release operation/ and /acquire operation/ is
-- outside the scope of Vulkan.
--
-- For any Vulkan operation that accesses a resource, the application
-- /must/ not assume the implementation accesses the resource’s memory as
-- read-only, even for /apparently/ read-only operations such as transfer
-- commands and shader reads.
--
-- The validity of
-- 'ExternalMemoryAcquireUnmodifiedEXT'::@acquireUnmodifiedMemory@ is
-- independent of memory ranges outside the ranges of
-- 'Vulkan.Core10.Handles.DeviceMemory' bound to the resource. In
-- particular, it is independent of any implementation-private memory
-- associated with the resource.
--
-- == Valid Usage
--
-- -   #VUID-VkExternalMemoryAcquireUnmodifiedEXT-acquireUnmodifiedMemory-08922#
--     If @acquireUnmodifiedMemory@ is
--     'Vulkan.Core10.FundamentalTypes.TRUE', and the memory barrier’s
--     @srcQueueFamilyIndex@ is a special queue family reserved for
--     external memory ownership transfers (as described in
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-queue-transfers>),
--     then each range of 'Vulkan.Core10.Handles.DeviceMemory' bound to the
--     resource /must/ have remained unmodified during all time since the
--     resource’s most recent release of ownership to the queue family.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkExternalMemoryAcquireUnmodifiedEXT-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_EXT'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_external_memory_acquire_unmodified VK_EXT_external_memory_acquire_unmodified>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ExternalMemoryAcquireUnmodifiedEXT = ExternalMemoryAcquireUnmodifiedEXT
  { -- | @acquireUnmodifiedMemory@ specifies, if
    -- 'Vulkan.Core10.FundamentalTypes.TRUE', that no range of
    -- 'Vulkan.Core10.Handles.DeviceMemory' bound to the resource of the memory
    -- barrier’s subresource range was modified at any time since the
    -- resource’s most recent release of ownership to the queue family
    -- specified by the memory barrier’s @srcQueueFamilyIndex@. If
    -- 'Vulkan.Core10.FundamentalTypes.FALSE', it specifies nothing.
    ExternalMemoryAcquireUnmodifiedEXT -> Bool
acquireUnmodifiedMemory :: Bool }
  deriving (Typeable, ExternalMemoryAcquireUnmodifiedEXT
-> ExternalMemoryAcquireUnmodifiedEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExternalMemoryAcquireUnmodifiedEXT
-> ExternalMemoryAcquireUnmodifiedEXT -> Bool
$c/= :: ExternalMemoryAcquireUnmodifiedEXT
-> ExternalMemoryAcquireUnmodifiedEXT -> Bool
== :: ExternalMemoryAcquireUnmodifiedEXT
-> ExternalMemoryAcquireUnmodifiedEXT -> Bool
$c== :: ExternalMemoryAcquireUnmodifiedEXT
-> ExternalMemoryAcquireUnmodifiedEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ExternalMemoryAcquireUnmodifiedEXT)
#endif
deriving instance Show ExternalMemoryAcquireUnmodifiedEXT

instance ToCStruct ExternalMemoryAcquireUnmodifiedEXT where
  withCStruct :: forall b.
ExternalMemoryAcquireUnmodifiedEXT
-> (Ptr ExternalMemoryAcquireUnmodifiedEXT -> IO b) -> IO b
withCStruct ExternalMemoryAcquireUnmodifiedEXT
x Ptr ExternalMemoryAcquireUnmodifiedEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr ExternalMemoryAcquireUnmodifiedEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ExternalMemoryAcquireUnmodifiedEXT
p ExternalMemoryAcquireUnmodifiedEXT
x (Ptr ExternalMemoryAcquireUnmodifiedEXT -> IO b
f Ptr ExternalMemoryAcquireUnmodifiedEXT
p)
  pokeCStruct :: forall b.
Ptr ExternalMemoryAcquireUnmodifiedEXT
-> ExternalMemoryAcquireUnmodifiedEXT -> IO b -> IO b
pokeCStruct Ptr ExternalMemoryAcquireUnmodifiedEXT
p ExternalMemoryAcquireUnmodifiedEXT{Bool
acquireUnmodifiedMemory :: Bool
$sel:acquireUnmodifiedMemory:ExternalMemoryAcquireUnmodifiedEXT :: ExternalMemoryAcquireUnmodifiedEXT -> Bool
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExternalMemoryAcquireUnmodifiedEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExternalMemoryAcquireUnmodifiedEXT
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 ExternalMemoryAcquireUnmodifiedEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
acquireUnmodifiedMemory))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr ExternalMemoryAcquireUnmodifiedEXT -> IO b -> IO b
pokeZeroCStruct Ptr ExternalMemoryAcquireUnmodifiedEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExternalMemoryAcquireUnmodifiedEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ExternalMemoryAcquireUnmodifiedEXT
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 ExternalMemoryAcquireUnmodifiedEXT
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 ExternalMemoryAcquireUnmodifiedEXT where
  peekCStruct :: Ptr ExternalMemoryAcquireUnmodifiedEXT
-> IO ExternalMemoryAcquireUnmodifiedEXT
peekCStruct Ptr ExternalMemoryAcquireUnmodifiedEXT
p = do
    Bool32
acquireUnmodifiedMemory <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr ExternalMemoryAcquireUnmodifiedEXT
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 -> ExternalMemoryAcquireUnmodifiedEXT
ExternalMemoryAcquireUnmodifiedEXT
             (Bool32 -> Bool
bool32ToBool Bool32
acquireUnmodifiedMemory)

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

instance Zero ExternalMemoryAcquireUnmodifiedEXT where
  zero :: ExternalMemoryAcquireUnmodifiedEXT
zero = Bool -> ExternalMemoryAcquireUnmodifiedEXT
ExternalMemoryAcquireUnmodifiedEXT
           forall a. Zero a => a
zero


type EXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_EXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_SPEC_VERSION"
pattern EXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_SPEC_VERSION :: forall a. Integral a => a
$mEXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_SPEC_VERSION = 1


type EXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_EXTENSION_NAME = "VK_EXT_external_memory_acquire_unmodified"

-- No documentation found for TopLevel "VK_EXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_EXTENSION_NAME"
pattern EXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_EXTERNAL_MEMORY_ACQUIRE_UNMODIFIED_EXTENSION_NAME = "VK_EXT_external_memory_acquire_unmodified"