{-# language CPP #-}
-- | = Name
--
-- VK_EXT_device_fault - device extension
--
-- == VK_EXT_device_fault
--
-- [__Name String__]
--     @VK_EXT_device_fault@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     342
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires support for Vulkan 1.0
--
--     -   Requires @VK_KHR_get_physical_device_properties2@ to be enabled
--         for any device-level functionality
--
-- [__Contact__]
--
--     -   Ralph Potter <<data:image/png;base64, GitLab>>r_potter
--
-- [__Extension Proposal__]
--     <https://github.com/KhronosGroup/Vulkan-Docs/tree/main/proposals/VK_EXT_device_fault.adoc VK_EXT_device_fault>
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2021-03-10
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Ralph Potter, Samsung
--
--     -   Stuart Smith, AMD
--
--     -   Jan-Harald Fredriksen, ARM
--
--     -   Mark Bellamy, ARM
--
--     -   Andrew Ellem, Google
--
--     -   Alex Walters, IMG
--
--     -   Jeff Bolz, NVIDIA
--
--     -   Baldur Karlsson, Valve
--
-- == Description
--
-- Device loss can be triggered by a variety of issues, including invalid
-- API usage, implementation errors, or hardware failures.
--
-- This extension introduces a new command: 'getDeviceFaultInfoEXT', which
-- may be called subsequent to a
-- 'Vulkan.Core10.Enums.Result.ERROR_DEVICE_LOST' error code having been
-- returned by the implementation. This command allows developers to query
-- for additional information on GPU faults which may have caused device
-- loss, and to generate binary crash dumps, which may be loaded into
-- external tools for further diagnosis.
--
-- == New Commands
--
-- -   'getDeviceFaultInfoEXT'
--
-- == New Structures
--
-- -   'DeviceFaultAddressInfoEXT'
--
-- -   'DeviceFaultCountsEXT'
--
-- -   'DeviceFaultInfoEXT'
--
-- -   'DeviceFaultVendorBinaryHeaderVersionOneEXT'
--
-- -   'DeviceFaultVendorInfoEXT'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceFaultFeaturesEXT'
--
-- == New Enums
--
-- -   'DeviceFaultAddressTypeEXT'
--
-- -   'DeviceFaultVendorBinaryHeaderVersionEXT'
--
-- == New Enum Constants
--
-- -   'EXT_DEVICE_FAULT_EXTENSION_NAME'
--
-- -   'EXT_DEVICE_FAULT_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DEVICE_FAULT_COUNTS_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DEVICE_FAULT_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_FAULT_FEATURES_EXT'
--
-- == Version History
--
-- -   Revision 1, 2020-10-19 (Ralph Potter)
--
--     -   Initial revision
--
-- == See Also
--
-- 'DeviceFaultAddressInfoEXT', 'DeviceFaultAddressTypeEXT',
-- 'DeviceFaultCountsEXT', 'DeviceFaultInfoEXT',
-- 'DeviceFaultVendorBinaryHeaderVersionEXT',
-- 'DeviceFaultVendorBinaryHeaderVersionOneEXT',
-- 'DeviceFaultVendorInfoEXT', 'PhysicalDeviceFaultFeaturesEXT',
-- 'getDeviceFaultInfoEXT'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_EXT_device_fault 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_device_fault  ( getDeviceFaultInfoEXT
                                              , PhysicalDeviceFaultFeaturesEXT(..)
                                              , DeviceFaultAddressInfoEXT(..)
                                              , DeviceFaultVendorInfoEXT(..)
                                              , DeviceFaultCountsEXT(..)
                                              , DeviceFaultInfoEXT(..)
                                              , DeviceFaultVendorBinaryHeaderVersionOneEXT(..)
                                              , DeviceFaultAddressTypeEXT( DEVICE_FAULT_ADDRESS_TYPE_NONE_EXT
                                                                         , DEVICE_FAULT_ADDRESS_TYPE_READ_INVALID_EXT
                                                                         , DEVICE_FAULT_ADDRESS_TYPE_WRITE_INVALID_EXT
                                                                         , DEVICE_FAULT_ADDRESS_TYPE_EXECUTE_INVALID_EXT
                                                                         , DEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_UNKNOWN_EXT
                                                                         , DEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_INVALID_EXT
                                                                         , DEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_FAULT_EXT
                                                                         , ..
                                                                         )
                                              , DeviceFaultVendorBinaryHeaderVersionEXT( DEVICE_FAULT_VENDOR_BINARY_HEADER_VERSION_ONE_EXT
                                                                                       , ..
                                                                                       )
                                              , EXT_DEVICE_FAULT_SPEC_VERSION
                                              , pattern EXT_DEVICE_FAULT_SPEC_VERSION
                                              , EXT_DEVICE_FAULT_EXTENSION_NAME
                                              , pattern EXT_DEVICE_FAULT_EXTENSION_NAME
                                              ) where

import Vulkan.CStruct.Utils (FixedArray)
import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Show (showsPrec)
import Data.ByteString (packCString)
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 Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
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 GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
import Data.Word (Word32)
import Data.Word (Word64)
import Data.Word (Word8)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.CStruct.Utils (lowerArrayPtr)
import Vulkan.CStruct.Utils (peekByteStringFromSizedVectorPtr)
import Vulkan.CStruct.Utils (pokeFixedLengthByteString)
import Vulkan.CStruct.Utils (pokeFixedLengthNullTerminatedByteString)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Core10.FundamentalTypes (DeviceAddress)
import Vulkan.Dynamic (DeviceCmds(pVkGetDeviceFaultInfoEXT))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.APIConstants (MAX_DESCRIPTION_SIZE)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.APIConstants (UUID_SIZE)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEVICE_FAULT_COUNTS_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEVICE_FAULT_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_FAULT_FEATURES_EXT))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetDeviceFaultInfoEXT
  :: FunPtr (Ptr Device_T -> Ptr DeviceFaultCountsEXT -> Ptr DeviceFaultInfoEXT -> IO Result) -> Ptr Device_T -> Ptr DeviceFaultCountsEXT -> Ptr DeviceFaultInfoEXT -> IO Result

-- | vkGetDeviceFaultInfoEXT - Reports diagnostic fault information on the
-- specified logical device
--
-- = Description
--
-- If @pFaultInfo@ is @NULL@, then the counts of corresponding additional
-- fault information structures available are returned in the
-- @addressInfoCount@ and @vendorInfoCount@ members of @pFaultCounts@.
-- Additionally, the size of any vendor-specific binary crash dump is
-- returned in the @vendorBinarySize@ member of @pFaultCounts@.
--
-- If @pFaultInfo@ is not @NULL@, @pFaultCounts@ /must/ point to a
-- 'DeviceFaultCountsEXT' structure with each structure count or size
-- member (@addressInfoCount@, @vendorInfoCount@, @vendorBinarySize@) set
-- by the user to the number of elements in the corresponding output array
-- member of @pFaultInfo@ (@pAddressInfos@ and @pVendorInfos@), or to the
-- size of the output buffer in bytes (@pVendorBinaryData@). On return,
-- each structure count member is overwritten with the number of structures
-- actually written to the corresponding output array member of
-- @pFaultInfo@. Similarly, @vendorBinarySize@ is overwritten with the
-- number of bytes actually written to the @pVendorBinaryData@ member of
-- @pFaultInfo@.
--
-- If the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-deviceFaultVendorBinary vendor-specific crash dumps>
-- feature is not enabled, then implementations /must/ set
-- @pFaultCounts@->vendorBinarySize to zero and /must/ not modify
-- @pFaultInfo@->pVendorBinaryData.
--
-- If any @pFaultCounts@ structure count member is less than the number of
-- corresponding fault properties available, at most structure count
-- (@addressInfoCount@, @vendorInfoCount@) elements will be written to the
-- associated @pFaultInfo@ output array. Similarly, if @vendorBinarySize@
-- is less than the size in bytes of the available crash dump data, at most
-- @vendorBinarySize@ elements will be written to @pVendorBinaryData@.
--
-- If @pFaultInfo@ is @NULL@, then subsequent calls to
-- 'getDeviceFaultInfoEXT' for the same @device@ /must/ return identical
-- values in the @addressInfoCount@, @vendorInfoCount@ and
-- @vendorBinarySize@ members of @pFaultCounts@.
--
-- If @pFaultInfo@ is not @NULL@, then subsequent calls to
-- 'getDeviceFaultInfoEXT' for the same @device@ /must/ return identical
-- values in the output members of @pFaultInfo@ (@pAddressInfos@,
-- @pVendorInfos@, @pVendorBinaryData@), up to the limits described by the
-- structure count and buffer size members of @pFaultCounts@
-- (@addressInfoCount@, @vendorInfoCount@, @vendorBinarySize@). If the
-- sizes of the output members of @pFaultInfo@ increase for a subsequent
-- call to 'getDeviceFaultInfoEXT', then supplementary information /may/ be
-- returned in the additional available space.
--
-- If any @pFaultCounts@ structure count member is smaller than the number
-- of corresponding fault properties available, or if
-- @pFaultCounts@->vendorBinarySize is smaller than the size in bytes of
-- the generated binary crash dump data,
-- 'Vulkan.Core10.Enums.Result.INCOMPLETE' will be returned instead of
-- 'Vulkan.Core10.Enums.Result.SUCCESS', to indicate that not all the
-- available properties were returned.
--
-- If @pFaultCounts@->vendorBinarySize is less than what is necessary to
-- store the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#vendor-binary-crash-dumps binary crash dump header>,
-- nothing will be written to @pFaultInfo@->pVendorBinaryData and zero will
-- be written to @pFaultCounts@->vendorBinarySize.
--
-- == Valid Usage
--
-- -   #VUID-vkGetDeviceFaultInfoEXT-device-07336# @device@ /must/ be in
--     the /lost/ state
--
-- -   #VUID-vkGetDeviceFaultInfoEXT-pFaultCounts-07337# If the value
--     referenced by @pFaultCounts->addressInfoCount@ is not @0@, and
--     @pFaultInfo->pAddressInfos@ is not @NULL@,
--     @pFaultInfo->pAddressInfos@ must be a valid pointer to an array of
--     @pFaultCounts->addressInfoCount@ 'DeviceFaultAddressInfoEXT'
--     structures
--
-- -   #VUID-vkGetDeviceFaultInfoEXT-pFaultCounts-07338# If the value
--     referenced by @pFaultCounts->vendorInfoCount@ is not @0@, and
--     @pFaultInfo->pVendorInfos@ is not @NULL@, @pFaultInfo->pVendorInfos@
--     must be a valid pointer to an array of
--     @pFaultCounts->vendorInfoCount@ 'DeviceFaultVendorInfoEXT'
--     structures
--
-- -   #VUID-vkGetDeviceFaultInfoEXT-pFaultCounts-07339# If the value
--     referenced by @pFaultCounts->vendorBinarySize@ is not @0@, and
--     @pFaultInfo->pVendorBinaryData@ is not @NULL@,
--     @pFaultInfo->pVendorBinaryData@ must be a valid pointer to an array
--     of @pFaultCounts->vendorBinarySize@ bytes
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetDeviceFaultInfoEXT-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkGetDeviceFaultInfoEXT-pFaultCounts-parameter# @pFaultCounts@
--     /must/ be a valid pointer to a 'DeviceFaultCountsEXT' structure
--
-- -   #VUID-vkGetDeviceFaultInfoEXT-pFaultInfo-parameter# If @pFaultInfo@
--     is not @NULL@, @pFaultInfo@ /must/ be a valid pointer to a
--     'DeviceFaultInfoEXT' structure
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<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'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_device_fault VK_EXT_device_fault>,
-- 'Vulkan.Core10.Handles.Device', 'DeviceFaultCountsEXT',
-- 'DeviceFaultInfoEXT'
getDeviceFaultInfoEXT :: forall io
                       . (MonadIO io)
                      => -- | @device@ is the logical device from which to query the diagnostic fault
                         -- information.
                         Device
                      -> io (Result, DeviceFaultCountsEXT, DeviceFaultInfoEXT)
getDeviceFaultInfoEXT :: forall (io :: * -> *).
MonadIO io =>
Device -> io (Result, DeviceFaultCountsEXT, DeviceFaultInfoEXT)
getDeviceFaultInfoEXT Device
device = 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 vkGetDeviceFaultInfoEXTPtr :: FunPtr
  (Ptr Device_T
   -> ("pFaultCounts" ::: Ptr DeviceFaultCountsEXT)
   -> ("pFaultInfo" ::: Ptr DeviceFaultInfoEXT)
   -> IO Result)
vkGetDeviceFaultInfoEXTPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pFaultCounts" ::: Ptr DeviceFaultCountsEXT)
      -> ("pFaultInfo" ::: Ptr DeviceFaultInfoEXT)
      -> IO Result)
pVkGetDeviceFaultInfoEXT (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
   -> ("pFaultCounts" ::: Ptr DeviceFaultCountsEXT)
   -> ("pFaultInfo" ::: Ptr DeviceFaultInfoEXT)
   -> IO Result)
vkGetDeviceFaultInfoEXTPtr 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 vkGetDeviceFaultInfoEXT is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetDeviceFaultInfoEXT' :: Ptr Device_T
-> ("pFaultCounts" ::: Ptr DeviceFaultCountsEXT)
-> ("pFaultInfo" ::: Ptr DeviceFaultInfoEXT)
-> IO Result
vkGetDeviceFaultInfoEXT' = FunPtr
  (Ptr Device_T
   -> ("pFaultCounts" ::: Ptr DeviceFaultCountsEXT)
   -> ("pFaultInfo" ::: Ptr DeviceFaultInfoEXT)
   -> IO Result)
-> Ptr Device_T
-> ("pFaultCounts" ::: Ptr DeviceFaultCountsEXT)
-> ("pFaultInfo" ::: Ptr DeviceFaultInfoEXT)
-> IO Result
mkVkGetDeviceFaultInfoEXT FunPtr
  (Ptr Device_T
   -> ("pFaultCounts" ::: Ptr DeviceFaultCountsEXT)
   -> ("pFaultInfo" ::: Ptr DeviceFaultInfoEXT)
   -> IO Result)
vkGetDeviceFaultInfoEXTPtr
  "pFaultCounts" ::: Ptr DeviceFaultCountsEXT
pPFaultCounts <- 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 @DeviceFaultCountsEXT)
  "pFaultInfo" ::: Ptr DeviceFaultInfoEXT
pPFaultInfo <- 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 @DeviceFaultInfoEXT)
  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
"vkGetDeviceFaultInfoEXT" (Ptr Device_T
-> ("pFaultCounts" ::: Ptr DeviceFaultCountsEXT)
-> ("pFaultInfo" ::: Ptr DeviceFaultInfoEXT)
-> IO Result
vkGetDeviceFaultInfoEXT'
                                                            (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                            ("pFaultCounts" ::: Ptr DeviceFaultCountsEXT
pPFaultCounts)
                                                            ("pFaultInfo" ::: Ptr DeviceFaultInfoEXT
pPFaultInfo))
  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))
  DeviceFaultCountsEXT
pFaultCounts <- 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 @DeviceFaultCountsEXT "pFaultCounts" ::: Ptr DeviceFaultCountsEXT
pPFaultCounts
  DeviceFaultInfoEXT
pFaultInfo <- 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 @DeviceFaultInfoEXT "pFaultInfo" ::: Ptr DeviceFaultInfoEXT
pPFaultInfo
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Result
r, DeviceFaultCountsEXT
pFaultCounts, DeviceFaultInfoEXT
pFaultInfo)


-- | VkPhysicalDeviceFaultFeaturesEXT - Structure indicating support for
-- device fault reporting
--
-- = Members
--
-- The members of the 'PhysicalDeviceFaultFeaturesEXT' structure describe
-- the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceFaultFeaturesEXT' structure is included in the
-- @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceFeatures2',
-- it is filled in to indicate whether each corresponding feature is
-- supported. 'PhysicalDeviceFaultFeaturesEXT' /can/ also be used in the
-- @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to selectively
-- enable these features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_device_fault VK_EXT_device_fault>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceFaultFeaturesEXT = PhysicalDeviceFaultFeaturesEXT
  { -- | #features-deviceFault# @deviceFault@ indicates that the implementation
    -- supports the reporting of device fault information.
    PhysicalDeviceFaultFeaturesEXT -> Bool
deviceFault :: Bool
  , -- | #features-deviceFaultVendorBinary# @deviceFaultVendorBinary@ indicates
    -- that the implementation supports the generation of vendor-specific
    -- binary crash dumps. These may provide additional information when
    -- imported into vendor-specific external tools.
    PhysicalDeviceFaultFeaturesEXT -> Bool
deviceFaultVendorBinary :: Bool
  }
  deriving (Typeable, PhysicalDeviceFaultFeaturesEXT
-> PhysicalDeviceFaultFeaturesEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceFaultFeaturesEXT
-> PhysicalDeviceFaultFeaturesEXT -> Bool
$c/= :: PhysicalDeviceFaultFeaturesEXT
-> PhysicalDeviceFaultFeaturesEXT -> Bool
== :: PhysicalDeviceFaultFeaturesEXT
-> PhysicalDeviceFaultFeaturesEXT -> Bool
$c== :: PhysicalDeviceFaultFeaturesEXT
-> PhysicalDeviceFaultFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceFaultFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceFaultFeaturesEXT

instance ToCStruct PhysicalDeviceFaultFeaturesEXT where
  withCStruct :: forall b.
PhysicalDeviceFaultFeaturesEXT
-> (Ptr PhysicalDeviceFaultFeaturesEXT -> IO b) -> IO b
withCStruct PhysicalDeviceFaultFeaturesEXT
x Ptr PhysicalDeviceFaultFeaturesEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceFaultFeaturesEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceFaultFeaturesEXT
p PhysicalDeviceFaultFeaturesEXT
x (Ptr PhysicalDeviceFaultFeaturesEXT -> IO b
f Ptr PhysicalDeviceFaultFeaturesEXT
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceFaultFeaturesEXT
-> PhysicalDeviceFaultFeaturesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceFaultFeaturesEXT
p PhysicalDeviceFaultFeaturesEXT{Bool
deviceFaultVendorBinary :: Bool
deviceFault :: Bool
$sel:deviceFaultVendorBinary:PhysicalDeviceFaultFeaturesEXT :: PhysicalDeviceFaultFeaturesEXT -> Bool
$sel:deviceFault:PhysicalDeviceFaultFeaturesEXT :: PhysicalDeviceFaultFeaturesEXT -> Bool
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceFaultFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_FAULT_FEATURES_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceFaultFeaturesEXT
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 PhysicalDeviceFaultFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
deviceFault))
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceFaultFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
deviceFaultVendorBinary))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr PhysicalDeviceFaultFeaturesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceFaultFeaturesEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceFaultFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_FAULT_FEATURES_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceFaultFeaturesEXT
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 PhysicalDeviceFaultFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceFaultFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct PhysicalDeviceFaultFeaturesEXT where
  peekCStruct :: Ptr PhysicalDeviceFaultFeaturesEXT
-> IO PhysicalDeviceFaultFeaturesEXT
peekCStruct Ptr PhysicalDeviceFaultFeaturesEXT
p = do
    Bool32
deviceFault <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceFaultFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    Bool32
deviceFaultVendorBinary <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceFaultFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> PhysicalDeviceFaultFeaturesEXT
PhysicalDeviceFaultFeaturesEXT
             (Bool32 -> Bool
bool32ToBool Bool32
deviceFault) (Bool32 -> Bool
bool32ToBool Bool32
deviceFaultVendorBinary)

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

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


-- | VkDeviceFaultAddressInfoEXT - Structure specifying GPU virtual address
-- information
--
-- = Description
--
-- The combination of @reportedAddress@ and @addressPrecision@ allow the
-- possible range of addresses to be calculated, such that:
--
-- > lower_address = (pInfo->reportedAddress & ~(pInfo->addressPrecision-1))
-- > upper_address = (pInfo->reportedAddress |  (pInfo->addressPrecision-1))
--
-- Note
--
-- It is valid for the @reportedAddress@ to contain a more precise address
-- than indicated by @addressPrecision@. In this case, the value of
-- @reportedAddress@ should be treated as an additional hint as to the
-- value of the address that triggered the page fault, or to the value of
-- an instruction pointer.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_device_fault VK_EXT_device_fault>,
-- 'Vulkan.Core10.FundamentalTypes.DeviceAddress',
-- 'DeviceFaultAddressTypeEXT', 'DeviceFaultInfoEXT',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize'
data DeviceFaultAddressInfoEXT = DeviceFaultAddressInfoEXT
  { -- | @addressType@ is either the type of memory operation that triggered a
    -- page fault, or the type of association between an instruction pointer
    -- and a fault.
    --
    -- #VUID-VkDeviceFaultAddressInfoEXT-addressType-parameter# @addressType@
    -- /must/ be a valid 'DeviceFaultAddressTypeEXT' value
    DeviceFaultAddressInfoEXT -> DeviceFaultAddressTypeEXT
addressType :: DeviceFaultAddressTypeEXT
  , -- | @reportedAddress@ is the GPU virtual address recorded by the device.
    DeviceFaultAddressInfoEXT -> DeviceAddress
reportedAddress :: DeviceAddress
  , -- | @addressPrecision@ is a power of two value that specifies how precisely
    -- the device can report the address.
    DeviceFaultAddressInfoEXT -> DeviceAddress
addressPrecision :: DeviceSize
  }
  deriving (Typeable, DeviceFaultAddressInfoEXT -> DeviceFaultAddressInfoEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceFaultAddressInfoEXT -> DeviceFaultAddressInfoEXT -> Bool
$c/= :: DeviceFaultAddressInfoEXT -> DeviceFaultAddressInfoEXT -> Bool
== :: DeviceFaultAddressInfoEXT -> DeviceFaultAddressInfoEXT -> Bool
$c== :: DeviceFaultAddressInfoEXT -> DeviceFaultAddressInfoEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DeviceFaultAddressInfoEXT)
#endif
deriving instance Show DeviceFaultAddressInfoEXT

instance ToCStruct DeviceFaultAddressInfoEXT where
  withCStruct :: forall b.
DeviceFaultAddressInfoEXT
-> (Ptr DeviceFaultAddressInfoEXT -> IO b) -> IO b
withCStruct DeviceFaultAddressInfoEXT
x Ptr DeviceFaultAddressInfoEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr DeviceFaultAddressInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DeviceFaultAddressInfoEXT
p DeviceFaultAddressInfoEXT
x (Ptr DeviceFaultAddressInfoEXT -> IO b
f Ptr DeviceFaultAddressInfoEXT
p)
  pokeCStruct :: forall b.
Ptr DeviceFaultAddressInfoEXT
-> DeviceFaultAddressInfoEXT -> IO b -> IO b
pokeCStruct Ptr DeviceFaultAddressInfoEXT
p DeviceFaultAddressInfoEXT{DeviceAddress
DeviceFaultAddressTypeEXT
addressPrecision :: DeviceAddress
reportedAddress :: DeviceAddress
addressType :: DeviceFaultAddressTypeEXT
$sel:addressPrecision:DeviceFaultAddressInfoEXT :: DeviceFaultAddressInfoEXT -> DeviceAddress
$sel:reportedAddress:DeviceFaultAddressInfoEXT :: DeviceFaultAddressInfoEXT -> DeviceAddress
$sel:addressType:DeviceFaultAddressInfoEXT :: DeviceFaultAddressInfoEXT -> DeviceFaultAddressTypeEXT
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultAddressInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceFaultAddressTypeEXT)) (DeviceFaultAddressTypeEXT
addressType)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultAddressInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DeviceAddress)) (DeviceAddress
reportedAddress)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultAddressInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize)) (DeviceAddress
addressPrecision)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr DeviceFaultAddressInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr DeviceFaultAddressInfoEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultAddressInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceFaultAddressTypeEXT)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultAddressInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DeviceAddress)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultAddressInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DeviceFaultAddressInfoEXT where
  peekCStruct :: Ptr DeviceFaultAddressInfoEXT -> IO DeviceFaultAddressInfoEXT
peekCStruct Ptr DeviceFaultAddressInfoEXT
p = do
    DeviceFaultAddressTypeEXT
addressType <- forall a. Storable a => Ptr a -> IO a
peek @DeviceFaultAddressTypeEXT ((Ptr DeviceFaultAddressInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceFaultAddressTypeEXT))
    DeviceAddress
reportedAddress <- forall a. Storable a => Ptr a -> IO a
peek @DeviceAddress ((Ptr DeviceFaultAddressInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DeviceAddress))
    DeviceAddress
addressPrecision <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr DeviceFaultAddressInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeviceFaultAddressTypeEXT
-> DeviceAddress -> DeviceAddress -> DeviceFaultAddressInfoEXT
DeviceFaultAddressInfoEXT
             DeviceFaultAddressTypeEXT
addressType DeviceAddress
reportedAddress DeviceAddress
addressPrecision

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

instance Zero DeviceFaultAddressInfoEXT where
  zero :: DeviceFaultAddressInfoEXT
zero = DeviceFaultAddressTypeEXT
-> DeviceAddress -> DeviceAddress -> DeviceFaultAddressInfoEXT
DeviceFaultAddressInfoEXT
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkDeviceFaultVendorInfoEXT - Structure specifying vendor-specific fault
-- information
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_device_fault VK_EXT_device_fault>,
-- 'DeviceFaultInfoEXT'
data DeviceFaultVendorInfoEXT = DeviceFaultVendorInfoEXT
  { -- | @description@ is an array of
    -- 'Vulkan.Core10.APIConstants.MAX_DESCRIPTION_SIZE' @char@ containing a
    -- null-terminated UTF-8 string which is a human readable description of
    -- the fault.
    DeviceFaultVendorInfoEXT -> ByteString
description :: ByteString
  , -- | @vendorFaultCode@ is the vendor-specific fault code for this fault.
    DeviceFaultVendorInfoEXT -> DeviceAddress
vendorFaultCode :: Word64
  , -- | @vendorFaultData@ is the vendor-specific fault data associated with this
    -- fault.
    DeviceFaultVendorInfoEXT -> DeviceAddress
vendorFaultData :: Word64
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DeviceFaultVendorInfoEXT)
#endif
deriving instance Show DeviceFaultVendorInfoEXT

instance ToCStruct DeviceFaultVendorInfoEXT where
  withCStruct :: forall b.
DeviceFaultVendorInfoEXT
-> (Ptr DeviceFaultVendorInfoEXT -> IO b) -> IO b
withCStruct DeviceFaultVendorInfoEXT
x Ptr DeviceFaultVendorInfoEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
272 forall a b. (a -> b) -> a -> b
$ \Ptr DeviceFaultVendorInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DeviceFaultVendorInfoEXT
p DeviceFaultVendorInfoEXT
x (Ptr DeviceFaultVendorInfoEXT -> IO b
f Ptr DeviceFaultVendorInfoEXT
p)
  pokeCStruct :: forall b.
Ptr DeviceFaultVendorInfoEXT
-> DeviceFaultVendorInfoEXT -> IO b -> IO b
pokeCStruct Ptr DeviceFaultVendorInfoEXT
p DeviceFaultVendorInfoEXT{DeviceAddress
ByteString
vendorFaultData :: DeviceAddress
vendorFaultCode :: DeviceAddress
description :: ByteString
$sel:vendorFaultData:DeviceFaultVendorInfoEXT :: DeviceFaultVendorInfoEXT -> DeviceAddress
$sel:vendorFaultCode:DeviceFaultVendorInfoEXT :: DeviceFaultVendorInfoEXT -> DeviceAddress
$sel:description:DeviceFaultVendorInfoEXT :: DeviceFaultVendorInfoEXT -> ByteString
..} IO b
f = do
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr DeviceFaultVendorInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
description)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
256 :: Ptr Word64)) (DeviceAddress
vendorFaultCode)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
264 :: Ptr Word64)) (DeviceAddress
vendorFaultData)
    IO b
f
  cStructSize :: Int
cStructSize = Int
272
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr DeviceFaultVendorInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr DeviceFaultVendorInfoEXT
p IO b
f = do
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr DeviceFaultVendorInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
256 :: Ptr Word64)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
264 :: Ptr Word64)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DeviceFaultVendorInfoEXT where
  peekCStruct :: Ptr DeviceFaultVendorInfoEXT -> IO DeviceFaultVendorInfoEXT
peekCStruct Ptr DeviceFaultVendorInfoEXT
p = do
    ByteString
description <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr DeviceFaultVendorInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
    DeviceAddress
vendorFaultCode <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr DeviceFaultVendorInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
256 :: Ptr Word64))
    DeviceAddress
vendorFaultData <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr DeviceFaultVendorInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
264 :: Ptr Word64))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString
-> DeviceAddress -> DeviceAddress -> DeviceFaultVendorInfoEXT
DeviceFaultVendorInfoEXT
             ByteString
description DeviceAddress
vendorFaultCode DeviceAddress
vendorFaultData

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

instance Zero DeviceFaultVendorInfoEXT where
  zero :: DeviceFaultVendorInfoEXT
zero = ByteString
-> DeviceAddress -> DeviceAddress -> DeviceFaultVendorInfoEXT
DeviceFaultVendorInfoEXT
           forall a. Monoid a => a
mempty
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkDeviceFaultCountsEXT - Structure specifying device fault information
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_device_fault VK_EXT_device_fault>,
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getDeviceFaultInfoEXT'
data DeviceFaultCountsEXT = DeviceFaultCountsEXT
  { -- | @addressInfoCount@ is the number of 'DeviceFaultAddressInfoEXT'
    -- structures describing either memory accesses which /may/ have caused a
    -- page fault, or the addresses of active instructions at the time of the
    -- fault.
    DeviceFaultCountsEXT -> Word32
addressInfoCount :: Word32
  , -- | @vendorInfoCount@ is the number of 'DeviceFaultVendorInfoEXT' structures
    -- describing vendor-specific fault information.
    DeviceFaultCountsEXT -> Word32
vendorInfoCount :: Word32
  , -- | @vendorBinarySize@ is the size in bytes of a vendor-specific binary
    -- crash dump, which may provide additional information when imported into
    -- external tools.
    DeviceFaultCountsEXT -> DeviceAddress
vendorBinarySize :: DeviceSize
  }
  deriving (Typeable, DeviceFaultCountsEXT -> DeviceFaultCountsEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceFaultCountsEXT -> DeviceFaultCountsEXT -> Bool
$c/= :: DeviceFaultCountsEXT -> DeviceFaultCountsEXT -> Bool
== :: DeviceFaultCountsEXT -> DeviceFaultCountsEXT -> Bool
$c== :: DeviceFaultCountsEXT -> DeviceFaultCountsEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DeviceFaultCountsEXT)
#endif
deriving instance Show DeviceFaultCountsEXT

instance ToCStruct DeviceFaultCountsEXT where
  withCStruct :: forall b.
DeviceFaultCountsEXT
-> (("pFaultCounts" ::: Ptr DeviceFaultCountsEXT) -> IO b) -> IO b
withCStruct DeviceFaultCountsEXT
x ("pFaultCounts" ::: Ptr DeviceFaultCountsEXT) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pFaultCounts" ::: Ptr DeviceFaultCountsEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pFaultCounts" ::: Ptr DeviceFaultCountsEXT
p DeviceFaultCountsEXT
x (("pFaultCounts" ::: Ptr DeviceFaultCountsEXT) -> IO b
f "pFaultCounts" ::: Ptr DeviceFaultCountsEXT
p)
  pokeCStruct :: forall b.
("pFaultCounts" ::: Ptr DeviceFaultCountsEXT)
-> DeviceFaultCountsEXT -> IO b -> IO b
pokeCStruct "pFaultCounts" ::: Ptr DeviceFaultCountsEXT
p DeviceFaultCountsEXT{Word32
DeviceAddress
vendorBinarySize :: DeviceAddress
vendorInfoCount :: Word32
addressInfoCount :: Word32
$sel:vendorBinarySize:DeviceFaultCountsEXT :: DeviceFaultCountsEXT -> DeviceAddress
$sel:vendorInfoCount:DeviceFaultCountsEXT :: DeviceFaultCountsEXT -> Word32
$sel:addressInfoCount:DeviceFaultCountsEXT :: DeviceFaultCountsEXT -> Word32
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFaultCounts" ::: Ptr DeviceFaultCountsEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_FAULT_COUNTS_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFaultCounts" ::: Ptr DeviceFaultCountsEXT
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 (("pFaultCounts" ::: Ptr DeviceFaultCountsEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
addressInfoCount)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFaultCounts" ::: Ptr DeviceFaultCountsEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
vendorInfoCount)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFaultCounts" ::: Ptr DeviceFaultCountsEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize)) (DeviceAddress
vendorBinarySize)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pFaultCounts" ::: Ptr DeviceFaultCountsEXT) -> IO b -> IO b
pokeZeroCStruct "pFaultCounts" ::: Ptr DeviceFaultCountsEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFaultCounts" ::: Ptr DeviceFaultCountsEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_FAULT_COUNTS_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFaultCounts" ::: Ptr DeviceFaultCountsEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct DeviceFaultCountsEXT where
  peekCStruct :: ("pFaultCounts" ::: Ptr DeviceFaultCountsEXT)
-> IO DeviceFaultCountsEXT
peekCStruct "pFaultCounts" ::: Ptr DeviceFaultCountsEXT
p = do
    Word32
addressInfoCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pFaultCounts" ::: Ptr DeviceFaultCountsEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Word32
vendorInfoCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pFaultCounts" ::: Ptr DeviceFaultCountsEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    DeviceAddress
vendorBinarySize <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize (("pFaultCounts" ::: Ptr DeviceFaultCountsEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> DeviceAddress -> DeviceFaultCountsEXT
DeviceFaultCountsEXT
             Word32
addressInfoCount Word32
vendorInfoCount DeviceAddress
vendorBinarySize

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

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


-- | VkDeviceFaultInfoEXT - Structure specifying device fault information
--
-- = Description
--
-- An implementation /should/ populate as many members of
-- 'DeviceFaultInfoEXT' as possible, given the information available at the
-- time of the fault and the constraints of the implementation itself.
--
-- Due to hardware limitations, @pAddressInfos@ describes ranges of GPU
-- virtual address space, rather than precise addresses. The precise memory
-- address accessed or the precise value of the instruction pointer /must/
-- lie within the region described.
--
-- Note
--
-- Each element of @pAddressInfos@ describes either:
--
-- -   A memory access which may have triggered a page fault and may have
--     contributed to device loss
--
-- -   The value of an active instruction pointer at the time a fault
--     occurred. This value may be indicative of the active pipeline or
--     shader at the time of device loss
--
-- Comparison of the GPU virtual addresses described by @pAddressInfos@ to
-- GPU virtual address ranges reported by the
-- @VK_EXT_device_address_binding_report@ extension may allow applications
-- to correlate between these addresses and Vulkan objects. Applications
-- should be aware that these addresses may also correspond to resources
-- internal to an implementation, which will not be reported via the
-- @VK_EXT_device_address_binding_report@ extension.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkDeviceFaultInfoEXT-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DEVICE_FAULT_INFO_EXT'
--
-- -   #VUID-VkDeviceFaultInfoEXT-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkDeviceFaultInfoEXT-pAddressInfos-parameter# If
--     @pAddressInfos@ is not @NULL@, @pAddressInfos@ /must/ be a valid
--     pointer to a 'DeviceFaultAddressInfoEXT' structure
--
-- -   #VUID-VkDeviceFaultInfoEXT-pVendorInfos-parameter# If @pVendorInfos@
--     is not @NULL@, @pVendorInfos@ /must/ be a valid pointer to a
--     'DeviceFaultVendorInfoEXT' structure
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_device_fault VK_EXT_device_fault>,
-- 'DeviceFaultAddressInfoEXT', 'DeviceFaultVendorInfoEXT',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getDeviceFaultInfoEXT'
data DeviceFaultInfoEXT = DeviceFaultInfoEXT
  { -- | @description@ is an array of
    -- 'Vulkan.Core10.APIConstants.MAX_DESCRIPTION_SIZE' @char@ containing a
    -- null-terminated UTF-8 string which is a human readable description of
    -- the fault.
    DeviceFaultInfoEXT -> ByteString
description :: ByteString
  , -- | @pAddressInfos@ is @NULL@ or a pointer to an array of
    -- 'DeviceFaultAddressInfoEXT' structures describing either memory accesses
    -- which /may/ have caused a page fault, or describing active instruction
    -- pointers at the time of the fault. If not @NULL@, each element of
    -- @pAddressInfos@ describes the a bounded region of GPU virtual address
    -- space containing either the GPU virtual address accessed, or the value
    -- of an active instruction pointer.
    DeviceFaultInfoEXT -> Ptr DeviceFaultAddressInfoEXT
addressInfos :: Ptr DeviceFaultAddressInfoEXT
  , -- | @pVendorInfos@ is @NULL@ or a pointer to an array of
    -- 'DeviceFaultVendorInfoEXT' structures describing vendor-specific fault
    -- information.
    DeviceFaultInfoEXT -> Ptr DeviceFaultVendorInfoEXT
vendorInfos :: Ptr DeviceFaultVendorInfoEXT
  , -- | @pVendorBinaryData@ is @NULL@ or a pointer to @vendorBinarySize@ number
    -- of bytes of data, which will be populated with a vendor-specific binary
    -- crash dump, as described in
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#vendor-binary-crash-dumps Vendor Binary Crash Dumps>.
    DeviceFaultInfoEXT -> Ptr ()
vendorBinaryData :: Ptr ()
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DeviceFaultInfoEXT)
#endif
deriving instance Show DeviceFaultInfoEXT

instance ToCStruct DeviceFaultInfoEXT where
  withCStruct :: forall b.
DeviceFaultInfoEXT
-> (("pFaultInfo" ::: Ptr DeviceFaultInfoEXT) -> IO b) -> IO b
withCStruct DeviceFaultInfoEXT
x ("pFaultInfo" ::: Ptr DeviceFaultInfoEXT) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
296 forall a b. (a -> b) -> a -> b
$ \"pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p DeviceFaultInfoEXT
x (("pFaultInfo" ::: Ptr DeviceFaultInfoEXT) -> IO b
f "pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p)
  pokeCStruct :: forall b.
("pFaultInfo" ::: Ptr DeviceFaultInfoEXT)
-> DeviceFaultInfoEXT -> IO b -> IO b
pokeCStruct "pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p DeviceFaultInfoEXT{Ptr ()
Ptr DeviceFaultVendorInfoEXT
Ptr DeviceFaultAddressInfoEXT
ByteString
vendorBinaryData :: Ptr ()
vendorInfos :: Ptr DeviceFaultVendorInfoEXT
addressInfos :: Ptr DeviceFaultAddressInfoEXT
description :: ByteString
$sel:vendorBinaryData:DeviceFaultInfoEXT :: DeviceFaultInfoEXT -> Ptr ()
$sel:vendorInfos:DeviceFaultInfoEXT :: DeviceFaultInfoEXT -> Ptr DeviceFaultVendorInfoEXT
$sel:addressInfos:DeviceFaultInfoEXT :: DeviceFaultInfoEXT -> Ptr DeviceFaultAddressInfoEXT
$sel:description:DeviceFaultInfoEXT :: DeviceFaultInfoEXT -> ByteString
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_FAULT_INFO_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
description)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (Ptr DeviceFaultAddressInfoEXT))) (Ptr DeviceFaultAddressInfoEXT
addressInfos)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
280 :: Ptr (Ptr DeviceFaultVendorInfoEXT))) (Ptr DeviceFaultVendorInfoEXT
vendorInfos)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
288 :: Ptr (Ptr ()))) (Ptr ()
vendorBinaryData)
    IO b
f
  cStructSize :: Int
cStructSize = Int
296
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. ("pFaultInfo" ::: Ptr DeviceFaultInfoEXT) -> IO b -> IO b
pokeZeroCStruct "pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_FAULT_INFO_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
    IO b
f

instance FromCStruct DeviceFaultInfoEXT where
  peekCStruct :: ("pFaultInfo" ::: Ptr DeviceFaultInfoEXT) -> IO DeviceFaultInfoEXT
peekCStruct "pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p = do
    ByteString
description <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
    Ptr DeviceFaultAddressInfoEXT
pAddressInfos <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr DeviceFaultAddressInfoEXT) (("pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (Ptr DeviceFaultAddressInfoEXT)))
    Ptr DeviceFaultVendorInfoEXT
pVendorInfos <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr DeviceFaultVendorInfoEXT) (("pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
280 :: Ptr (Ptr DeviceFaultVendorInfoEXT)))
    Ptr ()
pVendorBinaryData <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) (("pFaultInfo" ::: Ptr DeviceFaultInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
288 :: Ptr (Ptr ())))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString
-> Ptr DeviceFaultAddressInfoEXT
-> Ptr DeviceFaultVendorInfoEXT
-> Ptr ()
-> DeviceFaultInfoEXT
DeviceFaultInfoEXT
             ByteString
description Ptr DeviceFaultAddressInfoEXT
pAddressInfos Ptr DeviceFaultVendorInfoEXT
pVendorInfos Ptr ()
pVendorBinaryData

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

instance Zero DeviceFaultInfoEXT where
  zero :: DeviceFaultInfoEXT
zero = ByteString
-> Ptr DeviceFaultAddressInfoEXT
-> Ptr DeviceFaultVendorInfoEXT
-> Ptr ()
-> DeviceFaultInfoEXT
DeviceFaultInfoEXT
           forall a. Monoid a => a
mempty
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkDeviceFaultVendorBinaryHeaderVersionOneEXT - Structure describing the
-- layout of the vendor binary crash dump header
--
-- = Description
--
-- Unlike most structures declared by the Vulkan API, all fields of this
-- structure are written with the least significant byte first, regardless
-- of host byte-order.
--
-- The C language specification does not define the packing of structure
-- members. This layout assumes tight structure member packing, with
-- members laid out in the order listed in the structure, and the intended
-- size of the structure is 56 bytes. If a compiler produces code that
-- diverges from that pattern, applications /must/ employ another method to
-- set values at the correct offsets.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_device_fault VK_EXT_device_fault>,
-- 'DeviceFaultVendorBinaryHeaderVersionEXT'
data DeviceFaultVendorBinaryHeaderVersionOneEXT = DeviceFaultVendorBinaryHeaderVersionOneEXT
  { -- | @headerSize@ is the length in bytes of the crash dump header.
    --
    -- #VUID-VkDeviceFaultVendorBinaryHeaderVersionOneEXT-headerSize-07340#
    -- @headerSize@ /must/ be 56
    DeviceFaultVendorBinaryHeaderVersionOneEXT -> Word32
headerSize :: Word32
  , -- | @headerVersion@ is a 'DeviceFaultVendorBinaryHeaderVersionEXT' enum
    -- value specifying the version of the header. A consumer of the crash dump
    -- /should/ use the header version to interpret the remainder of the
    -- header.
    --
    -- #VUID-VkDeviceFaultVendorBinaryHeaderVersionOneEXT-headerVersion-07341#
    -- @headerVersion@ /must/ be
    -- 'DEVICE_FAULT_VENDOR_BINARY_HEADER_VERSION_ONE_EXT'
    --
    -- #VUID-VkDeviceFaultVendorBinaryHeaderVersionOneEXT-headerVersion-parameter#
    -- @headerVersion@ /must/ be a valid
    -- 'DeviceFaultVendorBinaryHeaderVersionEXT' value
    DeviceFaultVendorBinaryHeaderVersionOneEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT
headerVersion :: DeviceFaultVendorBinaryHeaderVersionEXT
  , -- | @vendorID@ is the
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceProperties'::@vendorID@
    -- of the implementation.
    DeviceFaultVendorBinaryHeaderVersionOneEXT -> Word32
vendorID :: Word32
  , -- | @deviceID@ is the
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceProperties'::@deviceID@
    -- of the implementation.
    DeviceFaultVendorBinaryHeaderVersionOneEXT -> Word32
deviceID :: Word32
  , -- | @driverVersion@ is the
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceProperties'::@driverVersion@
    -- of the implementation.
    DeviceFaultVendorBinaryHeaderVersionOneEXT -> Word32
driverVersion :: Word32
  , -- | @pipelineCacheUUID@ is an array of
    -- 'Vulkan.Core10.APIConstants.UUID_SIZE' @uint8_t@ values matching the
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceProperties'::@pipelineCacheUUID@
    -- property of the implementation.
    DeviceFaultVendorBinaryHeaderVersionOneEXT -> ByteString
pipelineCacheUUID :: ByteString
  , -- | @applicationNameOffset@ is zero, or an offset from the base address of
    -- the crash dump header to a null-terminated UTF-8 string containing the
    -- name of the application. If @applicationNameOffset@ is non-zero, this
    -- string /must/ match the application name specified via
    -- 'Vulkan.Core10.DeviceInitialization.ApplicationInfo'::@pApplicationName@
    -- during instance creation.
    DeviceFaultVendorBinaryHeaderVersionOneEXT -> Word32
applicationNameOffset :: Word32
  , -- | @applicationVersion@ /must/ be zero or the value specified by
    -- 'Vulkan.Core10.DeviceInitialization.ApplicationInfo'::@applicationVersion@
    -- during instance creation.
    DeviceFaultVendorBinaryHeaderVersionOneEXT -> Word32
applicationVersion :: Word32
  , -- | @engineNameOffset@ is zero, or an offset from the base address of the
    -- crash dump header to a null-terminated UTF-8 string containing the name
    -- of the engine (if any) used to create the application. If
    -- @engineNameOffset@ is non-zero, this string /must/ match the engine name
    -- specified via
    -- 'Vulkan.Core10.DeviceInitialization.ApplicationInfo'::@pEngineName@
    -- during instance creation.
    DeviceFaultVendorBinaryHeaderVersionOneEXT -> Word32
engineNameOffset :: Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DeviceFaultVendorBinaryHeaderVersionOneEXT)
#endif
deriving instance Show DeviceFaultVendorBinaryHeaderVersionOneEXT

instance ToCStruct DeviceFaultVendorBinaryHeaderVersionOneEXT where
  withCStruct :: forall b.
DeviceFaultVendorBinaryHeaderVersionOneEXT
-> (Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT -> IO b) -> IO b
withCStruct DeviceFaultVendorBinaryHeaderVersionOneEXT
x Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 forall a b. (a -> b) -> a -> b
$ \Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p DeviceFaultVendorBinaryHeaderVersionOneEXT
x (Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT -> IO b
f Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p)
  pokeCStruct :: forall b.
Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
-> DeviceFaultVendorBinaryHeaderVersionOneEXT -> IO b -> IO b
pokeCStruct Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p DeviceFaultVendorBinaryHeaderVersionOneEXT{Word32
ByteString
DeviceFaultVendorBinaryHeaderVersionEXT
engineNameOffset :: Word32
applicationVersion :: Word32
applicationNameOffset :: Word32
pipelineCacheUUID :: ByteString
driverVersion :: Word32
deviceID :: Word32
vendorID :: Word32
headerVersion :: DeviceFaultVendorBinaryHeaderVersionEXT
headerSize :: Word32
$sel:engineNameOffset:DeviceFaultVendorBinaryHeaderVersionOneEXT :: DeviceFaultVendorBinaryHeaderVersionOneEXT -> Word32
$sel:applicationVersion:DeviceFaultVendorBinaryHeaderVersionOneEXT :: DeviceFaultVendorBinaryHeaderVersionOneEXT -> Word32
$sel:applicationNameOffset:DeviceFaultVendorBinaryHeaderVersionOneEXT :: DeviceFaultVendorBinaryHeaderVersionOneEXT -> Word32
$sel:pipelineCacheUUID:DeviceFaultVendorBinaryHeaderVersionOneEXT :: DeviceFaultVendorBinaryHeaderVersionOneEXT -> ByteString
$sel:driverVersion:DeviceFaultVendorBinaryHeaderVersionOneEXT :: DeviceFaultVendorBinaryHeaderVersionOneEXT -> Word32
$sel:deviceID:DeviceFaultVendorBinaryHeaderVersionOneEXT :: DeviceFaultVendorBinaryHeaderVersionOneEXT -> Word32
$sel:vendorID:DeviceFaultVendorBinaryHeaderVersionOneEXT :: DeviceFaultVendorBinaryHeaderVersionOneEXT -> Word32
$sel:headerVersion:DeviceFaultVendorBinaryHeaderVersionOneEXT :: DeviceFaultVendorBinaryHeaderVersionOneEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT
$sel:headerSize:DeviceFaultVendorBinaryHeaderVersionOneEXT :: DeviceFaultVendorBinaryHeaderVersionOneEXT -> Word32
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (Word32
headerSize)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr DeviceFaultVendorBinaryHeaderVersionEXT)) (DeviceFaultVendorBinaryHeaderVersionEXT
headerVersion)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (Word32
vendorID)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32)) (Word32
deviceID)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
driverVersion)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ByteString -> IO ()
pokeFixedLengthByteString ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray UUID_SIZE Word8))) (ByteString
pipelineCacheUUID)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (Word32
applicationNameOffset)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) (Word32
applicationVersion)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32)) (Word32
engineNameOffset)
    IO b
f
  cStructSize :: Int
cStructSize = Int
48
  cStructAlignment :: Int
cStructAlignment = Int
4
  pokeZeroCStruct :: forall b.
Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT -> IO b -> IO b
pokeZeroCStruct Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr DeviceFaultVendorBinaryHeaderVersionEXT)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ByteString -> IO ()
pokeFixedLengthByteString ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray UUID_SIZE Word8))) (forall a. Monoid a => a
mempty)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
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 ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
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 ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DeviceFaultVendorBinaryHeaderVersionOneEXT where
  peekCStruct :: Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
-> IO DeviceFaultVendorBinaryHeaderVersionOneEXT
peekCStruct Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p = do
    Word32
headerSize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32))
    DeviceFaultVendorBinaryHeaderVersionEXT
headerVersion <- forall a. Storable a => Ptr a -> IO a
peek @DeviceFaultVendorBinaryHeaderVersionEXT ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr DeviceFaultVendorBinaryHeaderVersionEXT))
    Word32
vendorID <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32))
    Word32
deviceID <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32))
    Word32
driverVersion <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    ByteString
pipelineCacheUUID <- forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> IO ByteString
peekByteStringFromSizedVectorPtr ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray UUID_SIZE Word8)))
    Word32
applicationNameOffset <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32))
    Word32
applicationVersion <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32))
    Word32
engineNameOffset <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DeviceFaultVendorBinaryHeaderVersionOneEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32
-> DeviceFaultVendorBinaryHeaderVersionEXT
-> Word32
-> Word32
-> Word32
-> ByteString
-> Word32
-> Word32
-> Word32
-> DeviceFaultVendorBinaryHeaderVersionOneEXT
DeviceFaultVendorBinaryHeaderVersionOneEXT
             Word32
headerSize
             DeviceFaultVendorBinaryHeaderVersionEXT
headerVersion
             Word32
vendorID
             Word32
deviceID
             Word32
driverVersion
             ByteString
pipelineCacheUUID
             Word32
applicationNameOffset
             Word32
applicationVersion
             Word32
engineNameOffset

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

instance Zero DeviceFaultVendorBinaryHeaderVersionOneEXT where
  zero :: DeviceFaultVendorBinaryHeaderVersionOneEXT
zero = Word32
-> DeviceFaultVendorBinaryHeaderVersionEXT
-> Word32
-> Word32
-> Word32
-> ByteString
-> Word32
-> Word32
-> Word32
-> DeviceFaultVendorBinaryHeaderVersionOneEXT
DeviceFaultVendorBinaryHeaderVersionOneEXT
           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. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkDeviceFaultAddressTypeEXT - Page fault access types
--
-- = Description
--
-- Note
--
-- The instruction pointer values recorded may not identify the specific
-- instruction(s) that triggered the fault. The relationship between the
-- instruction pointer reported and triggering instruction will be
-- vendor-specific.
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_device_fault VK_EXT_device_fault>,
-- 'DeviceFaultAddressInfoEXT'
newtype DeviceFaultAddressTypeEXT = DeviceFaultAddressTypeEXT Int32
  deriving newtype (DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Bool
$c/= :: DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Bool
== :: DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Bool
$c== :: DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Bool
Eq, Eq DeviceFaultAddressTypeEXT
DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Bool
DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Ordering
DeviceFaultAddressTypeEXT
-> DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DeviceFaultAddressTypeEXT
-> DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT
$cmin :: DeviceFaultAddressTypeEXT
-> DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT
max :: DeviceFaultAddressTypeEXT
-> DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT
$cmax :: DeviceFaultAddressTypeEXT
-> DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT
>= :: DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Bool
$c>= :: DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Bool
> :: DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Bool
$c> :: DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Bool
<= :: DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Bool
$c<= :: DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Bool
< :: DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Bool
$c< :: DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Bool
compare :: DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Ordering
$ccompare :: DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> Ordering
Ord, Ptr DeviceFaultAddressTypeEXT -> IO DeviceFaultAddressTypeEXT
Ptr DeviceFaultAddressTypeEXT
-> Int -> IO DeviceFaultAddressTypeEXT
Ptr DeviceFaultAddressTypeEXT
-> Int -> DeviceFaultAddressTypeEXT -> IO ()
Ptr DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> IO ()
DeviceFaultAddressTypeEXT -> Int
forall b. Ptr b -> Int -> IO DeviceFaultAddressTypeEXT
forall b. Ptr b -> Int -> DeviceFaultAddressTypeEXT -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> IO ()
$cpoke :: Ptr DeviceFaultAddressTypeEXT -> DeviceFaultAddressTypeEXT -> IO ()
peek :: Ptr DeviceFaultAddressTypeEXT -> IO DeviceFaultAddressTypeEXT
$cpeek :: Ptr DeviceFaultAddressTypeEXT -> IO DeviceFaultAddressTypeEXT
pokeByteOff :: forall b. Ptr b -> Int -> DeviceFaultAddressTypeEXT -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> DeviceFaultAddressTypeEXT -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO DeviceFaultAddressTypeEXT
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DeviceFaultAddressTypeEXT
pokeElemOff :: Ptr DeviceFaultAddressTypeEXT
-> Int -> DeviceFaultAddressTypeEXT -> IO ()
$cpokeElemOff :: Ptr DeviceFaultAddressTypeEXT
-> Int -> DeviceFaultAddressTypeEXT -> IO ()
peekElemOff :: Ptr DeviceFaultAddressTypeEXT
-> Int -> IO DeviceFaultAddressTypeEXT
$cpeekElemOff :: Ptr DeviceFaultAddressTypeEXT
-> Int -> IO DeviceFaultAddressTypeEXT
alignment :: DeviceFaultAddressTypeEXT -> Int
$calignment :: DeviceFaultAddressTypeEXT -> Int
sizeOf :: DeviceFaultAddressTypeEXT -> Int
$csizeOf :: DeviceFaultAddressTypeEXT -> Int
Storable, DeviceFaultAddressTypeEXT
forall a. a -> Zero a
zero :: DeviceFaultAddressTypeEXT
$czero :: DeviceFaultAddressTypeEXT
Zero)

-- | 'DEVICE_FAULT_ADDRESS_TYPE_NONE_EXT' specifies that
-- 'DeviceFaultAddressInfoEXT' does not describe a page fault, or an
-- instruction address.
pattern $bDEVICE_FAULT_ADDRESS_TYPE_NONE_EXT :: DeviceFaultAddressTypeEXT
$mDEVICE_FAULT_ADDRESS_TYPE_NONE_EXT :: forall {r}.
DeviceFaultAddressTypeEXT -> ((# #) -> r) -> ((# #) -> r) -> r
DEVICE_FAULT_ADDRESS_TYPE_NONE_EXT = DeviceFaultAddressTypeEXT 0

-- | 'DEVICE_FAULT_ADDRESS_TYPE_READ_INVALID_EXT' specifies that
-- 'DeviceFaultAddressInfoEXT' describes a page fault triggered by an
-- invalid read operation.
pattern $bDEVICE_FAULT_ADDRESS_TYPE_READ_INVALID_EXT :: DeviceFaultAddressTypeEXT
$mDEVICE_FAULT_ADDRESS_TYPE_READ_INVALID_EXT :: forall {r}.
DeviceFaultAddressTypeEXT -> ((# #) -> r) -> ((# #) -> r) -> r
DEVICE_FAULT_ADDRESS_TYPE_READ_INVALID_EXT = DeviceFaultAddressTypeEXT 1

-- | 'DEVICE_FAULT_ADDRESS_TYPE_WRITE_INVALID_EXT' specifies that
-- 'DeviceFaultAddressInfoEXT' describes a page fault triggered by an
-- invalid write operation.
pattern $bDEVICE_FAULT_ADDRESS_TYPE_WRITE_INVALID_EXT :: DeviceFaultAddressTypeEXT
$mDEVICE_FAULT_ADDRESS_TYPE_WRITE_INVALID_EXT :: forall {r}.
DeviceFaultAddressTypeEXT -> ((# #) -> r) -> ((# #) -> r) -> r
DEVICE_FAULT_ADDRESS_TYPE_WRITE_INVALID_EXT = DeviceFaultAddressTypeEXT 2

-- | 'DEVICE_FAULT_ADDRESS_TYPE_EXECUTE_INVALID_EXT' describes a page fault
-- triggered by an attempt to execute non-executable memory.
pattern $bDEVICE_FAULT_ADDRESS_TYPE_EXECUTE_INVALID_EXT :: DeviceFaultAddressTypeEXT
$mDEVICE_FAULT_ADDRESS_TYPE_EXECUTE_INVALID_EXT :: forall {r}.
DeviceFaultAddressTypeEXT -> ((# #) -> r) -> ((# #) -> r) -> r
DEVICE_FAULT_ADDRESS_TYPE_EXECUTE_INVALID_EXT = DeviceFaultAddressTypeEXT 3

-- | 'DEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_UNKNOWN_EXT' specifies an
-- instruction pointer value at the time the fault occurred. This may or
-- may not be related to a fault.
pattern $bDEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_UNKNOWN_EXT :: DeviceFaultAddressTypeEXT
$mDEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_UNKNOWN_EXT :: forall {r}.
DeviceFaultAddressTypeEXT -> ((# #) -> r) -> ((# #) -> r) -> r
DEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_UNKNOWN_EXT = DeviceFaultAddressTypeEXT 4

-- | 'DEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_INVALID_EXT' specifies an
-- instruction pointer value associated with an invalid instruction fault.
pattern $bDEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_INVALID_EXT :: DeviceFaultAddressTypeEXT
$mDEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_INVALID_EXT :: forall {r}.
DeviceFaultAddressTypeEXT -> ((# #) -> r) -> ((# #) -> r) -> r
DEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_INVALID_EXT = DeviceFaultAddressTypeEXT 5

-- | 'DEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_FAULT_EXT' specifies an
-- instruction pointer value associated with a fault.
pattern $bDEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_FAULT_EXT :: DeviceFaultAddressTypeEXT
$mDEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_FAULT_EXT :: forall {r}.
DeviceFaultAddressTypeEXT -> ((# #) -> r) -> ((# #) -> r) -> r
DEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_FAULT_EXT = DeviceFaultAddressTypeEXT 6

{-# COMPLETE
  DEVICE_FAULT_ADDRESS_TYPE_NONE_EXT
  , DEVICE_FAULT_ADDRESS_TYPE_READ_INVALID_EXT
  , DEVICE_FAULT_ADDRESS_TYPE_WRITE_INVALID_EXT
  , DEVICE_FAULT_ADDRESS_TYPE_EXECUTE_INVALID_EXT
  , DEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_UNKNOWN_EXT
  , DEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_INVALID_EXT
  , DEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_FAULT_EXT ::
    DeviceFaultAddressTypeEXT
  #-}

conNameDeviceFaultAddressTypeEXT :: String
conNameDeviceFaultAddressTypeEXT :: String
conNameDeviceFaultAddressTypeEXT = String
"DeviceFaultAddressTypeEXT"

enumPrefixDeviceFaultAddressTypeEXT :: String
enumPrefixDeviceFaultAddressTypeEXT :: String
enumPrefixDeviceFaultAddressTypeEXT = String
"DEVICE_FAULT_ADDRESS_TYPE_"

showTableDeviceFaultAddressTypeEXT :: [(DeviceFaultAddressTypeEXT, String)]
showTableDeviceFaultAddressTypeEXT :: [(DeviceFaultAddressTypeEXT, String)]
showTableDeviceFaultAddressTypeEXT =
  [
    ( DeviceFaultAddressTypeEXT
DEVICE_FAULT_ADDRESS_TYPE_NONE_EXT
    , String
"NONE_EXT"
    )
  ,
    ( DeviceFaultAddressTypeEXT
DEVICE_FAULT_ADDRESS_TYPE_READ_INVALID_EXT
    , String
"READ_INVALID_EXT"
    )
  ,
    ( DeviceFaultAddressTypeEXT
DEVICE_FAULT_ADDRESS_TYPE_WRITE_INVALID_EXT
    , String
"WRITE_INVALID_EXT"
    )
  ,
    ( DeviceFaultAddressTypeEXT
DEVICE_FAULT_ADDRESS_TYPE_EXECUTE_INVALID_EXT
    , String
"EXECUTE_INVALID_EXT"
    )
  ,
    ( DeviceFaultAddressTypeEXT
DEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_UNKNOWN_EXT
    , String
"INSTRUCTION_POINTER_UNKNOWN_EXT"
    )
  ,
    ( DeviceFaultAddressTypeEXT
DEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_INVALID_EXT
    , String
"INSTRUCTION_POINTER_INVALID_EXT"
    )
  ,
    ( DeviceFaultAddressTypeEXT
DEVICE_FAULT_ADDRESS_TYPE_INSTRUCTION_POINTER_FAULT_EXT
    , String
"INSTRUCTION_POINTER_FAULT_EXT"
    )
  ]

instance Show DeviceFaultAddressTypeEXT where
  showsPrec :: Int -> DeviceFaultAddressTypeEXT -> ShowS
showsPrec =
    forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixDeviceFaultAddressTypeEXT
      [(DeviceFaultAddressTypeEXT, String)]
showTableDeviceFaultAddressTypeEXT
      String
conNameDeviceFaultAddressTypeEXT
      (\(DeviceFaultAddressTypeEXT Int32
x) -> Int32
x)
      (forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read DeviceFaultAddressTypeEXT where
  readPrec :: ReadPrec DeviceFaultAddressTypeEXT
readPrec =
    forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixDeviceFaultAddressTypeEXT
      [(DeviceFaultAddressTypeEXT, String)]
showTableDeviceFaultAddressTypeEXT
      String
conNameDeviceFaultAddressTypeEXT
      Int32 -> DeviceFaultAddressTypeEXT
DeviceFaultAddressTypeEXT

-- | VkDeviceFaultVendorBinaryHeaderVersionEXT - Encode vendor binary crash
-- dump version
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_device_fault VK_EXT_device_fault>,
-- 'DeviceFaultVendorBinaryHeaderVersionOneEXT', 'getDeviceFaultInfoEXT'
newtype DeviceFaultVendorBinaryHeaderVersionEXT = DeviceFaultVendorBinaryHeaderVersionEXT Int32
  deriving newtype (DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Bool
$c/= :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Bool
== :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Bool
$c== :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Bool
Eq, Eq DeviceFaultVendorBinaryHeaderVersionEXT
DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Bool
DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Ordering
DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT
$cmin :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT
max :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT
$cmax :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT
>= :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Bool
$c>= :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Bool
> :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Bool
$c> :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Bool
<= :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Bool
$c<= :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Bool
< :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Bool
$c< :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Bool
compare :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Ordering
$ccompare :: DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> Ordering
Ord, Ptr DeviceFaultVendorBinaryHeaderVersionEXT
-> IO DeviceFaultVendorBinaryHeaderVersionEXT
Ptr DeviceFaultVendorBinaryHeaderVersionEXT
-> Int -> IO DeviceFaultVendorBinaryHeaderVersionEXT
Ptr DeviceFaultVendorBinaryHeaderVersionEXT
-> Int -> DeviceFaultVendorBinaryHeaderVersionEXT -> IO ()
Ptr DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> IO ()
DeviceFaultVendorBinaryHeaderVersionEXT -> Int
forall b.
Ptr b -> Int -> IO DeviceFaultVendorBinaryHeaderVersionEXT
forall b.
Ptr b -> Int -> DeviceFaultVendorBinaryHeaderVersionEXT -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> IO ()
$cpoke :: Ptr DeviceFaultVendorBinaryHeaderVersionEXT
-> DeviceFaultVendorBinaryHeaderVersionEXT -> IO ()
peek :: Ptr DeviceFaultVendorBinaryHeaderVersionEXT
-> IO DeviceFaultVendorBinaryHeaderVersionEXT
$cpeek :: Ptr DeviceFaultVendorBinaryHeaderVersionEXT
-> IO DeviceFaultVendorBinaryHeaderVersionEXT
pokeByteOff :: forall b.
Ptr b -> Int -> DeviceFaultVendorBinaryHeaderVersionEXT -> IO ()
$cpokeByteOff :: forall b.
Ptr b -> Int -> DeviceFaultVendorBinaryHeaderVersionEXT -> IO ()
peekByteOff :: forall b.
Ptr b -> Int -> IO DeviceFaultVendorBinaryHeaderVersionEXT
$cpeekByteOff :: forall b.
Ptr b -> Int -> IO DeviceFaultVendorBinaryHeaderVersionEXT
pokeElemOff :: Ptr DeviceFaultVendorBinaryHeaderVersionEXT
-> Int -> DeviceFaultVendorBinaryHeaderVersionEXT -> IO ()
$cpokeElemOff :: Ptr DeviceFaultVendorBinaryHeaderVersionEXT
-> Int -> DeviceFaultVendorBinaryHeaderVersionEXT -> IO ()
peekElemOff :: Ptr DeviceFaultVendorBinaryHeaderVersionEXT
-> Int -> IO DeviceFaultVendorBinaryHeaderVersionEXT
$cpeekElemOff :: Ptr DeviceFaultVendorBinaryHeaderVersionEXT
-> Int -> IO DeviceFaultVendorBinaryHeaderVersionEXT
alignment :: DeviceFaultVendorBinaryHeaderVersionEXT -> Int
$calignment :: DeviceFaultVendorBinaryHeaderVersionEXT -> Int
sizeOf :: DeviceFaultVendorBinaryHeaderVersionEXT -> Int
$csizeOf :: DeviceFaultVendorBinaryHeaderVersionEXT -> Int
Storable, DeviceFaultVendorBinaryHeaderVersionEXT
forall a. a -> Zero a
zero :: DeviceFaultVendorBinaryHeaderVersionEXT
$czero :: DeviceFaultVendorBinaryHeaderVersionEXT
Zero)

-- Note that the zero instance does not produce a valid value, passing 'zero' to Vulkan will result in an error

-- | 'DEVICE_FAULT_VENDOR_BINARY_HEADER_VERSION_ONE_EXT' specifies version
-- one of the binary crash dump header.
pattern $bDEVICE_FAULT_VENDOR_BINARY_HEADER_VERSION_ONE_EXT :: DeviceFaultVendorBinaryHeaderVersionEXT
$mDEVICE_FAULT_VENDOR_BINARY_HEADER_VERSION_ONE_EXT :: forall {r}.
DeviceFaultVendorBinaryHeaderVersionEXT
-> ((# #) -> r) -> ((# #) -> r) -> r
DEVICE_FAULT_VENDOR_BINARY_HEADER_VERSION_ONE_EXT = DeviceFaultVendorBinaryHeaderVersionEXT 1

{-# COMPLETE DEVICE_FAULT_VENDOR_BINARY_HEADER_VERSION_ONE_EXT :: DeviceFaultVendorBinaryHeaderVersionEXT #-}

conNameDeviceFaultVendorBinaryHeaderVersionEXT :: String
conNameDeviceFaultVendorBinaryHeaderVersionEXT :: String
conNameDeviceFaultVendorBinaryHeaderVersionEXT = String
"DeviceFaultVendorBinaryHeaderVersionEXT"

enumPrefixDeviceFaultVendorBinaryHeaderVersionEXT :: String
enumPrefixDeviceFaultVendorBinaryHeaderVersionEXT :: String
enumPrefixDeviceFaultVendorBinaryHeaderVersionEXT = String
"DEVICE_FAULT_VENDOR_BINARY_HEADER_VERSION_ONE_EXT"

showTableDeviceFaultVendorBinaryHeaderVersionEXT :: [(DeviceFaultVendorBinaryHeaderVersionEXT, String)]
showTableDeviceFaultVendorBinaryHeaderVersionEXT :: [(DeviceFaultVendorBinaryHeaderVersionEXT, String)]
showTableDeviceFaultVendorBinaryHeaderVersionEXT =
  [
    ( DeviceFaultVendorBinaryHeaderVersionEXT
DEVICE_FAULT_VENDOR_BINARY_HEADER_VERSION_ONE_EXT
    , String
""
    )
  ]

instance Show DeviceFaultVendorBinaryHeaderVersionEXT where
  showsPrec :: Int -> DeviceFaultVendorBinaryHeaderVersionEXT -> ShowS
showsPrec =
    forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixDeviceFaultVendorBinaryHeaderVersionEXT
      [(DeviceFaultVendorBinaryHeaderVersionEXT, String)]
showTableDeviceFaultVendorBinaryHeaderVersionEXT
      String
conNameDeviceFaultVendorBinaryHeaderVersionEXT
      (\(DeviceFaultVendorBinaryHeaderVersionEXT Int32
x) -> Int32
x)
      (forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read DeviceFaultVendorBinaryHeaderVersionEXT where
  readPrec :: ReadPrec DeviceFaultVendorBinaryHeaderVersionEXT
readPrec =
    forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixDeviceFaultVendorBinaryHeaderVersionEXT
      [(DeviceFaultVendorBinaryHeaderVersionEXT, String)]
showTableDeviceFaultVendorBinaryHeaderVersionEXT
      String
conNameDeviceFaultVendorBinaryHeaderVersionEXT
      Int32 -> DeviceFaultVendorBinaryHeaderVersionEXT
DeviceFaultVendorBinaryHeaderVersionEXT

type EXT_DEVICE_FAULT_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_EXT_DEVICE_FAULT_SPEC_VERSION"
pattern EXT_DEVICE_FAULT_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_DEVICE_FAULT_SPEC_VERSION :: forall a. Integral a => a
$mEXT_DEVICE_FAULT_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_DEVICE_FAULT_SPEC_VERSION = 1


type EXT_DEVICE_FAULT_EXTENSION_NAME = "VK_EXT_device_fault"

-- No documentation found for TopLevel "VK_EXT_DEVICE_FAULT_EXTENSION_NAME"
pattern EXT_DEVICE_FAULT_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_DEVICE_FAULT_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_DEVICE_FAULT_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_DEVICE_FAULT_EXTENSION_NAME = "VK_EXT_device_fault"