{-# language CPP #-}
module Graphics.VulkanMemoryAllocator ( createAllocator
, withAllocator
, destroyAllocator
, getAllocatorInfo
, getPhysicalDeviceProperties
, getMemoryProperties
, getMemoryTypeProperties
, setCurrentFrameIndex
, calculateStats
, getBudget
, buildStatsString
, freeStatsString
, findMemoryTypeIndex
, findMemoryTypeIndexForBufferInfo
, findMemoryTypeIndexForImageInfo
, createPool
, withPool
, destroyPool
, getPoolStats
, makePoolAllocationsLost
, checkPoolCorruption
, getPoolName
, setPoolName
, allocateMemory
, withMemory
, allocateMemoryPages
, withMemoryPages
, allocateMemoryForBuffer
, withMemoryForBuffer
, allocateMemoryForImage
, withMemoryForImage
, freeMemory
, freeMemoryPages
, resizeAllocation
, getAllocationInfo
, touchAllocation
, setAllocationUserData
, createLostAllocation
, withLostAllocation
, mapMemory
, withMappedMemory
, unmapMemory
, flushAllocation
, invalidateAllocation
, flushAllocations
, invalidateAllocations
, checkCorruption
, defragmentationBegin
, withDefragmentation
, defragmentationEnd
, beginDefragmentationPass
, withDefragmentationPass
, endDefragmentationPass
, defragment
, bindBufferMemory
, bindBufferMemory2
, bindImageMemory
, bindImageMemory2
, createBuffer
, withBuffer
, destroyBuffer
, createImage
, withImage
, destroyImage
, Allocator(..)
, PFN_vmaAllocateDeviceMemoryFunction
, FN_vmaAllocateDeviceMemoryFunction
, PFN_vmaFreeDeviceMemoryFunction
, FN_vmaFreeDeviceMemoryFunction
, DeviceMemoryCallbacks(..)
, AllocatorCreateFlagBits( ALLOCATOR_CREATE_EXTERNALLY_SYNCHRONIZED_BIT
, ALLOCATOR_CREATE_KHR_DEDICATED_ALLOCATION_BIT
, ALLOCATOR_CREATE_KHR_BIND_MEMORY2_BIT
, ALLOCATOR_CREATE_EXT_MEMORY_BUDGET_BIT
, ALLOCATOR_CREATE_AMD_DEVICE_COHERENT_MEMORY_BIT
, ALLOCATOR_CREATE_BUFFER_DEVICE_ADDRESS_BIT
, ..
)
, AllocatorCreateFlags
, VulkanFunctions(..)
, RecordFlagBits( RECORD_FLUSH_AFTER_CALL_BIT
, ..
)
, RecordFlags
, RecordSettings(..)
, AllocatorCreateInfo(..)
, AllocatorInfo(..)
, StatInfo(..)
, Stats(..)
, Budget(..)
, Pool(..)
, MemoryUsage( MEMORY_USAGE_UNKNOWN
, MEMORY_USAGE_GPU_ONLY
, MEMORY_USAGE_CPU_ONLY
, MEMORY_USAGE_CPU_TO_GPU
, MEMORY_USAGE_GPU_TO_CPU
, MEMORY_USAGE_CPU_COPY
, MEMORY_USAGE_GPU_LAZILY_ALLOCATED
, ..
)
, AllocationCreateFlagBits( ALLOCATION_CREATE_DEDICATED_MEMORY_BIT
, ALLOCATION_CREATE_NEVER_ALLOCATE_BIT
, ALLOCATION_CREATE_MAPPED_BIT
, ALLOCATION_CREATE_CAN_BECOME_LOST_BIT
, ALLOCATION_CREATE_CAN_MAKE_OTHER_LOST_BIT
, ALLOCATION_CREATE_USER_DATA_COPY_STRING_BIT
, ALLOCATION_CREATE_UPPER_ADDRESS_BIT
, ALLOCATION_CREATE_DONT_BIND_BIT
, ALLOCATION_CREATE_WITHIN_BUDGET_BIT
, ALLOCATION_CREATE_STRATEGY_BEST_FIT_BIT
, ALLOCATION_CREATE_STRATEGY_WORST_FIT_BIT
, ALLOCATION_CREATE_STRATEGY_FIRST_FIT_BIT
, ALLOCATION_CREATE_STRATEGY_MIN_MEMORY_BIT
, ALLOCATION_CREATE_STRATEGY_MIN_TIME_BIT
, ALLOCATION_CREATE_STRATEGY_MIN_FRAGMENTATION_BIT
, ALLOCATION_CREATE_STRATEGY_MASK
, ..
)
, AllocationCreateFlags
, AllocationCreateInfo(..)
, PoolCreateFlagBits( POOL_CREATE_IGNORE_BUFFER_IMAGE_GRANULARITY_BIT
, POOL_CREATE_LINEAR_ALGORITHM_BIT
, POOL_CREATE_BUDDY_ALGORITHM_BIT
, POOL_CREATE_ALGORITHM_MASK
, ..
)
, PoolCreateFlags
, PoolCreateInfo(..)
, PoolStats(..)
, Allocation(..)
, AllocationInfo(..)
, DefragmentationContext(..)
, DefragmentationFlagBits( DEFRAGMENTATION_FLAG_INCREMENTAL
, ..
)
, DefragmentationFlags
, DefragmentationInfo2(..)
, DefragmentationPassMoveInfo(..)
, DefragmentationPassInfo(..)
, DefragmentationInfo(..)
, DefragmentationStats(..)
) where
import Graphics.Vulkan (AllocationCallbacks)
import Graphics.Vulkan (BindBufferMemoryInfo)
import Graphics.Vulkan (BindImageMemoryInfo)
import Graphics.Vulkan (Bool32)
import Graphics.Vulkan (Buffer)
import Graphics.Vulkan (BufferCopy)
import Graphics.Vulkan (BufferCreateInfo)
import Graphics.Vulkan (BufferMemoryRequirementsInfo2)
import Graphics.Vulkan (CommandBuffer_T)
import Graphics.Vulkan (DeviceMemory)
import Graphics.Vulkan (DeviceSize)
import Graphics.Vulkan (Device_T)
import Graphics.Vulkan (Flags)
import Graphics.Vulkan (Image)
import Graphics.Vulkan (ImageCreateInfo)
import Graphics.Vulkan (ImageMemoryRequirementsInfo2)
import Graphics.Vulkan (Instance_T)
import Graphics.Vulkan (MappedMemoryRange)
import Graphics.Vulkan (MemoryAllocateInfo)
import Graphics.Vulkan (MemoryMapFlags)
import Graphics.Vulkan (MemoryPropertyFlags)
import Graphics.Vulkan (MemoryRequirements)
import Graphics.Vulkan (MemoryRequirements2)
import Graphics.Vulkan (PhysicalDeviceMemoryProperties)
import Graphics.Vulkan (PhysicalDeviceMemoryProperties2)
import Graphics.Vulkan (PhysicalDeviceProperties)
import Graphics.Vulkan (PhysicalDevice_T)
import Graphics.Vulkan (Result)
import Graphics.Vulkan.CStruct.Utils (FixedArray)
import Graphics.Vulkan.CStruct.Utils (advancePtrBytes)
import Graphics.Vulkan.CStruct.Utils (lowerArrayPtr)
import Graphics.Vulkan.Core10.BaseType (bool32ToBool)
import Graphics.Vulkan.Core10.BaseType (boolToBool32)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Utils (maybePeek)
import GHC.Base (when)
import GHC.IO (throwIO)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Read (choose)
import GHC.Read (expectP)
import GHC.Read (parens)
import GHC.Show (showParen)
import GHC.Show (showString)
import GHC.Show (showsPrec)
import Numeric (showHex)
import Text.ParserCombinators.ReadPrec ((+++))
import Text.ParserCombinators.ReadPrec (prec)
import Text.ParserCombinators.ReadPrec (step)
import Data.ByteString (packCString)
import Data.ByteString (useAsCString)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import qualified Data.Vector (null)
import Graphics.Vulkan.Core10.APIConstants (pattern MAX_MEMORY_HEAPS)
import Graphics.Vulkan.Core10.APIConstants (pattern MAX_MEMORY_TYPES)
import Graphics.Vulkan.Core10.Enums.Result (pattern SUCCESS)
import Foreign.C.Types (CChar(..))
import Foreign.C.Types (CSize(..))
import Graphics.Vulkan (Bool32(..))
import Graphics.Vulkan (Buffer(..))
import Graphics.Vulkan (Image(..))
import Graphics.Vulkan (MemoryPropertyFlagBits(..))
import Graphics.Vulkan (Result(..))
import Graphics.Vulkan.CStruct (FromCStruct)
import Graphics.Vulkan.CStruct (FromCStruct(..))
import Graphics.Vulkan.CStruct (ToCStruct)
import Graphics.Vulkan.CStruct (ToCStruct(..))
import Graphics.Vulkan.CStruct.Extends (PokeChain)
import Graphics.Vulkan.CStruct.Extends (SomeStruct)
import Graphics.Vulkan.Core10.APIConstants (IsHandle)
import Graphics.Vulkan.Core10.APIConstants (MAX_MEMORY_HEAPS)
import Graphics.Vulkan.Core10.APIConstants (MAX_MEMORY_TYPES)
import Graphics.Vulkan.Exception (VulkanException(..))
import Graphics.Vulkan.NamedType ((:::))
import Graphics.Vulkan.Zero (Zero)
import Graphics.Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Bits (Bits)
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CSize)
import Foreign.C.Types (CSize(CSize))
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.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 Data.Word (Word32)
import Data.Word (Word64)
import Text.Read.Lex (Lexeme(Ident))
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaCreateAllocator" ffiVmaCreateAllocator
:: Ptr AllocatorCreateInfo -> Ptr Allocator -> IO Result
createAllocator :: forall io . MonadIO io => AllocatorCreateInfo -> io (Allocator)
createAllocator createInfo = liftIO . evalContT $ do
pCreateInfo <- ContT $ withCStruct (createInfo)
pPAllocator <- ContT $ bracket (callocBytes @Allocator 8) free
r <- lift $ (ffiVmaCreateAllocator) pCreateInfo (pPAllocator)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pAllocator <- lift $ peek @Allocator pPAllocator
pure $ (pAllocator)
withAllocator :: forall io r . MonadIO io => (io (Allocator) -> ((Allocator) -> io ()) -> r) -> AllocatorCreateInfo -> r
withAllocator b pCreateInfo =
b (createAllocator pCreateInfo)
(\(o0) -> destroyAllocator o0)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaDestroyAllocator" ffiVmaDestroyAllocator
:: Allocator -> IO ()
destroyAllocator :: forall io . MonadIO io => Allocator -> io ()
destroyAllocator allocator = liftIO $ do
(ffiVmaDestroyAllocator) (allocator)
pure $ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetAllocatorInfo" ffiVmaGetAllocatorInfo
:: Allocator -> Ptr AllocatorInfo -> IO ()
getAllocatorInfo :: forall io . MonadIO io => Allocator -> io (AllocatorInfo)
getAllocatorInfo allocator = liftIO . evalContT $ do
pPAllocatorInfo <- ContT (withZeroCStruct @AllocatorInfo)
lift $ (ffiVmaGetAllocatorInfo) (allocator) (pPAllocatorInfo)
pAllocatorInfo <- lift $ peekCStruct @AllocatorInfo pPAllocatorInfo
pure $ (pAllocatorInfo)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetPhysicalDeviceProperties" ffiVmaGetPhysicalDeviceProperties
:: Allocator -> Ptr (Ptr PhysicalDeviceProperties) -> IO ()
getPhysicalDeviceProperties :: forall io . MonadIO io => Allocator -> io (Ptr PhysicalDeviceProperties)
getPhysicalDeviceProperties allocator = liftIO . evalContT $ do
pPpPhysicalDeviceProperties <- ContT $ bracket (callocBytes @(Ptr PhysicalDeviceProperties) 8) free
lift $ (ffiVmaGetPhysicalDeviceProperties) (allocator) (pPpPhysicalDeviceProperties)
ppPhysicalDeviceProperties <- lift $ peek @(Ptr PhysicalDeviceProperties) pPpPhysicalDeviceProperties
pure $ (ppPhysicalDeviceProperties)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetMemoryProperties" ffiVmaGetMemoryProperties
:: Allocator -> Ptr (Ptr PhysicalDeviceMemoryProperties) -> IO ()
getMemoryProperties :: forall io . MonadIO io => Allocator -> io (Ptr PhysicalDeviceMemoryProperties)
getMemoryProperties allocator = liftIO . evalContT $ do
pPpPhysicalDeviceMemoryProperties <- ContT $ bracket (callocBytes @(Ptr PhysicalDeviceMemoryProperties) 8) free
lift $ (ffiVmaGetMemoryProperties) (allocator) (pPpPhysicalDeviceMemoryProperties)
ppPhysicalDeviceMemoryProperties <- lift $ peek @(Ptr PhysicalDeviceMemoryProperties) pPpPhysicalDeviceMemoryProperties
pure $ (ppPhysicalDeviceMemoryProperties)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetMemoryTypeProperties" ffiVmaGetMemoryTypeProperties
:: Allocator -> Word32 -> Ptr MemoryPropertyFlags -> IO ()
getMemoryTypeProperties :: forall io . MonadIO io => Allocator -> ("memoryTypeIndex" ::: Word32) -> io (MemoryPropertyFlags)
getMemoryTypeProperties allocator memoryTypeIndex = liftIO . evalContT $ do
pPFlags <- ContT $ bracket (callocBytes @MemoryPropertyFlags 4) free
lift $ (ffiVmaGetMemoryTypeProperties) (allocator) (memoryTypeIndex) (pPFlags)
pFlags <- lift $ peek @MemoryPropertyFlags pPFlags
pure $ (pFlags)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaSetCurrentFrameIndex" ffiVmaSetCurrentFrameIndex
:: Allocator -> Word32 -> IO ()
setCurrentFrameIndex :: forall io . MonadIO io => Allocator -> ("frameIndex" ::: Word32) -> io ()
setCurrentFrameIndex allocator frameIndex = liftIO $ do
(ffiVmaSetCurrentFrameIndex) (allocator) (frameIndex)
pure $ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaCalculateStats" ffiVmaCalculateStats
:: Allocator -> Ptr Stats -> IO ()
calculateStats :: forall io . MonadIO io => Allocator -> io (Stats)
calculateStats allocator = liftIO . evalContT $ do
pPStats <- ContT (withZeroCStruct @Stats)
lift $ (ffiVmaCalculateStats) (allocator) (pPStats)
pStats <- lift $ peekCStruct @Stats pPStats
pure $ (pStats)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetBudget" ffiVmaGetBudget
:: Allocator -> Ptr Budget -> IO ()
getBudget :: forall io . MonadIO io => Allocator -> io (Budget)
getBudget allocator = liftIO . evalContT $ do
pPBudget <- ContT (withZeroCStruct @Budget)
lift $ (ffiVmaGetBudget) (allocator) (pPBudget)
pBudget <- lift $ peekCStruct @Budget pPBudget
pure $ (pBudget)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaBuildStatsString" ffiVmaBuildStatsString
:: Allocator -> Ptr (Ptr CChar) -> Bool32 -> IO ()
buildStatsString :: forall io . MonadIO io => Allocator -> ("detailedMap" ::: Bool) -> io (("statsString" ::: Ptr CChar))
buildStatsString allocator detailedMap = liftIO . evalContT $ do
pPpStatsString <- ContT $ bracket (callocBytes @(Ptr CChar) 8) free
lift $ (ffiVmaBuildStatsString) (allocator) (pPpStatsString) (boolToBool32 (detailedMap))
ppStatsString <- lift $ peek @(Ptr CChar) pPpStatsString
pure $ (ppStatsString)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFreeStatsString" ffiVmaFreeStatsString
:: Allocator -> Ptr CChar -> IO ()
freeStatsString :: forall io . MonadIO io => Allocator -> ("statsString" ::: Ptr CChar) -> io ()
freeStatsString allocator statsString = liftIO $ do
(ffiVmaFreeStatsString) (allocator) (statsString)
pure $ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFindMemoryTypeIndex" ffiVmaFindMemoryTypeIndex
:: Allocator -> Word32 -> Ptr AllocationCreateInfo -> Ptr Word32 -> IO Result
findMemoryTypeIndex :: forall io . MonadIO io => Allocator -> ("memoryTypeBits" ::: Word32) -> AllocationCreateInfo -> io (("memoryTypeIndex" ::: Word32))
findMemoryTypeIndex allocator memoryTypeBits allocationCreateInfo = liftIO . evalContT $ do
pAllocationCreateInfo <- ContT $ withCStruct (allocationCreateInfo)
pPMemoryTypeIndex <- ContT $ bracket (callocBytes @Word32 4) free
r <- lift $ (ffiVmaFindMemoryTypeIndex) (allocator) (memoryTypeBits) pAllocationCreateInfo (pPMemoryTypeIndex)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pMemoryTypeIndex <- lift $ peek @Word32 pPMemoryTypeIndex
pure $ (pMemoryTypeIndex)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFindMemoryTypeIndexForBufferInfo" ffiVmaFindMemoryTypeIndexForBufferInfo
:: Allocator -> Ptr (BufferCreateInfo a) -> Ptr AllocationCreateInfo -> Ptr Word32 -> IO Result
findMemoryTypeIndexForBufferInfo :: forall a io . (PokeChain a, MonadIO io) => Allocator -> BufferCreateInfo a -> AllocationCreateInfo -> io (("memoryTypeIndex" ::: Word32))
findMemoryTypeIndexForBufferInfo allocator bufferCreateInfo allocationCreateInfo = liftIO . evalContT $ do
pBufferCreateInfo <- ContT $ withCStruct (bufferCreateInfo)
pAllocationCreateInfo <- ContT $ withCStruct (allocationCreateInfo)
pPMemoryTypeIndex <- ContT $ bracket (callocBytes @Word32 4) free
r <- lift $ (ffiVmaFindMemoryTypeIndexForBufferInfo) (allocator) pBufferCreateInfo pAllocationCreateInfo (pPMemoryTypeIndex)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pMemoryTypeIndex <- lift $ peek @Word32 pPMemoryTypeIndex
pure $ (pMemoryTypeIndex)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFindMemoryTypeIndexForImageInfo" ffiVmaFindMemoryTypeIndexForImageInfo
:: Allocator -> Ptr (ImageCreateInfo a) -> Ptr AllocationCreateInfo -> Ptr Word32 -> IO Result
findMemoryTypeIndexForImageInfo :: forall a io . (PokeChain a, MonadIO io) => Allocator -> ImageCreateInfo a -> AllocationCreateInfo -> io (("memoryTypeIndex" ::: Word32))
findMemoryTypeIndexForImageInfo allocator imageCreateInfo allocationCreateInfo = liftIO . evalContT $ do
pImageCreateInfo <- ContT $ withCStruct (imageCreateInfo)
pAllocationCreateInfo <- ContT $ withCStruct (allocationCreateInfo)
pPMemoryTypeIndex <- ContT $ bracket (callocBytes @Word32 4) free
r <- lift $ (ffiVmaFindMemoryTypeIndexForImageInfo) (allocator) pImageCreateInfo pAllocationCreateInfo (pPMemoryTypeIndex)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pMemoryTypeIndex <- lift $ peek @Word32 pPMemoryTypeIndex
pure $ (pMemoryTypeIndex)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaCreatePool" ffiVmaCreatePool
:: Allocator -> Ptr PoolCreateInfo -> Ptr Pool -> IO Result
createPool :: forall io . MonadIO io => Allocator -> PoolCreateInfo -> io (Pool)
createPool allocator createInfo = liftIO . evalContT $ do
pCreateInfo <- ContT $ withCStruct (createInfo)
pPPool <- ContT $ bracket (callocBytes @Pool 8) free
r <- lift $ (ffiVmaCreatePool) (allocator) pCreateInfo (pPPool)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pPool <- lift $ peek @Pool pPPool
pure $ (pPool)
withPool :: forall io r . MonadIO io => (io (Pool) -> ((Pool) -> io ()) -> r) -> Allocator -> PoolCreateInfo -> r
withPool b allocator pCreateInfo =
b (createPool allocator pCreateInfo)
(\(o0) -> destroyPool allocator o0)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaDestroyPool" ffiVmaDestroyPool
:: Allocator -> Pool -> IO ()
destroyPool :: forall io . MonadIO io => Allocator -> Pool -> io ()
destroyPool allocator pool = liftIO $ do
(ffiVmaDestroyPool) (allocator) (pool)
pure $ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetPoolStats" ffiVmaGetPoolStats
:: Allocator -> Pool -> Ptr PoolStats -> IO ()
getPoolStats :: forall io . MonadIO io => Allocator -> Pool -> io (PoolStats)
getPoolStats allocator pool = liftIO . evalContT $ do
pPPoolStats <- ContT (withZeroCStruct @PoolStats)
lift $ (ffiVmaGetPoolStats) (allocator) (pool) (pPPoolStats)
pPoolStats <- lift $ peekCStruct @PoolStats pPPoolStats
pure $ (pPoolStats)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaMakePoolAllocationsLost" ffiVmaMakePoolAllocationsLost
:: Allocator -> Pool -> Ptr CSize -> IO ()
makePoolAllocationsLost :: forall io . MonadIO io => Allocator -> Pool -> io (("lostAllocationCount" ::: Word64))
makePoolAllocationsLost allocator pool = liftIO . evalContT $ do
pPLostAllocationCount <- ContT $ bracket (callocBytes @CSize 8) free
lift $ (ffiVmaMakePoolAllocationsLost) (allocator) (pool) (pPLostAllocationCount)
pLostAllocationCount <- lift $ peek @CSize pPLostAllocationCount
pure $ (((\(CSize a) -> a) pLostAllocationCount))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaCheckPoolCorruption" ffiVmaCheckPoolCorruption
:: Allocator -> Pool -> IO Result
checkPoolCorruption :: forall io . MonadIO io => Allocator -> Pool -> io ()
checkPoolCorruption allocator pool = liftIO $ do
r <- (ffiVmaCheckPoolCorruption) (allocator) (pool)
when (r < SUCCESS) (throwIO (VulkanException r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetPoolName" ffiVmaGetPoolName
:: Allocator -> Pool -> Ptr (Ptr CChar) -> IO ()
getPoolName :: forall io . MonadIO io => Allocator -> Pool -> io (("name" ::: Ptr CChar))
getPoolName allocator pool = liftIO . evalContT $ do
pPpName <- ContT $ bracket (callocBytes @(Ptr CChar) 8) free
lift $ (ffiVmaGetPoolName) (allocator) (pool) (pPpName)
ppName <- lift $ peek @(Ptr CChar) pPpName
pure $ (ppName)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaSetPoolName" ffiVmaSetPoolName
:: Allocator -> Pool -> Ptr CChar -> IO ()
setPoolName :: forall io . MonadIO io => Allocator -> Pool -> ("name" ::: Maybe ByteString) -> io ()
setPoolName allocator pool name = liftIO . evalContT $ do
pName <- case (name) of
Nothing -> pure nullPtr
Just j -> ContT $ useAsCString (j)
lift $ (ffiVmaSetPoolName) (allocator) (pool) pName
pure $ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaAllocateMemory" ffiVmaAllocateMemory
:: Allocator -> Ptr MemoryRequirements -> Ptr AllocationCreateInfo -> Ptr Allocation -> Ptr AllocationInfo -> IO Result
allocateMemory :: forall io . MonadIO io => Allocator -> ("vkMemoryRequirements" ::: MemoryRequirements) -> AllocationCreateInfo -> io (Allocation, AllocationInfo)
allocateMemory allocator vkMemoryRequirements createInfo = liftIO . evalContT $ do
pVkMemoryRequirements <- ContT $ withCStruct (vkMemoryRequirements)
pCreateInfo <- ContT $ withCStruct (createInfo)
pPAllocation <- ContT $ bracket (callocBytes @Allocation 8) free
pPAllocationInfo <- ContT (withZeroCStruct @AllocationInfo)
r <- lift $ (ffiVmaAllocateMemory) (allocator) pVkMemoryRequirements pCreateInfo (pPAllocation) (pPAllocationInfo)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pAllocation <- lift $ peek @Allocation pPAllocation
pAllocationInfo <- lift $ peekCStruct @AllocationInfo pPAllocationInfo
pure $ (pAllocation, pAllocationInfo)
withMemory :: forall io r . MonadIO io => (io (Allocation, AllocationInfo) -> ((Allocation, AllocationInfo) -> io ()) -> r) -> Allocator -> MemoryRequirements -> AllocationCreateInfo -> r
withMemory b allocator pVkMemoryRequirements pCreateInfo =
b (allocateMemory allocator pVkMemoryRequirements pCreateInfo)
(\(o0, _) -> freeMemory allocator o0)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaAllocateMemoryPages" ffiVmaAllocateMemoryPages
:: Allocator -> Ptr MemoryRequirements -> Ptr AllocationCreateInfo -> CSize -> Ptr Allocation -> Ptr AllocationInfo -> IO Result
allocateMemoryPages :: forall io . MonadIO io => Allocator -> ("vkMemoryRequirements" ::: Vector MemoryRequirements) -> ("createInfo" ::: Vector AllocationCreateInfo) -> io (("allocations" ::: Vector Allocation), ("allocationInfo" ::: Vector AllocationInfo))
allocateMemoryPages allocator vkMemoryRequirements createInfo = liftIO . evalContT $ do
pPVkMemoryRequirements <- ContT $ allocaBytesAligned @MemoryRequirements ((Data.Vector.length (vkMemoryRequirements)) * 24) 8
Data.Vector.imapM_ (\i e -> ContT $ pokeCStruct (pPVkMemoryRequirements `plusPtr` (24 * (i)) :: Ptr MemoryRequirements) (e) . ($ ())) (vkMemoryRequirements)
pPCreateInfo <- ContT $ allocaBytesAligned @AllocationCreateInfo ((Data.Vector.length (createInfo)) * 40) 8
lift $ Data.Vector.imapM_ (\i e -> poke (pPCreateInfo `plusPtr` (40 * (i)) :: Ptr AllocationCreateInfo) (e)) (createInfo)
let pVkMemoryRequirementsLength = Data.Vector.length $ (vkMemoryRequirements)
let pCreateInfoLength = Data.Vector.length $ (createInfo)
lift $ unless (pCreateInfoLength == pVkMemoryRequirementsLength) $
throwIO $ IOError Nothing InvalidArgument "" "pCreateInfo and pVkMemoryRequirements must have the same length" Nothing Nothing
pPAllocations <- ContT $ bracket (callocBytes @Allocation ((fromIntegral ((fromIntegral pVkMemoryRequirementsLength :: CSize))) * 8)) free
pPAllocationInfo <- ContT $ bracket (callocBytes @AllocationInfo ((fromIntegral ((fromIntegral pVkMemoryRequirementsLength :: CSize))) * 48)) free
_ <- traverse (\i -> ContT $ pokeZeroCStruct (pPAllocationInfo `advancePtrBytes` (i * 48) :: Ptr AllocationInfo) . ($ ())) [0..(fromIntegral ((fromIntegral pVkMemoryRequirementsLength :: CSize))) - 1]
r <- lift $ (ffiVmaAllocateMemoryPages) (allocator) (pPVkMemoryRequirements) (pPCreateInfo) ((fromIntegral pVkMemoryRequirementsLength :: CSize)) (pPAllocations) ((pPAllocationInfo))
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pAllocations <- lift $ generateM (fromIntegral ((fromIntegral pVkMemoryRequirementsLength :: CSize))) (\i -> peek @Allocation ((pPAllocations `advancePtrBytes` (8 * (i)) :: Ptr Allocation)))
pAllocationInfo <- lift $ generateM (fromIntegral ((fromIntegral pVkMemoryRequirementsLength :: CSize))) (\i -> peekCStruct @AllocationInfo (((pPAllocationInfo) `advancePtrBytes` (48 * (i)) :: Ptr AllocationInfo)))
pure $ (pAllocations, pAllocationInfo)
withMemoryPages :: forall io r . MonadIO io => (io (Vector Allocation, Vector AllocationInfo) -> ((Vector Allocation, Vector AllocationInfo) -> io ()) -> r) -> Allocator -> Vector MemoryRequirements -> Vector AllocationCreateInfo -> r
withMemoryPages b allocator pVkMemoryRequirements pCreateInfo =
b (allocateMemoryPages allocator pVkMemoryRequirements pCreateInfo)
(\(o0, _) -> freeMemoryPages allocator o0)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaAllocateMemoryForBuffer" ffiVmaAllocateMemoryForBuffer
:: Allocator -> Buffer -> Ptr AllocationCreateInfo -> Ptr Allocation -> Ptr AllocationInfo -> IO Result
allocateMemoryForBuffer :: forall io . MonadIO io => Allocator -> Buffer -> AllocationCreateInfo -> io (Allocation, AllocationInfo)
allocateMemoryForBuffer allocator buffer createInfo = liftIO . evalContT $ do
pCreateInfo <- ContT $ withCStruct (createInfo)
pPAllocation <- ContT $ bracket (callocBytes @Allocation 8) free
pPAllocationInfo <- ContT (withZeroCStruct @AllocationInfo)
r <- lift $ (ffiVmaAllocateMemoryForBuffer) (allocator) (buffer) pCreateInfo (pPAllocation) (pPAllocationInfo)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pAllocation <- lift $ peek @Allocation pPAllocation
pAllocationInfo <- lift $ peekCStruct @AllocationInfo pPAllocationInfo
pure $ (pAllocation, pAllocationInfo)
withMemoryForBuffer :: forall io r . MonadIO io => (io (Allocation, AllocationInfo) -> ((Allocation, AllocationInfo) -> io ()) -> r) -> Allocator -> Buffer -> AllocationCreateInfo -> r
withMemoryForBuffer b allocator buffer pCreateInfo =
b (allocateMemoryForBuffer allocator buffer pCreateInfo)
(\(o0, _) -> freeMemory allocator o0)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaAllocateMemoryForImage" ffiVmaAllocateMemoryForImage
:: Allocator -> Image -> Ptr AllocationCreateInfo -> Ptr Allocation -> Ptr AllocationInfo -> IO Result
allocateMemoryForImage :: forall io . MonadIO io => Allocator -> Image -> AllocationCreateInfo -> io (Allocation, AllocationInfo)
allocateMemoryForImage allocator image createInfo = liftIO . evalContT $ do
pCreateInfo <- ContT $ withCStruct (createInfo)
pPAllocation <- ContT $ bracket (callocBytes @Allocation 8) free
pPAllocationInfo <- ContT (withZeroCStruct @AllocationInfo)
r <- lift $ (ffiVmaAllocateMemoryForImage) (allocator) (image) pCreateInfo (pPAllocation) (pPAllocationInfo)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pAllocation <- lift $ peek @Allocation pPAllocation
pAllocationInfo <- lift $ peekCStruct @AllocationInfo pPAllocationInfo
pure $ (pAllocation, pAllocationInfo)
withMemoryForImage :: forall io r . MonadIO io => (io (Allocation, AllocationInfo) -> ((Allocation, AllocationInfo) -> io ()) -> r) -> Allocator -> Image -> AllocationCreateInfo -> r
withMemoryForImage b allocator image pCreateInfo =
b (allocateMemoryForImage allocator image pCreateInfo)
(\(o0, _) -> freeMemory allocator o0)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFreeMemory" ffiVmaFreeMemory
:: Allocator -> Allocation -> IO ()
freeMemory :: forall io . MonadIO io => Allocator -> Allocation -> io ()
freeMemory allocator allocation = liftIO $ do
(ffiVmaFreeMemory) (allocator) (allocation)
pure $ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFreeMemoryPages" ffiVmaFreeMemoryPages
:: Allocator -> CSize -> Ptr Allocation -> IO ()
freeMemoryPages :: forall io . MonadIO io => Allocator -> ("allocations" ::: Vector Allocation) -> io ()
freeMemoryPages allocator allocations = liftIO . evalContT $ do
pPAllocations <- ContT $ allocaBytesAligned @Allocation ((Data.Vector.length (allocations)) * 8) 8
lift $ Data.Vector.imapM_ (\i e -> poke (pPAllocations `plusPtr` (8 * (i)) :: Ptr Allocation) (e)) (allocations)
lift $ (ffiVmaFreeMemoryPages) (allocator) ((fromIntegral (Data.Vector.length $ (allocations)) :: CSize)) (pPAllocations)
pure $ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaResizeAllocation" ffiVmaResizeAllocation
:: Allocator -> Allocation -> DeviceSize -> IO Result
resizeAllocation :: forall io . MonadIO io => Allocator -> Allocation -> ("newSize" ::: DeviceSize) -> io ()
resizeAllocation allocator allocation newSize = liftIO $ do
r <- (ffiVmaResizeAllocation) (allocator) (allocation) (newSize)
when (r < SUCCESS) (throwIO (VulkanException r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetAllocationInfo" ffiVmaGetAllocationInfo
:: Allocator -> Allocation -> Ptr AllocationInfo -> IO ()
getAllocationInfo :: forall io . MonadIO io => Allocator -> Allocation -> io (AllocationInfo)
getAllocationInfo allocator allocation = liftIO . evalContT $ do
pPAllocationInfo <- ContT (withZeroCStruct @AllocationInfo)
lift $ (ffiVmaGetAllocationInfo) (allocator) (allocation) (pPAllocationInfo)
pAllocationInfo <- lift $ peekCStruct @AllocationInfo pPAllocationInfo
pure $ (pAllocationInfo)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaTouchAllocation" ffiVmaTouchAllocation
:: Allocator -> Allocation -> IO Bool32
touchAllocation :: forall io . MonadIO io => Allocator -> Allocation -> io (Bool)
touchAllocation allocator allocation = liftIO $ do
r <- (ffiVmaTouchAllocation) (allocator) (allocation)
pure $ ((bool32ToBool r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaSetAllocationUserData" ffiVmaSetAllocationUserData
:: Allocator -> Allocation -> Ptr () -> IO ()
setAllocationUserData :: forall io . MonadIO io => Allocator -> Allocation -> ("userData" ::: Ptr ()) -> io ()
setAllocationUserData allocator allocation userData = liftIO $ do
(ffiVmaSetAllocationUserData) (allocator) (allocation) (userData)
pure $ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaCreateLostAllocation" ffiVmaCreateLostAllocation
:: Allocator -> Ptr Allocation -> IO ()
createLostAllocation :: forall io . MonadIO io => Allocator -> io (Allocation)
createLostAllocation allocator = liftIO . evalContT $ do
pPAllocation <- ContT $ bracket (callocBytes @Allocation 8) free
lift $ (ffiVmaCreateLostAllocation) (allocator) (pPAllocation)
pAllocation <- lift $ peek @Allocation pPAllocation
pure $ (pAllocation)
withLostAllocation :: forall io r . MonadIO io => (io (Allocation) -> ((Allocation) -> io ()) -> r) -> Allocator -> r
withLostAllocation b allocator =
b (createLostAllocation allocator)
(\(o0) -> freeMemory allocator o0)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaMapMemory" ffiVmaMapMemory
:: Allocator -> Allocation -> Ptr (Ptr ()) -> IO Result
mapMemory :: forall io . MonadIO io => Allocator -> Allocation -> io (("data" ::: Ptr ()))
mapMemory allocator allocation = liftIO . evalContT $ do
pPpData <- ContT $ bracket (callocBytes @(Ptr ()) 8) free
r <- lift $ (ffiVmaMapMemory) (allocator) (allocation) (pPpData)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
ppData <- lift $ peek @(Ptr ()) pPpData
pure $ (ppData)
withMappedMemory :: forall io r . MonadIO io => (io (Ptr ()) -> ((Ptr ()) -> io ()) -> r) -> Allocator -> Allocation -> r
withMappedMemory b allocator allocation =
b (mapMemory allocator allocation)
(\(_) -> unmapMemory allocator allocation)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaUnmapMemory" ffiVmaUnmapMemory
:: Allocator -> Allocation -> IO ()
unmapMemory :: forall io . MonadIO io => Allocator -> Allocation -> io ()
unmapMemory allocator allocation = liftIO $ do
(ffiVmaUnmapMemory) (allocator) (allocation)
pure $ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFlushAllocation" ffiVmaFlushAllocation
:: Allocator -> Allocation -> DeviceSize -> DeviceSize -> IO Result
flushAllocation :: forall io . MonadIO io => Allocator -> Allocation -> ("offset" ::: DeviceSize) -> DeviceSize -> io ()
flushAllocation allocator allocation offset size = liftIO $ do
r <- (ffiVmaFlushAllocation) (allocator) (allocation) (offset) (size)
when (r < SUCCESS) (throwIO (VulkanException r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaInvalidateAllocation" ffiVmaInvalidateAllocation
:: Allocator -> Allocation -> DeviceSize -> DeviceSize -> IO Result
invalidateAllocation :: forall io . MonadIO io => Allocator -> Allocation -> ("offset" ::: DeviceSize) -> DeviceSize -> io ()
invalidateAllocation allocator allocation offset size = liftIO $ do
r <- (ffiVmaInvalidateAllocation) (allocator) (allocation) (offset) (size)
when (r < SUCCESS) (throwIO (VulkanException r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFlushAllocations" ffiVmaFlushAllocations
:: Allocator -> Word32 -> Ptr Allocation -> Ptr DeviceSize -> Ptr DeviceSize -> IO Result
flushAllocations :: forall io . MonadIO io => Allocator -> ("allocations" ::: Vector Allocation) -> ("offsets" ::: Vector DeviceSize) -> ("sizes" ::: Vector DeviceSize) -> io ()
flushAllocations allocator allocations offsets sizes = liftIO . evalContT $ do
let allocationsLength = Data.Vector.length $ (allocations)
let offsetsLength = Data.Vector.length $ (offsets)
lift $ unless (fromIntegral offsetsLength == allocationsLength || offsetsLength == 0) $
throwIO $ IOError Nothing InvalidArgument "" "offsets and allocations must have the same length" Nothing Nothing
let sizesLength = Data.Vector.length $ (sizes)
lift $ unless (fromIntegral sizesLength == allocationsLength || sizesLength == 0) $
throwIO $ IOError Nothing InvalidArgument "" "sizes and allocations must have the same length" Nothing Nothing
pAllocations <- ContT $ allocaBytesAligned @Allocation ((Data.Vector.length (allocations)) * 8) 8
lift $ Data.Vector.imapM_ (\i e -> poke (pAllocations `plusPtr` (8 * (i)) :: Ptr Allocation) (e)) (allocations)
offsets' <- if Data.Vector.null (offsets)
then pure nullPtr
else do
pOffsets <- ContT $ allocaBytesAligned @DeviceSize (((Data.Vector.length (offsets))) * 8) 8
lift $ Data.Vector.imapM_ (\i e -> poke (pOffsets `plusPtr` (8 * (i)) :: Ptr DeviceSize) (e)) ((offsets))
pure $ pOffsets
sizes' <- if Data.Vector.null (sizes)
then pure nullPtr
else do
pSizes <- ContT $ allocaBytesAligned @DeviceSize (((Data.Vector.length (sizes))) * 8) 8
lift $ Data.Vector.imapM_ (\i e -> poke (pSizes `plusPtr` (8 * (i)) :: Ptr DeviceSize) (e)) ((sizes))
pure $ pSizes
r <- lift $ (ffiVmaFlushAllocations) (allocator) ((fromIntegral allocationsLength :: Word32)) (pAllocations) offsets' sizes'
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaInvalidateAllocations" ffiVmaInvalidateAllocations
:: Allocator -> Word32 -> Ptr Allocation -> Ptr DeviceSize -> Ptr DeviceSize -> IO Result
invalidateAllocations :: forall io . MonadIO io => Allocator -> ("allocations" ::: Vector Allocation) -> ("offsets" ::: Vector DeviceSize) -> ("sizes" ::: Vector DeviceSize) -> io ()
invalidateAllocations allocator allocations offsets sizes = liftIO . evalContT $ do
let allocationsLength = Data.Vector.length $ (allocations)
let offsetsLength = Data.Vector.length $ (offsets)
lift $ unless (fromIntegral offsetsLength == allocationsLength || offsetsLength == 0) $
throwIO $ IOError Nothing InvalidArgument "" "offsets and allocations must have the same length" Nothing Nothing
let sizesLength = Data.Vector.length $ (sizes)
lift $ unless (fromIntegral sizesLength == allocationsLength || sizesLength == 0) $
throwIO $ IOError Nothing InvalidArgument "" "sizes and allocations must have the same length" Nothing Nothing
pAllocations <- ContT $ allocaBytesAligned @Allocation ((Data.Vector.length (allocations)) * 8) 8
lift $ Data.Vector.imapM_ (\i e -> poke (pAllocations `plusPtr` (8 * (i)) :: Ptr Allocation) (e)) (allocations)
offsets' <- if Data.Vector.null (offsets)
then pure nullPtr
else do
pOffsets <- ContT $ allocaBytesAligned @DeviceSize (((Data.Vector.length (offsets))) * 8) 8
lift $ Data.Vector.imapM_ (\i e -> poke (pOffsets `plusPtr` (8 * (i)) :: Ptr DeviceSize) (e)) ((offsets))
pure $ pOffsets
sizes' <- if Data.Vector.null (sizes)
then pure nullPtr
else do
pSizes <- ContT $ allocaBytesAligned @DeviceSize (((Data.Vector.length (sizes))) * 8) 8
lift $ Data.Vector.imapM_ (\i e -> poke (pSizes `plusPtr` (8 * (i)) :: Ptr DeviceSize) (e)) ((sizes))
pure $ pSizes
r <- lift $ (ffiVmaInvalidateAllocations) (allocator) ((fromIntegral allocationsLength :: Word32)) (pAllocations) offsets' sizes'
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaCheckCorruption" ffiVmaCheckCorruption
:: Allocator -> Word32 -> IO Result
checkCorruption :: forall io . MonadIO io => Allocator -> ("memoryTypeBits" ::: Word32) -> io ()
checkCorruption allocator memoryTypeBits = liftIO $ do
r <- (ffiVmaCheckCorruption) (allocator) (memoryTypeBits)
when (r < SUCCESS) (throwIO (VulkanException r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaDefragmentationBegin" ffiVmaDefragmentationBegin
:: Allocator -> Ptr DefragmentationInfo2 -> Ptr DefragmentationStats -> Ptr DefragmentationContext -> IO Result
defragmentationBegin :: forall io . MonadIO io => Allocator -> DefragmentationInfo2 -> io (Result, DefragmentationStats, DefragmentationContext)
defragmentationBegin allocator info = liftIO . evalContT $ do
pInfo <- ContT $ withCStruct (info)
pPStats <- ContT (withZeroCStruct @DefragmentationStats)
pPContext <- ContT $ bracket (callocBytes @DefragmentationContext 8) free
r <- lift $ (ffiVmaDefragmentationBegin) (allocator) pInfo (pPStats) (pPContext)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pStats <- lift $ peekCStruct @DefragmentationStats pPStats
pContext <- lift $ peek @DefragmentationContext pPContext
pure $ (r, pStats, pContext)
withDefragmentation :: forall io r . MonadIO io => (io (Result, DefragmentationStats, DefragmentationContext) -> ((Result, DefragmentationStats, DefragmentationContext) -> io ()) -> r) -> Allocator -> DefragmentationInfo2 -> r
withDefragmentation b allocator pInfo =
b (defragmentationBegin allocator pInfo)
(\(_, _, o2) -> defragmentationEnd allocator o2)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaDefragmentationEnd" ffiVmaDefragmentationEnd
:: Allocator -> DefragmentationContext -> IO Result
defragmentationEnd :: forall io . MonadIO io => Allocator -> DefragmentationContext -> io ()
defragmentationEnd allocator context = liftIO $ do
r <- (ffiVmaDefragmentationEnd) (allocator) (context)
when (r < SUCCESS) (throwIO (VulkanException r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaBeginDefragmentationPass" ffiVmaBeginDefragmentationPass
:: Allocator -> DefragmentationContext -> Ptr DefragmentationPassInfo -> IO Result
beginDefragmentationPass :: forall io . MonadIO io => Allocator -> DefragmentationContext -> io (DefragmentationPassInfo)
beginDefragmentationPass allocator context = liftIO . evalContT $ do
pPInfo <- ContT (withZeroCStruct @DefragmentationPassInfo)
r <- lift $ (ffiVmaBeginDefragmentationPass) (allocator) (context) (pPInfo)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pInfo <- lift $ peekCStruct @DefragmentationPassInfo pPInfo
pure $ (pInfo)
withDefragmentationPass :: forall io r . MonadIO io => (io (DefragmentationPassInfo) -> ((DefragmentationPassInfo) -> io ()) -> r) -> Allocator -> DefragmentationContext -> r
withDefragmentationPass b allocator context =
b (beginDefragmentationPass allocator context)
(\(_) -> endDefragmentationPass allocator context)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaEndDefragmentationPass" ffiVmaEndDefragmentationPass
:: Allocator -> DefragmentationContext -> IO Result
endDefragmentationPass :: forall io . MonadIO io => Allocator -> DefragmentationContext -> io ()
endDefragmentationPass allocator context = liftIO $ do
r <- (ffiVmaEndDefragmentationPass) (allocator) (context)
when (r < SUCCESS) (throwIO (VulkanException r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaDefragment" ffiVmaDefragment
:: Allocator -> Ptr Allocation -> CSize -> Ptr Bool32 -> Ptr DefragmentationInfo -> Ptr DefragmentationStats -> IO Result
defragment :: forall io . MonadIO io => Allocator -> ("allocations" ::: Vector Allocation) -> ("defragmentationInfo" ::: Maybe DefragmentationInfo) -> io (("allocationsChanged" ::: Vector Bool), DefragmentationStats)
defragment allocator allocations defragmentationInfo = liftIO . evalContT $ do
pPAllocations <- ContT $ allocaBytesAligned @Allocation ((Data.Vector.length (allocations)) * 8) 8
lift $ Data.Vector.imapM_ (\i e -> poke (pPAllocations `plusPtr` (8 * (i)) :: Ptr Allocation) (e)) (allocations)
pPAllocationsChanged <- ContT $ bracket (callocBytes @Bool32 ((fromIntegral ((fromIntegral (Data.Vector.length $ (allocations)) :: CSize))) * 4)) free
pDefragmentationInfo <- case (defragmentationInfo) of
Nothing -> pure nullPtr
Just j -> ContT $ withCStruct (j)
pPDefragmentationStats <- ContT (withZeroCStruct @DefragmentationStats)
r <- lift $ (ffiVmaDefragment) (allocator) (pPAllocations) ((fromIntegral (Data.Vector.length $ (allocations)) :: CSize)) (pPAllocationsChanged) pDefragmentationInfo (pPDefragmentationStats)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pAllocationsChanged <- lift $ generateM (fromIntegral ((fromIntegral (Data.Vector.length $ (allocations)) :: CSize))) (\i -> do
pAllocationsChangedElem <- peek @Bool32 ((pPAllocationsChanged `advancePtrBytes` (4 * (i)) :: Ptr Bool32))
pure $ bool32ToBool pAllocationsChangedElem)
pDefragmentationStats <- lift $ peekCStruct @DefragmentationStats pPDefragmentationStats
pure $ (pAllocationsChanged, pDefragmentationStats)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaBindBufferMemory" ffiVmaBindBufferMemory
:: Allocator -> Allocation -> Buffer -> IO Result
bindBufferMemory :: forall io . MonadIO io => Allocator -> Allocation -> Buffer -> io ()
bindBufferMemory allocator allocation buffer = liftIO $ do
r <- (ffiVmaBindBufferMemory) (allocator) (allocation) (buffer)
when (r < SUCCESS) (throwIO (VulkanException r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaBindBufferMemory2" ffiVmaBindBufferMemory2
:: Allocator -> Allocation -> DeviceSize -> Buffer -> Ptr () -> IO Result
bindBufferMemory2 :: forall io . MonadIO io => Allocator -> Allocation -> ("allocationLocalOffset" ::: DeviceSize) -> Buffer -> ("next" ::: Ptr ()) -> io ()
bindBufferMemory2 allocator allocation allocationLocalOffset buffer next = liftIO $ do
r <- (ffiVmaBindBufferMemory2) (allocator) (allocation) (allocationLocalOffset) (buffer) (next)
when (r < SUCCESS) (throwIO (VulkanException r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaBindImageMemory" ffiVmaBindImageMemory
:: Allocator -> Allocation -> Image -> IO Result
bindImageMemory :: forall io . MonadIO io => Allocator -> Allocation -> Image -> io ()
bindImageMemory allocator allocation image = liftIO $ do
r <- (ffiVmaBindImageMemory) (allocator) (allocation) (image)
when (r < SUCCESS) (throwIO (VulkanException r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaBindImageMemory2" ffiVmaBindImageMemory2
:: Allocator -> Allocation -> DeviceSize -> Image -> Ptr () -> IO Result
bindImageMemory2 :: forall io . MonadIO io => Allocator -> Allocation -> ("allocationLocalOffset" ::: DeviceSize) -> Image -> ("next" ::: Ptr ()) -> io ()
bindImageMemory2 allocator allocation allocationLocalOffset image next = liftIO $ do
r <- (ffiVmaBindImageMemory2) (allocator) (allocation) (allocationLocalOffset) (image) (next)
when (r < SUCCESS) (throwIO (VulkanException r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaCreateBuffer" ffiVmaCreateBuffer
:: Allocator -> Ptr (BufferCreateInfo a) -> Ptr AllocationCreateInfo -> Ptr Buffer -> Ptr Allocation -> Ptr AllocationInfo -> IO Result
createBuffer :: forall a io . (PokeChain a, MonadIO io) => Allocator -> BufferCreateInfo a -> AllocationCreateInfo -> io (Buffer, Allocation, AllocationInfo)
createBuffer allocator bufferCreateInfo allocationCreateInfo = liftIO . evalContT $ do
pBufferCreateInfo <- ContT $ withCStruct (bufferCreateInfo)
pAllocationCreateInfo <- ContT $ withCStruct (allocationCreateInfo)
pPBuffer <- ContT $ bracket (callocBytes @Buffer 8) free
pPAllocation <- ContT $ bracket (callocBytes @Allocation 8) free
pPAllocationInfo <- ContT (withZeroCStruct @AllocationInfo)
r <- lift $ (ffiVmaCreateBuffer) (allocator) pBufferCreateInfo pAllocationCreateInfo (pPBuffer) (pPAllocation) (pPAllocationInfo)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pBuffer <- lift $ peek @Buffer pPBuffer
pAllocation <- lift $ peek @Allocation pPAllocation
pAllocationInfo <- lift $ peekCStruct @AllocationInfo pPAllocationInfo
pure $ (pBuffer, pAllocation, pAllocationInfo)
withBuffer :: forall a io r . (PokeChain a, MonadIO io) => (io (Buffer, Allocation, AllocationInfo) -> ((Buffer, Allocation, AllocationInfo) -> io ()) -> r) -> Allocator -> BufferCreateInfo a -> AllocationCreateInfo -> r
withBuffer b allocator pBufferCreateInfo pAllocationCreateInfo =
b (createBuffer allocator pBufferCreateInfo pAllocationCreateInfo)
(\(o0, o1, _) -> destroyBuffer allocator o0 o1)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaDestroyBuffer" ffiVmaDestroyBuffer
:: Allocator -> Buffer -> Allocation -> IO ()
destroyBuffer :: forall io . MonadIO io => Allocator -> Buffer -> Allocation -> io ()
destroyBuffer allocator buffer allocation = liftIO $ do
(ffiVmaDestroyBuffer) (allocator) (buffer) (allocation)
pure $ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaCreateImage" ffiVmaCreateImage
:: Allocator -> Ptr (ImageCreateInfo a) -> Ptr AllocationCreateInfo -> Ptr Image -> Ptr Allocation -> Ptr AllocationInfo -> IO Result
createImage :: forall a io . (PokeChain a, MonadIO io) => Allocator -> ImageCreateInfo a -> AllocationCreateInfo -> io (Image, Allocation, AllocationInfo)
createImage allocator imageCreateInfo allocationCreateInfo = liftIO . evalContT $ do
pImageCreateInfo <- ContT $ withCStruct (imageCreateInfo)
pAllocationCreateInfo <- ContT $ withCStruct (allocationCreateInfo)
pPImage <- ContT $ bracket (callocBytes @Image 8) free
pPAllocation <- ContT $ bracket (callocBytes @Allocation 8) free
pPAllocationInfo <- ContT (withZeroCStruct @AllocationInfo)
r <- lift $ (ffiVmaCreateImage) (allocator) pImageCreateInfo pAllocationCreateInfo (pPImage) (pPAllocation) (pPAllocationInfo)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pImage <- lift $ peek @Image pPImage
pAllocation <- lift $ peek @Allocation pPAllocation
pAllocationInfo <- lift $ peekCStruct @AllocationInfo pPAllocationInfo
pure $ (pImage, pAllocation, pAllocationInfo)
withImage :: forall a io r . (PokeChain a, MonadIO io) => (io (Image, Allocation, AllocationInfo) -> ((Image, Allocation, AllocationInfo) -> io ()) -> r) -> Allocator -> ImageCreateInfo a -> AllocationCreateInfo -> r
withImage b allocator pImageCreateInfo pAllocationCreateInfo =
b (createImage allocator pImageCreateInfo pAllocationCreateInfo)
(\(o0, o1, _) -> destroyImage allocator o0 o1)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaDestroyImage" ffiVmaDestroyImage
:: Allocator -> Image -> Allocation -> IO ()
destroyImage :: forall io . MonadIO io => Allocator -> Image -> Allocation -> io ()
destroyImage allocator image allocation = liftIO $ do
(ffiVmaDestroyImage) (allocator) (image) (allocation)
pure $ ()
type FN_vkAllocateMemory = Ptr Device_T -> ("pAllocateInfo" ::: Ptr (SomeStruct MemoryAllocateInfo)) -> ("pAllocator" ::: Ptr AllocationCallbacks) -> ("pMemory" ::: Ptr DeviceMemory) -> IO Result
type PFN_vkAllocateMemory = FunPtr FN_vkAllocateMemory
type FN_vkBindBufferMemory = Ptr Device_T -> Buffer -> DeviceMemory -> ("memoryOffset" ::: DeviceSize) -> IO Result
type PFN_vkBindBufferMemory = FunPtr FN_vkBindBufferMemory
type FN_vkBindBufferMemory2KHR = Ptr Device_T -> ("bindInfoCount" ::: Word32) -> ("pBindInfos" ::: Ptr (SomeStruct BindBufferMemoryInfo)) -> IO Result
type PFN_vkBindBufferMemory2KHR = FunPtr FN_vkBindBufferMemory2KHR
type FN_vkBindImageMemory = Ptr Device_T -> Image -> DeviceMemory -> ("memoryOffset" ::: DeviceSize) -> IO Result
type PFN_vkBindImageMemory = FunPtr FN_vkBindImageMemory
type FN_vkBindImageMemory2KHR = Ptr Device_T -> ("bindInfoCount" ::: Word32) -> ("pBindInfos" ::: Ptr (SomeStruct BindImageMemoryInfo)) -> IO Result
type PFN_vkBindImageMemory2KHR = FunPtr FN_vkBindImageMemory2KHR
type FN_vkCmdCopyBuffer = Ptr CommandBuffer_T -> ("srcBuffer" ::: Buffer) -> ("dstBuffer" ::: Buffer) -> ("regionCount" ::: Word32) -> ("pRegions" ::: Ptr BufferCopy) -> IO ()
type PFN_vkCmdCopyBuffer = FunPtr FN_vkCmdCopyBuffer
type FN_vkCreateBuffer = Ptr Device_T -> ("pCreateInfo" ::: Ptr (SomeStruct BufferCreateInfo)) -> ("pAllocator" ::: Ptr AllocationCallbacks) -> ("pBuffer" ::: Ptr Buffer) -> IO Result
type PFN_vkCreateBuffer = FunPtr FN_vkCreateBuffer
type FN_vkCreateImage = Ptr Device_T -> ("pCreateInfo" ::: Ptr (SomeStruct ImageCreateInfo)) -> ("pAllocator" ::: Ptr AllocationCallbacks) -> ("pImage" ::: Ptr Image) -> IO Result
type PFN_vkCreateImage = FunPtr FN_vkCreateImage
type FN_vkDestroyBuffer = Ptr Device_T -> Buffer -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
type PFN_vkDestroyBuffer = FunPtr FN_vkDestroyBuffer
type FN_vkDestroyImage = Ptr Device_T -> Image -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
type PFN_vkDestroyImage = FunPtr FN_vkDestroyImage
type FN_vkFlushMappedMemoryRanges = Ptr Device_T -> ("memoryRangeCount" ::: Word32) -> ("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO Result
type PFN_vkFlushMappedMemoryRanges = FunPtr FN_vkFlushMappedMemoryRanges
type FN_vkFreeMemory = Ptr Device_T -> DeviceMemory -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
type PFN_vkFreeMemory = FunPtr FN_vkFreeMemory
type FN_vkGetBufferMemoryRequirements = Ptr Device_T -> Buffer -> ("pMemoryRequirements" ::: Ptr MemoryRequirements) -> IO ()
type PFN_vkGetBufferMemoryRequirements = FunPtr FN_vkGetBufferMemoryRequirements
type FN_vkGetBufferMemoryRequirements2KHR = Ptr Device_T -> ("pInfo" ::: Ptr BufferMemoryRequirementsInfo2) -> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2)) -> IO ()
type PFN_vkGetBufferMemoryRequirements2KHR = FunPtr FN_vkGetBufferMemoryRequirements2KHR
type FN_vkGetImageMemoryRequirements = Ptr Device_T -> Image -> ("pMemoryRequirements" ::: Ptr MemoryRequirements) -> IO ()
type PFN_vkGetImageMemoryRequirements = FunPtr FN_vkGetImageMemoryRequirements
type FN_vkGetImageMemoryRequirements2KHR = Ptr Device_T -> ("pInfo" ::: Ptr (SomeStruct ImageMemoryRequirementsInfo2)) -> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2)) -> IO ()
type PFN_vkGetImageMemoryRequirements2KHR = FunPtr FN_vkGetImageMemoryRequirements2KHR
type FN_vkGetPhysicalDeviceMemoryProperties = Ptr PhysicalDevice_T -> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties) -> IO ()
type PFN_vkGetPhysicalDeviceMemoryProperties = FunPtr FN_vkGetPhysicalDeviceMemoryProperties
type FN_vkGetPhysicalDeviceMemoryProperties2KHR = Ptr PhysicalDevice_T -> ("pMemoryProperties" ::: Ptr (SomeStruct PhysicalDeviceMemoryProperties2)) -> IO ()
type PFN_vkGetPhysicalDeviceMemoryProperties2KHR = FunPtr FN_vkGetPhysicalDeviceMemoryProperties2KHR
type FN_vkGetPhysicalDeviceProperties = Ptr PhysicalDevice_T -> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ()
type PFN_vkGetPhysicalDeviceProperties = FunPtr FN_vkGetPhysicalDeviceProperties
type FN_vkInvalidateMappedMemoryRanges = Ptr Device_T -> ("memoryRangeCount" ::: Word32) -> ("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO Result
type PFN_vkInvalidateMappedMemoryRanges = FunPtr FN_vkInvalidateMappedMemoryRanges
type FN_vkMapMemory = Ptr Device_T -> DeviceMemory -> ("offset" ::: DeviceSize) -> DeviceSize -> MemoryMapFlags -> ("ppData" ::: Ptr (Ptr ())) -> IO Result
type PFN_vkMapMemory = FunPtr FN_vkMapMemory
type FN_vkUnmapMemory = Ptr Device_T -> DeviceMemory -> IO ()
type PFN_vkUnmapMemory = FunPtr FN_vkUnmapMemory
newtype Allocator = Allocator Word64
deriving newtype (Eq, Ord, Storable, Zero)
deriving anyclass (IsHandle)
instance Show Allocator where
showsPrec p (Allocator x) = showParen (p >= 11) (showString "Allocator 0x" . showHex x)
type FN_vmaAllocateDeviceMemoryFunction = Allocator -> ("memoryType" ::: Word32) -> DeviceMemory -> DeviceSize -> ("pUserData" ::: Ptr ()) -> IO ()
type PFN_vmaAllocateDeviceMemoryFunction = FunPtr FN_vmaAllocateDeviceMemoryFunction
type FN_vmaFreeDeviceMemoryFunction = Allocator -> ("memoryType" ::: Word32) -> DeviceMemory -> DeviceSize -> ("pUserData" ::: Ptr ()) -> IO ()
type PFN_vmaFreeDeviceMemoryFunction = FunPtr FN_vmaFreeDeviceMemoryFunction
data DeviceMemoryCallbacks = DeviceMemoryCallbacks
{
pfnAllocate :: PFN_vmaAllocateDeviceMemoryFunction
,
pfnFree :: PFN_vmaFreeDeviceMemoryFunction
,
userData :: Ptr ()
}
deriving (Typeable)
deriving instance Show DeviceMemoryCallbacks
instance ToCStruct DeviceMemoryCallbacks where
withCStruct x f = allocaBytesAligned 24 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p DeviceMemoryCallbacks{..} f = do
poke ((p `plusPtr` 0 :: Ptr PFN_vmaAllocateDeviceMemoryFunction)) (pfnAllocate)
poke ((p `plusPtr` 8 :: Ptr PFN_vmaFreeDeviceMemoryFunction)) (pfnFree)
poke ((p `plusPtr` 16 :: Ptr (Ptr ()))) (userData)
f
cStructSize = 24
cStructAlignment = 8
pokeZeroCStruct _ f = f
instance FromCStruct DeviceMemoryCallbacks where
peekCStruct p = do
pfnAllocate <- peek @PFN_vmaAllocateDeviceMemoryFunction ((p `plusPtr` 0 :: Ptr PFN_vmaAllocateDeviceMemoryFunction))
pfnFree <- peek @PFN_vmaFreeDeviceMemoryFunction ((p `plusPtr` 8 :: Ptr PFN_vmaFreeDeviceMemoryFunction))
pUserData <- peek @(Ptr ()) ((p `plusPtr` 16 :: Ptr (Ptr ())))
pure $ DeviceMemoryCallbacks
pfnAllocate pfnFree pUserData
instance Storable DeviceMemoryCallbacks where
sizeOf ~_ = 24
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero DeviceMemoryCallbacks where
zero = DeviceMemoryCallbacks
zero
zero
zero
newtype AllocatorCreateFlagBits = AllocatorCreateFlagBits Flags
deriving newtype (Eq, Ord, Storable, Zero, Bits)
pattern ALLOCATOR_CREATE_EXTERNALLY_SYNCHRONIZED_BIT = AllocatorCreateFlagBits 0x00000001
pattern ALLOCATOR_CREATE_KHR_DEDICATED_ALLOCATION_BIT = AllocatorCreateFlagBits 0x00000002
pattern ALLOCATOR_CREATE_KHR_BIND_MEMORY2_BIT = AllocatorCreateFlagBits 0x00000004
pattern ALLOCATOR_CREATE_EXT_MEMORY_BUDGET_BIT = AllocatorCreateFlagBits 0x00000008
pattern ALLOCATOR_CREATE_AMD_DEVICE_COHERENT_MEMORY_BIT = AllocatorCreateFlagBits 0x00000010
pattern ALLOCATOR_CREATE_BUFFER_DEVICE_ADDRESS_BIT = AllocatorCreateFlagBits 0x00000020
type AllocatorCreateFlags = AllocatorCreateFlagBits
instance Show AllocatorCreateFlagBits where
showsPrec p = \case
ALLOCATOR_CREATE_EXTERNALLY_SYNCHRONIZED_BIT -> showString "ALLOCATOR_CREATE_EXTERNALLY_SYNCHRONIZED_BIT"
ALLOCATOR_CREATE_KHR_DEDICATED_ALLOCATION_BIT -> showString "ALLOCATOR_CREATE_KHR_DEDICATED_ALLOCATION_BIT"
ALLOCATOR_CREATE_KHR_BIND_MEMORY2_BIT -> showString "ALLOCATOR_CREATE_KHR_BIND_MEMORY2_BIT"
ALLOCATOR_CREATE_EXT_MEMORY_BUDGET_BIT -> showString "ALLOCATOR_CREATE_EXT_MEMORY_BUDGET_BIT"
ALLOCATOR_CREATE_AMD_DEVICE_COHERENT_MEMORY_BIT -> showString "ALLOCATOR_CREATE_AMD_DEVICE_COHERENT_MEMORY_BIT"
ALLOCATOR_CREATE_BUFFER_DEVICE_ADDRESS_BIT -> showString "ALLOCATOR_CREATE_BUFFER_DEVICE_ADDRESS_BIT"
AllocatorCreateFlagBits x -> showParen (p >= 11) (showString "AllocatorCreateFlagBits 0x" . showHex x)
instance Read AllocatorCreateFlagBits where
readPrec = parens (choose [("ALLOCATOR_CREATE_EXTERNALLY_SYNCHRONIZED_BIT", pure ALLOCATOR_CREATE_EXTERNALLY_SYNCHRONIZED_BIT)
, ("ALLOCATOR_CREATE_KHR_DEDICATED_ALLOCATION_BIT", pure ALLOCATOR_CREATE_KHR_DEDICATED_ALLOCATION_BIT)
, ("ALLOCATOR_CREATE_KHR_BIND_MEMORY2_BIT", pure ALLOCATOR_CREATE_KHR_BIND_MEMORY2_BIT)
, ("ALLOCATOR_CREATE_EXT_MEMORY_BUDGET_BIT", pure ALLOCATOR_CREATE_EXT_MEMORY_BUDGET_BIT)
, ("ALLOCATOR_CREATE_AMD_DEVICE_COHERENT_MEMORY_BIT", pure ALLOCATOR_CREATE_AMD_DEVICE_COHERENT_MEMORY_BIT)
, ("ALLOCATOR_CREATE_BUFFER_DEVICE_ADDRESS_BIT", pure ALLOCATOR_CREATE_BUFFER_DEVICE_ADDRESS_BIT)]
+++
prec 10 (do
expectP (Ident "AllocatorCreateFlagBits")
v <- step readPrec
pure (AllocatorCreateFlagBits v)))
data VulkanFunctions = VulkanFunctions
{
vkGetPhysicalDeviceProperties :: PFN_vkGetPhysicalDeviceProperties
,
vkGetPhysicalDeviceMemoryProperties :: PFN_vkGetPhysicalDeviceMemoryProperties
,
vkAllocateMemory :: PFN_vkAllocateMemory
,
vkFreeMemory :: PFN_vkFreeMemory
,
vkMapMemory :: PFN_vkMapMemory
,
vkUnmapMemory :: PFN_vkUnmapMemory
,
vkFlushMappedMemoryRanges :: PFN_vkFlushMappedMemoryRanges
,
vkInvalidateMappedMemoryRanges :: PFN_vkInvalidateMappedMemoryRanges
,
vkBindBufferMemory :: PFN_vkBindBufferMemory
,
vkBindImageMemory :: PFN_vkBindImageMemory
,
vkGetBufferMemoryRequirements :: PFN_vkGetBufferMemoryRequirements
,
vkGetImageMemoryRequirements :: PFN_vkGetImageMemoryRequirements
,
vkCreateBuffer :: PFN_vkCreateBuffer
,
vkDestroyBuffer :: PFN_vkDestroyBuffer
,
vkCreateImage :: PFN_vkCreateImage
,
vkDestroyImage :: PFN_vkDestroyImage
,
vkCmdCopyBuffer :: PFN_vkCmdCopyBuffer
,
vkGetBufferMemoryRequirements2KHR :: PFN_vkGetBufferMemoryRequirements2KHR
,
vkGetImageMemoryRequirements2KHR :: PFN_vkGetImageMemoryRequirements2KHR
,
vkBindBufferMemory2KHR :: PFN_vkBindBufferMemory2KHR
,
vkBindImageMemory2KHR :: PFN_vkBindImageMemory2KHR
,
vkGetPhysicalDeviceMemoryProperties2KHR :: PFN_vkGetPhysicalDeviceMemoryProperties2KHR
}
deriving (Typeable)
deriving instance Show VulkanFunctions
instance ToCStruct VulkanFunctions where
withCStruct x f = allocaBytesAligned 176 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p VulkanFunctions{..} f = do
poke ((p `plusPtr` 0 :: Ptr PFN_vkGetPhysicalDeviceProperties)) (vkGetPhysicalDeviceProperties)
poke ((p `plusPtr` 8 :: Ptr PFN_vkGetPhysicalDeviceMemoryProperties)) (vkGetPhysicalDeviceMemoryProperties)
poke ((p `plusPtr` 16 :: Ptr PFN_vkAllocateMemory)) (vkAllocateMemory)
poke ((p `plusPtr` 24 :: Ptr PFN_vkFreeMemory)) (vkFreeMemory)
poke ((p `plusPtr` 32 :: Ptr PFN_vkMapMemory)) (vkMapMemory)
poke ((p `plusPtr` 40 :: Ptr PFN_vkUnmapMemory)) (vkUnmapMemory)
poke ((p `plusPtr` 48 :: Ptr PFN_vkFlushMappedMemoryRanges)) (vkFlushMappedMemoryRanges)
poke ((p `plusPtr` 56 :: Ptr PFN_vkInvalidateMappedMemoryRanges)) (vkInvalidateMappedMemoryRanges)
poke ((p `plusPtr` 64 :: Ptr PFN_vkBindBufferMemory)) (vkBindBufferMemory)
poke ((p `plusPtr` 72 :: Ptr PFN_vkBindImageMemory)) (vkBindImageMemory)
poke ((p `plusPtr` 80 :: Ptr PFN_vkGetBufferMemoryRequirements)) (vkGetBufferMemoryRequirements)
poke ((p `plusPtr` 88 :: Ptr PFN_vkGetImageMemoryRequirements)) (vkGetImageMemoryRequirements)
poke ((p `plusPtr` 96 :: Ptr PFN_vkCreateBuffer)) (vkCreateBuffer)
poke ((p `plusPtr` 104 :: Ptr PFN_vkDestroyBuffer)) (vkDestroyBuffer)
poke ((p `plusPtr` 112 :: Ptr PFN_vkCreateImage)) (vkCreateImage)
poke ((p `plusPtr` 120 :: Ptr PFN_vkDestroyImage)) (vkDestroyImage)
poke ((p `plusPtr` 128 :: Ptr PFN_vkCmdCopyBuffer)) (vkCmdCopyBuffer)
poke ((p `plusPtr` 136 :: Ptr PFN_vkGetBufferMemoryRequirements2KHR)) (vkGetBufferMemoryRequirements2KHR)
poke ((p `plusPtr` 144 :: Ptr PFN_vkGetImageMemoryRequirements2KHR)) (vkGetImageMemoryRequirements2KHR)
poke ((p `plusPtr` 152 :: Ptr PFN_vkBindBufferMemory2KHR)) (vkBindBufferMemory2KHR)
poke ((p `plusPtr` 160 :: Ptr PFN_vkBindImageMemory2KHR)) (vkBindImageMemory2KHR)
poke ((p `plusPtr` 168 :: Ptr PFN_vkGetPhysicalDeviceMemoryProperties2KHR)) (vkGetPhysicalDeviceMemoryProperties2KHR)
f
cStructSize = 176
cStructAlignment = 8
pokeZeroCStruct _ f = f
instance FromCStruct VulkanFunctions where
peekCStruct p = do
vkGetPhysicalDeviceProperties <- peek @PFN_vkGetPhysicalDeviceProperties ((p `plusPtr` 0 :: Ptr PFN_vkGetPhysicalDeviceProperties))
vkGetPhysicalDeviceMemoryProperties <- peek @PFN_vkGetPhysicalDeviceMemoryProperties ((p `plusPtr` 8 :: Ptr PFN_vkGetPhysicalDeviceMemoryProperties))
vkAllocateMemory <- peek @PFN_vkAllocateMemory ((p `plusPtr` 16 :: Ptr PFN_vkAllocateMemory))
vkFreeMemory <- peek @PFN_vkFreeMemory ((p `plusPtr` 24 :: Ptr PFN_vkFreeMemory))
vkMapMemory <- peek @PFN_vkMapMemory ((p `plusPtr` 32 :: Ptr PFN_vkMapMemory))
vkUnmapMemory <- peek @PFN_vkUnmapMemory ((p `plusPtr` 40 :: Ptr PFN_vkUnmapMemory))
vkFlushMappedMemoryRanges <- peek @PFN_vkFlushMappedMemoryRanges ((p `plusPtr` 48 :: Ptr PFN_vkFlushMappedMemoryRanges))
vkInvalidateMappedMemoryRanges <- peek @PFN_vkInvalidateMappedMemoryRanges ((p `plusPtr` 56 :: Ptr PFN_vkInvalidateMappedMemoryRanges))
vkBindBufferMemory <- peek @PFN_vkBindBufferMemory ((p `plusPtr` 64 :: Ptr PFN_vkBindBufferMemory))
vkBindImageMemory <- peek @PFN_vkBindImageMemory ((p `plusPtr` 72 :: Ptr PFN_vkBindImageMemory))
vkGetBufferMemoryRequirements <- peek @PFN_vkGetBufferMemoryRequirements ((p `plusPtr` 80 :: Ptr PFN_vkGetBufferMemoryRequirements))
vkGetImageMemoryRequirements <- peek @PFN_vkGetImageMemoryRequirements ((p `plusPtr` 88 :: Ptr PFN_vkGetImageMemoryRequirements))
vkCreateBuffer <- peek @PFN_vkCreateBuffer ((p `plusPtr` 96 :: Ptr PFN_vkCreateBuffer))
vkDestroyBuffer <- peek @PFN_vkDestroyBuffer ((p `plusPtr` 104 :: Ptr PFN_vkDestroyBuffer))
vkCreateImage <- peek @PFN_vkCreateImage ((p `plusPtr` 112 :: Ptr PFN_vkCreateImage))
vkDestroyImage <- peek @PFN_vkDestroyImage ((p `plusPtr` 120 :: Ptr PFN_vkDestroyImage))
vkCmdCopyBuffer <- peek @PFN_vkCmdCopyBuffer ((p `plusPtr` 128 :: Ptr PFN_vkCmdCopyBuffer))
vkGetBufferMemoryRequirements2KHR <- peek @PFN_vkGetBufferMemoryRequirements2KHR ((p `plusPtr` 136 :: Ptr PFN_vkGetBufferMemoryRequirements2KHR))
vkGetImageMemoryRequirements2KHR <- peek @PFN_vkGetImageMemoryRequirements2KHR ((p `plusPtr` 144 :: Ptr PFN_vkGetImageMemoryRequirements2KHR))
vkBindBufferMemory2KHR <- peek @PFN_vkBindBufferMemory2KHR ((p `plusPtr` 152 :: Ptr PFN_vkBindBufferMemory2KHR))
vkBindImageMemory2KHR <- peek @PFN_vkBindImageMemory2KHR ((p `plusPtr` 160 :: Ptr PFN_vkBindImageMemory2KHR))
vkGetPhysicalDeviceMemoryProperties2KHR <- peek @PFN_vkGetPhysicalDeviceMemoryProperties2KHR ((p `plusPtr` 168 :: Ptr PFN_vkGetPhysicalDeviceMemoryProperties2KHR))
pure $ VulkanFunctions
vkGetPhysicalDeviceProperties vkGetPhysicalDeviceMemoryProperties vkAllocateMemory vkFreeMemory vkMapMemory vkUnmapMemory vkFlushMappedMemoryRanges vkInvalidateMappedMemoryRanges vkBindBufferMemory vkBindImageMemory vkGetBufferMemoryRequirements vkGetImageMemoryRequirements vkCreateBuffer vkDestroyBuffer vkCreateImage vkDestroyImage vkCmdCopyBuffer vkGetBufferMemoryRequirements2KHR vkGetImageMemoryRequirements2KHR vkBindBufferMemory2KHR vkBindImageMemory2KHR vkGetPhysicalDeviceMemoryProperties2KHR
instance Storable VulkanFunctions where
sizeOf ~_ = 176
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero VulkanFunctions where
zero = VulkanFunctions
zero
zero
zero
zero
zero
zero
zero
zero
zero
zero
zero
zero
zero
zero
zero
zero
zero
zero
zero
zero
zero
zero
newtype RecordFlagBits = RecordFlagBits Flags
deriving newtype (Eq, Ord, Storable, Zero, Bits)
pattern RECORD_FLUSH_AFTER_CALL_BIT = RecordFlagBits 0x00000001
type RecordFlags = RecordFlagBits
instance Show RecordFlagBits where
showsPrec p = \case
RECORD_FLUSH_AFTER_CALL_BIT -> showString "RECORD_FLUSH_AFTER_CALL_BIT"
RecordFlagBits x -> showParen (p >= 11) (showString "RecordFlagBits 0x" . showHex x)
instance Read RecordFlagBits where
readPrec = parens (choose [("RECORD_FLUSH_AFTER_CALL_BIT", pure RECORD_FLUSH_AFTER_CALL_BIT)]
+++
prec 10 (do
expectP (Ident "RecordFlagBits")
v <- step readPrec
pure (RecordFlagBits v)))
data RecordSettings = RecordSettings
{
flags :: RecordFlags
,
filePath :: ByteString
}
deriving (Typeable)
deriving instance Show RecordSettings
instance ToCStruct RecordSettings where
withCStruct x f = allocaBytesAligned 16 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p RecordSettings{..} f = evalContT $ do
lift $ poke ((p `plusPtr` 0 :: Ptr RecordFlags)) (flags)
pFilePath'' <- ContT $ useAsCString (filePath)
lift $ poke ((p `plusPtr` 8 :: Ptr (Ptr CChar))) pFilePath''
lift $ f
cStructSize = 16
cStructAlignment = 8
pokeZeroCStruct p f = evalContT $ do
lift $ poke ((p `plusPtr` 0 :: Ptr RecordFlags)) (zero)
pFilePath'' <- ContT $ useAsCString (mempty)
lift $ poke ((p `plusPtr` 8 :: Ptr (Ptr CChar))) pFilePath''
lift $ f
instance FromCStruct RecordSettings where
peekCStruct p = do
flags <- peek @RecordFlags ((p `plusPtr` 0 :: Ptr RecordFlags))
pFilePath <- packCString =<< peek ((p `plusPtr` 8 :: Ptr (Ptr CChar)))
pure $ RecordSettings
flags pFilePath
instance Zero RecordSettings where
zero = RecordSettings
zero
mempty
data AllocatorCreateInfo = AllocatorCreateInfo
{
flags :: AllocatorCreateFlags
,
physicalDevice :: Ptr PhysicalDevice_T
,
device :: Ptr Device_T
,
preferredLargeHeapBlockSize :: DeviceSize
,
allocationCallbacks :: Maybe AllocationCallbacks
,
deviceMemoryCallbacks :: Maybe DeviceMemoryCallbacks
,
frameInUseCount :: Word32
,
heapSizeLimit :: Ptr DeviceSize
,
vulkanFunctions :: Maybe VulkanFunctions
,
recordSettings :: Maybe RecordSettings
,
instance' :: Ptr Instance_T
,
vulkanApiVersion :: Word32
}
deriving (Typeable)
deriving instance Show AllocatorCreateInfo
instance ToCStruct AllocatorCreateInfo where
withCStruct x f = allocaBytesAligned 96 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p AllocatorCreateInfo{..} f = evalContT $ do
lift $ poke ((p `plusPtr` 0 :: Ptr AllocatorCreateFlags)) (flags)
lift $ poke ((p `plusPtr` 8 :: Ptr (Ptr PhysicalDevice_T))) (physicalDevice)
lift $ poke ((p `plusPtr` 16 :: Ptr (Ptr Device_T))) (device)
lift $ poke ((p `plusPtr` 24 :: Ptr DeviceSize)) (preferredLargeHeapBlockSize)
pAllocationCallbacks'' <- case (allocationCallbacks) of
Nothing -> pure nullPtr
Just j -> ContT $ withCStruct (j)
lift $ poke ((p `plusPtr` 32 :: Ptr (Ptr AllocationCallbacks))) pAllocationCallbacks''
pDeviceMemoryCallbacks'' <- case (deviceMemoryCallbacks) of
Nothing -> pure nullPtr
Just j -> ContT $ withCStruct (j)
lift $ poke ((p `plusPtr` 40 :: Ptr (Ptr DeviceMemoryCallbacks))) pDeviceMemoryCallbacks''
lift $ poke ((p `plusPtr` 48 :: Ptr Word32)) (frameInUseCount)
lift $ poke ((p `plusPtr` 56 :: Ptr (Ptr DeviceSize))) (heapSizeLimit)
pVulkanFunctions'' <- case (vulkanFunctions) of
Nothing -> pure nullPtr
Just j -> ContT $ withCStruct (j)
lift $ poke ((p `plusPtr` 64 :: Ptr (Ptr VulkanFunctions))) pVulkanFunctions''
pRecordSettings'' <- case (recordSettings) of
Nothing -> pure nullPtr
Just j -> ContT $ withCStruct (j)
lift $ poke ((p `plusPtr` 72 :: Ptr (Ptr RecordSettings))) pRecordSettings''
lift $ poke ((p `plusPtr` 80 :: Ptr (Ptr Instance_T))) (instance')
lift $ poke ((p `plusPtr` 88 :: Ptr Word32)) (vulkanApiVersion)
lift $ f
cStructSize = 96
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr AllocatorCreateFlags)) (zero)
poke ((p `plusPtr` 8 :: Ptr (Ptr PhysicalDevice_T))) (zero)
poke ((p `plusPtr` 16 :: Ptr (Ptr Device_T))) (zero)
poke ((p `plusPtr` 24 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 48 :: Ptr Word32)) (zero)
poke ((p `plusPtr` 80 :: Ptr (Ptr Instance_T))) (zero)
poke ((p `plusPtr` 88 :: Ptr Word32)) (zero)
f
instance FromCStruct AllocatorCreateInfo where
peekCStruct p = do
flags <- peek @AllocatorCreateFlags ((p `plusPtr` 0 :: Ptr AllocatorCreateFlags))
physicalDevice <- peek @(Ptr PhysicalDevice_T) ((p `plusPtr` 8 :: Ptr (Ptr PhysicalDevice_T)))
device <- peek @(Ptr Device_T) ((p `plusPtr` 16 :: Ptr (Ptr Device_T)))
preferredLargeHeapBlockSize <- peek @DeviceSize ((p `plusPtr` 24 :: Ptr DeviceSize))
pAllocationCallbacks <- peek @(Ptr AllocationCallbacks) ((p `plusPtr` 32 :: Ptr (Ptr AllocationCallbacks)))
pAllocationCallbacks' <- maybePeek (\j -> peekCStruct @AllocationCallbacks (j)) pAllocationCallbacks
pDeviceMemoryCallbacks <- peek @(Ptr DeviceMemoryCallbacks) ((p `plusPtr` 40 :: Ptr (Ptr DeviceMemoryCallbacks)))
pDeviceMemoryCallbacks' <- maybePeek (\j -> peekCStruct @DeviceMemoryCallbacks (j)) pDeviceMemoryCallbacks
frameInUseCount <- peek @Word32 ((p `plusPtr` 48 :: Ptr Word32))
pHeapSizeLimit <- peek @(Ptr DeviceSize) ((p `plusPtr` 56 :: Ptr (Ptr DeviceSize)))
pVulkanFunctions <- peek @(Ptr VulkanFunctions) ((p `plusPtr` 64 :: Ptr (Ptr VulkanFunctions)))
pVulkanFunctions' <- maybePeek (\j -> peekCStruct @VulkanFunctions (j)) pVulkanFunctions
pRecordSettings <- peek @(Ptr RecordSettings) ((p `plusPtr` 72 :: Ptr (Ptr RecordSettings)))
pRecordSettings' <- maybePeek (\j -> peekCStruct @RecordSettings (j)) pRecordSettings
instance' <- peek @(Ptr Instance_T) ((p `plusPtr` 80 :: Ptr (Ptr Instance_T)))
vulkanApiVersion <- peek @Word32 ((p `plusPtr` 88 :: Ptr Word32))
pure $ AllocatorCreateInfo
flags physicalDevice device preferredLargeHeapBlockSize pAllocationCallbacks' pDeviceMemoryCallbacks' frameInUseCount pHeapSizeLimit pVulkanFunctions' pRecordSettings' instance' vulkanApiVersion
instance Zero AllocatorCreateInfo where
zero = AllocatorCreateInfo
zero
zero
zero
zero
Nothing
Nothing
zero
zero
Nothing
Nothing
zero
zero
data AllocatorInfo = AllocatorInfo
{
instance' :: Ptr Instance_T
,
physicalDevice :: Ptr PhysicalDevice_T
,
device :: Ptr Device_T
}
deriving (Typeable)
deriving instance Show AllocatorInfo
instance ToCStruct AllocatorInfo where
withCStruct x f = allocaBytesAligned 24 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p AllocatorInfo{..} f = do
poke ((p `plusPtr` 0 :: Ptr (Ptr Instance_T))) (instance')
poke ((p `plusPtr` 8 :: Ptr (Ptr PhysicalDevice_T))) (physicalDevice)
poke ((p `plusPtr` 16 :: Ptr (Ptr Device_T))) (device)
f
cStructSize = 24
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr (Ptr Instance_T))) (zero)
poke ((p `plusPtr` 8 :: Ptr (Ptr PhysicalDevice_T))) (zero)
poke ((p `plusPtr` 16 :: Ptr (Ptr Device_T))) (zero)
f
instance FromCStruct AllocatorInfo where
peekCStruct p = do
instance' <- peek @(Ptr Instance_T) ((p `plusPtr` 0 :: Ptr (Ptr Instance_T)))
physicalDevice <- peek @(Ptr PhysicalDevice_T) ((p `plusPtr` 8 :: Ptr (Ptr PhysicalDevice_T)))
device <- peek @(Ptr Device_T) ((p `plusPtr` 16 :: Ptr (Ptr Device_T)))
pure $ AllocatorInfo
instance' physicalDevice device
instance Storable AllocatorInfo where
sizeOf ~_ = 24
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero AllocatorInfo where
zero = AllocatorInfo
zero
zero
zero
data StatInfo = StatInfo
{
blockCount :: Word32
,
allocationCount :: Word32
,
unusedRangeCount :: Word32
,
usedBytes :: DeviceSize
,
unusedBytes :: DeviceSize
,
allocationSizeMin :: DeviceSize
,
allocationSizeAvg :: DeviceSize
,
allocationSizeMax :: DeviceSize
,
unusedRangeSizeMin :: DeviceSize
,
unusedRangeSizeAvg :: DeviceSize
,
unusedRangeSizeMax :: DeviceSize
}
deriving (Typeable)
deriving instance Show StatInfo
instance ToCStruct StatInfo where
withCStruct x f = allocaBytesAligned 80 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p StatInfo{..} f = do
poke ((p `plusPtr` 0 :: Ptr Word32)) (blockCount)
poke ((p `plusPtr` 4 :: Ptr Word32)) (allocationCount)
poke ((p `plusPtr` 8 :: Ptr Word32)) (unusedRangeCount)
poke ((p `plusPtr` 16 :: Ptr DeviceSize)) (usedBytes)
poke ((p `plusPtr` 24 :: Ptr DeviceSize)) (unusedBytes)
poke ((p `plusPtr` 32 :: Ptr DeviceSize)) (allocationSizeMin)
poke ((p `plusPtr` 40 :: Ptr DeviceSize)) (allocationSizeAvg)
poke ((p `plusPtr` 48 :: Ptr DeviceSize)) (allocationSizeMax)
poke ((p `plusPtr` 56 :: Ptr DeviceSize)) (unusedRangeSizeMin)
poke ((p `plusPtr` 64 :: Ptr DeviceSize)) (unusedRangeSizeAvg)
poke ((p `plusPtr` 72 :: Ptr DeviceSize)) (unusedRangeSizeMax)
f
cStructSize = 80
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr Word32)) (zero)
poke ((p `plusPtr` 4 :: Ptr Word32)) (zero)
poke ((p `plusPtr` 8 :: Ptr Word32)) (zero)
poke ((p `plusPtr` 16 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 24 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 32 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 40 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 48 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 56 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 64 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 72 :: Ptr DeviceSize)) (zero)
f
instance FromCStruct StatInfo where
peekCStruct p = do
blockCount <- peek @Word32 ((p `plusPtr` 0 :: Ptr Word32))
allocationCount <- peek @Word32 ((p `plusPtr` 4 :: Ptr Word32))
unusedRangeCount <- peek @Word32 ((p `plusPtr` 8 :: Ptr Word32))
usedBytes <- peek @DeviceSize ((p `plusPtr` 16 :: Ptr DeviceSize))
unusedBytes <- peek @DeviceSize ((p `plusPtr` 24 :: Ptr DeviceSize))
allocationSizeMin <- peek @DeviceSize ((p `plusPtr` 32 :: Ptr DeviceSize))
allocationSizeAvg <- peek @DeviceSize ((p `plusPtr` 40 :: Ptr DeviceSize))
allocationSizeMax <- peek @DeviceSize ((p `plusPtr` 48 :: Ptr DeviceSize))
unusedRangeSizeMin <- peek @DeviceSize ((p `plusPtr` 56 :: Ptr DeviceSize))
unusedRangeSizeAvg <- peek @DeviceSize ((p `plusPtr` 64 :: Ptr DeviceSize))
unusedRangeSizeMax <- peek @DeviceSize ((p `plusPtr` 72 :: Ptr DeviceSize))
pure $ StatInfo
blockCount allocationCount unusedRangeCount usedBytes unusedBytes allocationSizeMin allocationSizeAvg allocationSizeMax unusedRangeSizeMin unusedRangeSizeAvg unusedRangeSizeMax
instance Storable StatInfo where
sizeOf ~_ = 80
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero StatInfo where
zero = StatInfo
zero
zero
zero
zero
zero
zero
zero
zero
zero
zero
zero
data Stats = Stats
{
memoryType :: Vector StatInfo
,
memoryHeap :: Vector StatInfo
,
total :: StatInfo
}
deriving (Typeable)
deriving instance Show Stats
instance ToCStruct Stats where
withCStruct x f = allocaBytesAligned 3920 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p Stats{..} f = do
unless ((Data.Vector.length $ (memoryType)) <= MAX_MEMORY_TYPES) $
throwIO $ IOError Nothing InvalidArgument "" "memoryType is too long, a maximum of MAX_MEMORY_TYPES elements are allowed" Nothing Nothing
Data.Vector.imapM_ (\i e -> poke ((lowerArrayPtr ((p `plusPtr` 0 :: Ptr (FixedArray MAX_MEMORY_TYPES StatInfo)))) `plusPtr` (80 * (i)) :: Ptr StatInfo) (e)) (memoryType)
unless ((Data.Vector.length $ (memoryHeap)) <= MAX_MEMORY_HEAPS) $
throwIO $ IOError Nothing InvalidArgument "" "memoryHeap is too long, a maximum of MAX_MEMORY_HEAPS elements are allowed" Nothing Nothing
Data.Vector.imapM_ (\i e -> poke ((lowerArrayPtr ((p `plusPtr` 2560 :: Ptr (FixedArray MAX_MEMORY_HEAPS StatInfo)))) `plusPtr` (80 * (i)) :: Ptr StatInfo) (e)) (memoryHeap)
poke ((p `plusPtr` 3840 :: Ptr StatInfo)) (total)
f
cStructSize = 3920
cStructAlignment = 8
pokeZeroCStruct p f = do
unless ((Data.Vector.length $ (mempty)) <= MAX_MEMORY_TYPES) $
throwIO $ IOError Nothing InvalidArgument "" "memoryType is too long, a maximum of MAX_MEMORY_TYPES elements are allowed" Nothing Nothing
Data.Vector.imapM_ (\i e -> poke ((lowerArrayPtr ((p `plusPtr` 0 :: Ptr (FixedArray MAX_MEMORY_TYPES StatInfo)))) `plusPtr` (80 * (i)) :: Ptr StatInfo) (e)) (mempty)
unless ((Data.Vector.length $ (mempty)) <= MAX_MEMORY_HEAPS) $
throwIO $ IOError Nothing InvalidArgument "" "memoryHeap is too long, a maximum of MAX_MEMORY_HEAPS elements are allowed" Nothing Nothing
Data.Vector.imapM_ (\i e -> poke ((lowerArrayPtr ((p `plusPtr` 2560 :: Ptr (FixedArray MAX_MEMORY_HEAPS StatInfo)))) `plusPtr` (80 * (i)) :: Ptr StatInfo) (e)) (mempty)
poke ((p `plusPtr` 3840 :: Ptr StatInfo)) (zero)
f
instance FromCStruct Stats where
peekCStruct p = do
memoryType <- generateM (MAX_MEMORY_TYPES) (\i -> peekCStruct @StatInfo (((lowerArrayPtr @StatInfo ((p `plusPtr` 0 :: Ptr (FixedArray MAX_MEMORY_TYPES StatInfo)))) `advancePtrBytes` (80 * (i)) :: Ptr StatInfo)))
memoryHeap <- generateM (MAX_MEMORY_HEAPS) (\i -> peekCStruct @StatInfo (((lowerArrayPtr @StatInfo ((p `plusPtr` 2560 :: Ptr (FixedArray MAX_MEMORY_HEAPS StatInfo)))) `advancePtrBytes` (80 * (i)) :: Ptr StatInfo)))
total <- peekCStruct @StatInfo ((p `plusPtr` 3840 :: Ptr StatInfo))
pure $ Stats
memoryType memoryHeap total
instance Storable Stats where
sizeOf ~_ = 3920
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero Stats where
zero = Stats
mempty
mempty
zero
data Budget = Budget
{
blockBytes :: DeviceSize
,
allocationBytes :: DeviceSize
,
usage :: DeviceSize
,
budget :: DeviceSize
}
deriving (Typeable)
deriving instance Show Budget
instance ToCStruct Budget where
withCStruct x f = allocaBytesAligned 32 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p Budget{..} f = do
poke ((p `plusPtr` 0 :: Ptr DeviceSize)) (blockBytes)
poke ((p `plusPtr` 8 :: Ptr DeviceSize)) (allocationBytes)
poke ((p `plusPtr` 16 :: Ptr DeviceSize)) (usage)
poke ((p `plusPtr` 24 :: Ptr DeviceSize)) (budget)
f
cStructSize = 32
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 8 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 16 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 24 :: Ptr DeviceSize)) (zero)
f
instance FromCStruct Budget where
peekCStruct p = do
blockBytes <- peek @DeviceSize ((p `plusPtr` 0 :: Ptr DeviceSize))
allocationBytes <- peek @DeviceSize ((p `plusPtr` 8 :: Ptr DeviceSize))
usage <- peek @DeviceSize ((p `plusPtr` 16 :: Ptr DeviceSize))
budget <- peek @DeviceSize ((p `plusPtr` 24 :: Ptr DeviceSize))
pure $ Budget
blockBytes allocationBytes usage budget
instance Storable Budget where
sizeOf ~_ = 32
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero Budget where
zero = Budget
zero
zero
zero
zero
newtype Pool = Pool Word64
deriving newtype (Eq, Ord, Storable, Zero)
deriving anyclass (IsHandle)
instance Show Pool where
showsPrec p (Pool x) = showParen (p >= 11) (showString "Pool 0x" . showHex x)
newtype MemoryUsage = MemoryUsage Int32
deriving newtype (Eq, Ord, Storable, Zero)
pattern MEMORY_USAGE_UNKNOWN = MemoryUsage 0
pattern MEMORY_USAGE_GPU_ONLY = MemoryUsage 1
pattern MEMORY_USAGE_CPU_ONLY = MemoryUsage 2
pattern MEMORY_USAGE_CPU_TO_GPU = MemoryUsage 3
pattern MEMORY_USAGE_GPU_TO_CPU = MemoryUsage 4
pattern MEMORY_USAGE_CPU_COPY = MemoryUsage 5
pattern MEMORY_USAGE_GPU_LAZILY_ALLOCATED = MemoryUsage 6
{-# complete MEMORY_USAGE_UNKNOWN,
MEMORY_USAGE_GPU_ONLY,
MEMORY_USAGE_CPU_ONLY,
MEMORY_USAGE_CPU_TO_GPU,
MEMORY_USAGE_GPU_TO_CPU,
MEMORY_USAGE_CPU_COPY,
MEMORY_USAGE_GPU_LAZILY_ALLOCATED :: MemoryUsage #-}
instance Show MemoryUsage where
showsPrec p = \case
MEMORY_USAGE_UNKNOWN -> showString "MEMORY_USAGE_UNKNOWN"
MEMORY_USAGE_GPU_ONLY -> showString "MEMORY_USAGE_GPU_ONLY"
MEMORY_USAGE_CPU_ONLY -> showString "MEMORY_USAGE_CPU_ONLY"
MEMORY_USAGE_CPU_TO_GPU -> showString "MEMORY_USAGE_CPU_TO_GPU"
MEMORY_USAGE_GPU_TO_CPU -> showString "MEMORY_USAGE_GPU_TO_CPU"
MEMORY_USAGE_CPU_COPY -> showString "MEMORY_USAGE_CPU_COPY"
MEMORY_USAGE_GPU_LAZILY_ALLOCATED -> showString "MEMORY_USAGE_GPU_LAZILY_ALLOCATED"
MemoryUsage x -> showParen (p >= 11) (showString "MemoryUsage " . showsPrec 11 x)
instance Read MemoryUsage where
readPrec = parens (choose [("MEMORY_USAGE_UNKNOWN", pure MEMORY_USAGE_UNKNOWN)
, ("MEMORY_USAGE_GPU_ONLY", pure MEMORY_USAGE_GPU_ONLY)
, ("MEMORY_USAGE_CPU_ONLY", pure MEMORY_USAGE_CPU_ONLY)
, ("MEMORY_USAGE_CPU_TO_GPU", pure MEMORY_USAGE_CPU_TO_GPU)
, ("MEMORY_USAGE_GPU_TO_CPU", pure MEMORY_USAGE_GPU_TO_CPU)
, ("MEMORY_USAGE_CPU_COPY", pure MEMORY_USAGE_CPU_COPY)
, ("MEMORY_USAGE_GPU_LAZILY_ALLOCATED", pure MEMORY_USAGE_GPU_LAZILY_ALLOCATED)]
+++
prec 10 (do
expectP (Ident "MemoryUsage")
v <- step readPrec
pure (MemoryUsage v)))
newtype AllocationCreateFlagBits = AllocationCreateFlagBits Flags
deriving newtype (Eq, Ord, Storable, Zero, Bits)
pattern ALLOCATION_CREATE_DEDICATED_MEMORY_BIT = AllocationCreateFlagBits 0x00000001
pattern ALLOCATION_CREATE_NEVER_ALLOCATE_BIT = AllocationCreateFlagBits 0x00000002
pattern ALLOCATION_CREATE_MAPPED_BIT = AllocationCreateFlagBits 0x00000004
pattern ALLOCATION_CREATE_CAN_BECOME_LOST_BIT = AllocationCreateFlagBits 0x00000008
pattern ALLOCATION_CREATE_CAN_MAKE_OTHER_LOST_BIT = AllocationCreateFlagBits 0x00000010
pattern ALLOCATION_CREATE_USER_DATA_COPY_STRING_BIT = AllocationCreateFlagBits 0x00000020
pattern ALLOCATION_CREATE_UPPER_ADDRESS_BIT = AllocationCreateFlagBits 0x00000040
pattern ALLOCATION_CREATE_DONT_BIND_BIT = AllocationCreateFlagBits 0x00000080
pattern ALLOCATION_CREATE_WITHIN_BUDGET_BIT = AllocationCreateFlagBits 0x00000100
pattern ALLOCATION_CREATE_STRATEGY_BEST_FIT_BIT = AllocationCreateFlagBits 0x00010000
pattern ALLOCATION_CREATE_STRATEGY_WORST_FIT_BIT = AllocationCreateFlagBits 0x00020000
pattern ALLOCATION_CREATE_STRATEGY_FIRST_FIT_BIT = AllocationCreateFlagBits 0x00040000
pattern ALLOCATION_CREATE_STRATEGY_MIN_MEMORY_BIT = AllocationCreateFlagBits 0x00010000
pattern ALLOCATION_CREATE_STRATEGY_MIN_TIME_BIT = AllocationCreateFlagBits 0x00040000
pattern ALLOCATION_CREATE_STRATEGY_MIN_FRAGMENTATION_BIT = AllocationCreateFlagBits 0x00020000
pattern ALLOCATION_CREATE_STRATEGY_MASK = AllocationCreateFlagBits 0x00070000
type AllocationCreateFlags = AllocationCreateFlagBits
instance Show AllocationCreateFlagBits where
showsPrec p = \case
ALLOCATION_CREATE_DEDICATED_MEMORY_BIT -> showString "ALLOCATION_CREATE_DEDICATED_MEMORY_BIT"
ALLOCATION_CREATE_NEVER_ALLOCATE_BIT -> showString "ALLOCATION_CREATE_NEVER_ALLOCATE_BIT"
ALLOCATION_CREATE_MAPPED_BIT -> showString "ALLOCATION_CREATE_MAPPED_BIT"
ALLOCATION_CREATE_CAN_BECOME_LOST_BIT -> showString "ALLOCATION_CREATE_CAN_BECOME_LOST_BIT"
ALLOCATION_CREATE_CAN_MAKE_OTHER_LOST_BIT -> showString "ALLOCATION_CREATE_CAN_MAKE_OTHER_LOST_BIT"
ALLOCATION_CREATE_USER_DATA_COPY_STRING_BIT -> showString "ALLOCATION_CREATE_USER_DATA_COPY_STRING_BIT"
ALLOCATION_CREATE_UPPER_ADDRESS_BIT -> showString "ALLOCATION_CREATE_UPPER_ADDRESS_BIT"
ALLOCATION_CREATE_DONT_BIND_BIT -> showString "ALLOCATION_CREATE_DONT_BIND_BIT"
ALLOCATION_CREATE_WITHIN_BUDGET_BIT -> showString "ALLOCATION_CREATE_WITHIN_BUDGET_BIT"
ALLOCATION_CREATE_STRATEGY_BEST_FIT_BIT -> showString "ALLOCATION_CREATE_STRATEGY_BEST_FIT_BIT"
ALLOCATION_CREATE_STRATEGY_WORST_FIT_BIT -> showString "ALLOCATION_CREATE_STRATEGY_WORST_FIT_BIT"
ALLOCATION_CREATE_STRATEGY_FIRST_FIT_BIT -> showString "ALLOCATION_CREATE_STRATEGY_FIRST_FIT_BIT"
ALLOCATION_CREATE_STRATEGY_MIN_MEMORY_BIT -> showString "ALLOCATION_CREATE_STRATEGY_MIN_MEMORY_BIT"
ALLOCATION_CREATE_STRATEGY_MIN_TIME_BIT -> showString "ALLOCATION_CREATE_STRATEGY_MIN_TIME_BIT"
ALLOCATION_CREATE_STRATEGY_MIN_FRAGMENTATION_BIT -> showString "ALLOCATION_CREATE_STRATEGY_MIN_FRAGMENTATION_BIT"
ALLOCATION_CREATE_STRATEGY_MASK -> showString "ALLOCATION_CREATE_STRATEGY_MASK"
AllocationCreateFlagBits x -> showParen (p >= 11) (showString "AllocationCreateFlagBits 0x" . showHex x)
instance Read AllocationCreateFlagBits where
readPrec = parens (choose [("ALLOCATION_CREATE_DEDICATED_MEMORY_BIT", pure ALLOCATION_CREATE_DEDICATED_MEMORY_BIT)
, ("ALLOCATION_CREATE_NEVER_ALLOCATE_BIT", pure ALLOCATION_CREATE_NEVER_ALLOCATE_BIT)
, ("ALLOCATION_CREATE_MAPPED_BIT", pure ALLOCATION_CREATE_MAPPED_BIT)
, ("ALLOCATION_CREATE_CAN_BECOME_LOST_BIT", pure ALLOCATION_CREATE_CAN_BECOME_LOST_BIT)
, ("ALLOCATION_CREATE_CAN_MAKE_OTHER_LOST_BIT", pure ALLOCATION_CREATE_CAN_MAKE_OTHER_LOST_BIT)
, ("ALLOCATION_CREATE_USER_DATA_COPY_STRING_BIT", pure ALLOCATION_CREATE_USER_DATA_COPY_STRING_BIT)
, ("ALLOCATION_CREATE_UPPER_ADDRESS_BIT", pure ALLOCATION_CREATE_UPPER_ADDRESS_BIT)
, ("ALLOCATION_CREATE_DONT_BIND_BIT", pure ALLOCATION_CREATE_DONT_BIND_BIT)
, ("ALLOCATION_CREATE_WITHIN_BUDGET_BIT", pure ALLOCATION_CREATE_WITHIN_BUDGET_BIT)
, ("ALLOCATION_CREATE_STRATEGY_BEST_FIT_BIT", pure ALLOCATION_CREATE_STRATEGY_BEST_FIT_BIT)
, ("ALLOCATION_CREATE_STRATEGY_WORST_FIT_BIT", pure ALLOCATION_CREATE_STRATEGY_WORST_FIT_BIT)
, ("ALLOCATION_CREATE_STRATEGY_FIRST_FIT_BIT", pure ALLOCATION_CREATE_STRATEGY_FIRST_FIT_BIT)
, ("ALLOCATION_CREATE_STRATEGY_MIN_MEMORY_BIT", pure ALLOCATION_CREATE_STRATEGY_MIN_MEMORY_BIT)
, ("ALLOCATION_CREATE_STRATEGY_MIN_TIME_BIT", pure ALLOCATION_CREATE_STRATEGY_MIN_TIME_BIT)
, ("ALLOCATION_CREATE_STRATEGY_MIN_FRAGMENTATION_BIT", pure ALLOCATION_CREATE_STRATEGY_MIN_FRAGMENTATION_BIT)
, ("ALLOCATION_CREATE_STRATEGY_MASK", pure ALLOCATION_CREATE_STRATEGY_MASK)]
+++
prec 10 (do
expectP (Ident "AllocationCreateFlagBits")
v <- step readPrec
pure (AllocationCreateFlagBits v)))
data AllocationCreateInfo = AllocationCreateInfo
{
flags :: AllocationCreateFlags
,
usage :: MemoryUsage
,
requiredFlags :: MemoryPropertyFlags
,
preferredFlags :: MemoryPropertyFlags
,
memoryTypeBits :: Word32
,
pool :: Pool
,
userData :: Ptr ()
}
deriving (Typeable)
deriving instance Show AllocationCreateInfo
instance ToCStruct AllocationCreateInfo where
withCStruct x f = allocaBytesAligned 40 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p AllocationCreateInfo{..} f = do
poke ((p `plusPtr` 0 :: Ptr AllocationCreateFlags)) (flags)
poke ((p `plusPtr` 4 :: Ptr MemoryUsage)) (usage)
poke ((p `plusPtr` 8 :: Ptr MemoryPropertyFlags)) (requiredFlags)
poke ((p `plusPtr` 12 :: Ptr MemoryPropertyFlags)) (preferredFlags)
poke ((p `plusPtr` 16 :: Ptr Word32)) (memoryTypeBits)
poke ((p `plusPtr` 24 :: Ptr Pool)) (pool)
poke ((p `plusPtr` 32 :: Ptr (Ptr ()))) (userData)
f
cStructSize = 40
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr AllocationCreateFlags)) (zero)
poke ((p `plusPtr` 4 :: Ptr MemoryUsage)) (zero)
poke ((p `plusPtr` 8 :: Ptr MemoryPropertyFlags)) (zero)
poke ((p `plusPtr` 12 :: Ptr MemoryPropertyFlags)) (zero)
poke ((p `plusPtr` 16 :: Ptr Word32)) (zero)
f
instance FromCStruct AllocationCreateInfo where
peekCStruct p = do
flags <- peek @AllocationCreateFlags ((p `plusPtr` 0 :: Ptr AllocationCreateFlags))
usage <- peek @MemoryUsage ((p `plusPtr` 4 :: Ptr MemoryUsage))
requiredFlags <- peek @MemoryPropertyFlags ((p `plusPtr` 8 :: Ptr MemoryPropertyFlags))
preferredFlags <- peek @MemoryPropertyFlags ((p `plusPtr` 12 :: Ptr MemoryPropertyFlags))
memoryTypeBits <- peek @Word32 ((p `plusPtr` 16 :: Ptr Word32))
pool <- peek @Pool ((p `plusPtr` 24 :: Ptr Pool))
pUserData <- peek @(Ptr ()) ((p `plusPtr` 32 :: Ptr (Ptr ())))
pure $ AllocationCreateInfo
flags usage requiredFlags preferredFlags memoryTypeBits pool pUserData
instance Storable AllocationCreateInfo where
sizeOf ~_ = 40
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero AllocationCreateInfo where
zero = AllocationCreateInfo
zero
zero
zero
zero
zero
zero
zero
newtype PoolCreateFlagBits = PoolCreateFlagBits Flags
deriving newtype (Eq, Ord, Storable, Zero, Bits)
pattern POOL_CREATE_IGNORE_BUFFER_IMAGE_GRANULARITY_BIT = PoolCreateFlagBits 0x00000002
pattern POOL_CREATE_LINEAR_ALGORITHM_BIT = PoolCreateFlagBits 0x00000004
pattern POOL_CREATE_BUDDY_ALGORITHM_BIT = PoolCreateFlagBits 0x00000008
pattern POOL_CREATE_ALGORITHM_MASK = PoolCreateFlagBits 0x0000000c
type PoolCreateFlags = PoolCreateFlagBits
instance Show PoolCreateFlagBits where
showsPrec p = \case
POOL_CREATE_IGNORE_BUFFER_IMAGE_GRANULARITY_BIT -> showString "POOL_CREATE_IGNORE_BUFFER_IMAGE_GRANULARITY_BIT"
POOL_CREATE_LINEAR_ALGORITHM_BIT -> showString "POOL_CREATE_LINEAR_ALGORITHM_BIT"
POOL_CREATE_BUDDY_ALGORITHM_BIT -> showString "POOL_CREATE_BUDDY_ALGORITHM_BIT"
POOL_CREATE_ALGORITHM_MASK -> showString "POOL_CREATE_ALGORITHM_MASK"
PoolCreateFlagBits x -> showParen (p >= 11) (showString "PoolCreateFlagBits 0x" . showHex x)
instance Read PoolCreateFlagBits where
readPrec = parens (choose [("POOL_CREATE_IGNORE_BUFFER_IMAGE_GRANULARITY_BIT", pure POOL_CREATE_IGNORE_BUFFER_IMAGE_GRANULARITY_BIT)
, ("POOL_CREATE_LINEAR_ALGORITHM_BIT", pure POOL_CREATE_LINEAR_ALGORITHM_BIT)
, ("POOL_CREATE_BUDDY_ALGORITHM_BIT", pure POOL_CREATE_BUDDY_ALGORITHM_BIT)
, ("POOL_CREATE_ALGORITHM_MASK", pure POOL_CREATE_ALGORITHM_MASK)]
+++
prec 10 (do
expectP (Ident "PoolCreateFlagBits")
v <- step readPrec
pure (PoolCreateFlagBits v)))
data PoolCreateInfo = PoolCreateInfo
{
memoryTypeIndex :: Word32
,
flags :: PoolCreateFlags
,
blockSize :: DeviceSize
,
minBlockCount :: Word64
,
maxBlockCount :: Word64
,
frameInUseCount :: Word32
}
deriving (Typeable)
deriving instance Show PoolCreateInfo
instance ToCStruct PoolCreateInfo where
withCStruct x f = allocaBytesAligned 40 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p PoolCreateInfo{..} f = do
poke ((p `plusPtr` 0 :: Ptr Word32)) (memoryTypeIndex)
poke ((p `plusPtr` 4 :: Ptr PoolCreateFlags)) (flags)
poke ((p `plusPtr` 8 :: Ptr DeviceSize)) (blockSize)
poke ((p `plusPtr` 16 :: Ptr CSize)) (CSize (minBlockCount))
poke ((p `plusPtr` 24 :: Ptr CSize)) (CSize (maxBlockCount))
poke ((p `plusPtr` 32 :: Ptr Word32)) (frameInUseCount)
f
cStructSize = 40
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr Word32)) (zero)
poke ((p `plusPtr` 4 :: Ptr PoolCreateFlags)) (zero)
poke ((p `plusPtr` 8 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 16 :: Ptr CSize)) (CSize (zero))
poke ((p `plusPtr` 24 :: Ptr CSize)) (CSize (zero))
poke ((p `plusPtr` 32 :: Ptr Word32)) (zero)
f
instance FromCStruct PoolCreateInfo where
peekCStruct p = do
memoryTypeIndex <- peek @Word32 ((p `plusPtr` 0 :: Ptr Word32))
flags <- peek @PoolCreateFlags ((p `plusPtr` 4 :: Ptr PoolCreateFlags))
blockSize <- peek @DeviceSize ((p `plusPtr` 8 :: Ptr DeviceSize))
minBlockCount <- peek @CSize ((p `plusPtr` 16 :: Ptr CSize))
maxBlockCount <- peek @CSize ((p `plusPtr` 24 :: Ptr CSize))
frameInUseCount <- peek @Word32 ((p `plusPtr` 32 :: Ptr Word32))
pure $ PoolCreateInfo
memoryTypeIndex flags blockSize ((\(CSize a) -> a) minBlockCount) ((\(CSize a) -> a) maxBlockCount) frameInUseCount
instance Storable PoolCreateInfo where
sizeOf ~_ = 40
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero PoolCreateInfo where
zero = PoolCreateInfo
zero
zero
zero
zero
zero
zero
data PoolStats = PoolStats
{
size :: DeviceSize
,
unusedSize :: DeviceSize
,
allocationCount :: Word64
,
unusedRangeCount :: Word64
,
unusedRangeSizeMax :: DeviceSize
,
blockCount :: Word64
}
deriving (Typeable)
deriving instance Show PoolStats
instance ToCStruct PoolStats where
withCStruct x f = allocaBytesAligned 48 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p PoolStats{..} f = do
poke ((p `plusPtr` 0 :: Ptr DeviceSize)) (size)
poke ((p `plusPtr` 8 :: Ptr DeviceSize)) (unusedSize)
poke ((p `plusPtr` 16 :: Ptr CSize)) (CSize (allocationCount))
poke ((p `plusPtr` 24 :: Ptr CSize)) (CSize (unusedRangeCount))
poke ((p `plusPtr` 32 :: Ptr DeviceSize)) (unusedRangeSizeMax)
poke ((p `plusPtr` 40 :: Ptr CSize)) (CSize (blockCount))
f
cStructSize = 48
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 8 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 16 :: Ptr CSize)) (CSize (zero))
poke ((p `plusPtr` 24 :: Ptr CSize)) (CSize (zero))
poke ((p `plusPtr` 32 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 40 :: Ptr CSize)) (CSize (zero))
f
instance FromCStruct PoolStats where
peekCStruct p = do
size <- peek @DeviceSize ((p `plusPtr` 0 :: Ptr DeviceSize))
unusedSize <- peek @DeviceSize ((p `plusPtr` 8 :: Ptr DeviceSize))
allocationCount <- peek @CSize ((p `plusPtr` 16 :: Ptr CSize))
unusedRangeCount <- peek @CSize ((p `plusPtr` 24 :: Ptr CSize))
unusedRangeSizeMax <- peek @DeviceSize ((p `plusPtr` 32 :: Ptr DeviceSize))
blockCount <- peek @CSize ((p `plusPtr` 40 :: Ptr CSize))
pure $ PoolStats
size unusedSize ((\(CSize a) -> a) allocationCount) ((\(CSize a) -> a) unusedRangeCount) unusedRangeSizeMax ((\(CSize a) -> a) blockCount)
instance Storable PoolStats where
sizeOf ~_ = 48
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero PoolStats where
zero = PoolStats
zero
zero
zero
zero
zero
zero
newtype Allocation = Allocation Word64
deriving newtype (Eq, Ord, Storable, Zero)
deriving anyclass (IsHandle)
instance Show Allocation where
showsPrec p (Allocation x) = showParen (p >= 11) (showString "Allocation 0x" . showHex x)
data AllocationInfo = AllocationInfo
{
memoryType :: Word32
,
deviceMemory :: DeviceMemory
,
offset :: DeviceSize
,
size :: DeviceSize
,
mappedData :: Ptr ()
,
userData :: Ptr ()
}
deriving (Typeable)
deriving instance Show AllocationInfo
instance ToCStruct AllocationInfo where
withCStruct x f = allocaBytesAligned 48 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p AllocationInfo{..} f = do
poke ((p `plusPtr` 0 :: Ptr Word32)) (memoryType)
poke ((p `plusPtr` 8 :: Ptr DeviceMemory)) (deviceMemory)
poke ((p `plusPtr` 16 :: Ptr DeviceSize)) (offset)
poke ((p `plusPtr` 24 :: Ptr DeviceSize)) (size)
poke ((p `plusPtr` 32 :: Ptr (Ptr ()))) (mappedData)
poke ((p `plusPtr` 40 :: Ptr (Ptr ()))) (userData)
f
cStructSize = 48
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr Word32)) (zero)
poke ((p `plusPtr` 16 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 24 :: Ptr DeviceSize)) (zero)
f
instance FromCStruct AllocationInfo where
peekCStruct p = do
memoryType <- peek @Word32 ((p `plusPtr` 0 :: Ptr Word32))
deviceMemory <- peek @DeviceMemory ((p `plusPtr` 8 :: Ptr DeviceMemory))
offset <- peek @DeviceSize ((p `plusPtr` 16 :: Ptr DeviceSize))
size <- peek @DeviceSize ((p `plusPtr` 24 :: Ptr DeviceSize))
pMappedData <- peek @(Ptr ()) ((p `plusPtr` 32 :: Ptr (Ptr ())))
pUserData <- peek @(Ptr ()) ((p `plusPtr` 40 :: Ptr (Ptr ())))
pure $ AllocationInfo
memoryType deviceMemory offset size pMappedData pUserData
instance Storable AllocationInfo where
sizeOf ~_ = 48
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero AllocationInfo where
zero = AllocationInfo
zero
zero
zero
zero
zero
zero
newtype DefragmentationContext = DefragmentationContext Word64
deriving newtype (Eq, Ord, Storable, Zero)
deriving anyclass (IsHandle)
instance Show DefragmentationContext where
showsPrec p (DefragmentationContext x) = showParen (p >= 11) (showString "DefragmentationContext 0x" . showHex x)
newtype DefragmentationFlagBits = DefragmentationFlagBits Flags
deriving newtype (Eq, Ord, Storable, Zero, Bits)
pattern DEFRAGMENTATION_FLAG_INCREMENTAL = DefragmentationFlagBits 0x00000001
type DefragmentationFlags = DefragmentationFlagBits
instance Show DefragmentationFlagBits where
showsPrec p = \case
DEFRAGMENTATION_FLAG_INCREMENTAL -> showString "DEFRAGMENTATION_FLAG_INCREMENTAL"
DefragmentationFlagBits x -> showParen (p >= 11) (showString "DefragmentationFlagBits 0x" . showHex x)
instance Read DefragmentationFlagBits where
readPrec = parens (choose [("DEFRAGMENTATION_FLAG_INCREMENTAL", pure DEFRAGMENTATION_FLAG_INCREMENTAL)]
+++
prec 10 (do
expectP (Ident "DefragmentationFlagBits")
v <- step readPrec
pure (DefragmentationFlagBits v)))
data DefragmentationInfo2 = DefragmentationInfo2
{
flags :: DefragmentationFlags
,
allocations :: Vector Allocation
,
allocationsChanged :: Ptr Bool32
,
pools :: Vector Pool
,
maxCpuBytesToMove :: DeviceSize
,
maxCpuAllocationsToMove :: Word32
,
maxGpuBytesToMove :: DeviceSize
,
maxGpuAllocationsToMove :: Word32
,
commandBuffer :: Ptr CommandBuffer_T
}
deriving (Typeable)
deriving instance Show DefragmentationInfo2
instance ToCStruct DefragmentationInfo2 where
withCStruct x f = allocaBytesAligned 80 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p DefragmentationInfo2{..} f = evalContT $ do
lift $ poke ((p `plusPtr` 0 :: Ptr DefragmentationFlags)) (flags)
lift $ poke ((p `plusPtr` 4 :: Ptr Word32)) ((fromIntegral (Data.Vector.length $ (allocations)) :: Word32))
pPAllocations' <- ContT $ allocaBytesAligned @Allocation ((Data.Vector.length (allocations)) * 8) 8
lift $ Data.Vector.imapM_ (\i e -> poke (pPAllocations' `plusPtr` (8 * (i)) :: Ptr Allocation) (e)) (allocations)
lift $ poke ((p `plusPtr` 8 :: Ptr (Ptr Allocation))) (pPAllocations')
lift $ poke ((p `plusPtr` 16 :: Ptr (Ptr Bool32))) (allocationsChanged)
lift $ poke ((p `plusPtr` 24 :: Ptr Word32)) ((fromIntegral (Data.Vector.length $ (pools)) :: Word32))
pPPools' <- ContT $ allocaBytesAligned @Pool ((Data.Vector.length (pools)) * 8) 8
lift $ Data.Vector.imapM_ (\i e -> poke (pPPools' `plusPtr` (8 * (i)) :: Ptr Pool) (e)) (pools)
lift $ poke ((p `plusPtr` 32 :: Ptr (Ptr Pool))) (pPPools')
lift $ poke ((p `plusPtr` 40 :: Ptr DeviceSize)) (maxCpuBytesToMove)
lift $ poke ((p `plusPtr` 48 :: Ptr Word32)) (maxCpuAllocationsToMove)
lift $ poke ((p `plusPtr` 56 :: Ptr DeviceSize)) (maxGpuBytesToMove)
lift $ poke ((p `plusPtr` 64 :: Ptr Word32)) (maxGpuAllocationsToMove)
lift $ poke ((p `plusPtr` 72 :: Ptr (Ptr CommandBuffer_T))) (commandBuffer)
lift $ f
cStructSize = 80
cStructAlignment = 8
pokeZeroCStruct p f = evalContT $ do
lift $ poke ((p `plusPtr` 0 :: Ptr DefragmentationFlags)) (zero)
pPAllocations' <- ContT $ allocaBytesAligned @Allocation ((Data.Vector.length (mempty)) * 8) 8
lift $ Data.Vector.imapM_ (\i e -> poke (pPAllocations' `plusPtr` (8 * (i)) :: Ptr Allocation) (e)) (mempty)
lift $ poke ((p `plusPtr` 8 :: Ptr (Ptr Allocation))) (pPAllocations')
pPPools' <- ContT $ allocaBytesAligned @Pool ((Data.Vector.length (mempty)) * 8) 8
lift $ Data.Vector.imapM_ (\i e -> poke (pPPools' `plusPtr` (8 * (i)) :: Ptr Pool) (e)) (mempty)
lift $ poke ((p `plusPtr` 32 :: Ptr (Ptr Pool))) (pPPools')
lift $ poke ((p `plusPtr` 40 :: Ptr DeviceSize)) (zero)
lift $ poke ((p `plusPtr` 48 :: Ptr Word32)) (zero)
lift $ poke ((p `plusPtr` 56 :: Ptr DeviceSize)) (zero)
lift $ poke ((p `plusPtr` 64 :: Ptr Word32)) (zero)
lift $ f
instance FromCStruct DefragmentationInfo2 where
peekCStruct p = do
flags <- peek @DefragmentationFlags ((p `plusPtr` 0 :: Ptr DefragmentationFlags))
allocationCount <- peek @Word32 ((p `plusPtr` 4 :: Ptr Word32))
pAllocations <- peek @(Ptr Allocation) ((p `plusPtr` 8 :: Ptr (Ptr Allocation)))
pAllocations' <- generateM (fromIntegral allocationCount) (\i -> peek @Allocation ((pAllocations `advancePtrBytes` (8 * (i)) :: Ptr Allocation)))
pAllocationsChanged <- peek @(Ptr Bool32) ((p `plusPtr` 16 :: Ptr (Ptr Bool32)))
poolCount <- peek @Word32 ((p `plusPtr` 24 :: Ptr Word32))
pPools <- peek @(Ptr Pool) ((p `plusPtr` 32 :: Ptr (Ptr Pool)))
pPools' <- generateM (fromIntegral poolCount) (\i -> peek @Pool ((pPools `advancePtrBytes` (8 * (i)) :: Ptr Pool)))
maxCpuBytesToMove <- peek @DeviceSize ((p `plusPtr` 40 :: Ptr DeviceSize))
maxCpuAllocationsToMove <- peek @Word32 ((p `plusPtr` 48 :: Ptr Word32))
maxGpuBytesToMove <- peek @DeviceSize ((p `plusPtr` 56 :: Ptr DeviceSize))
maxGpuAllocationsToMove <- peek @Word32 ((p `plusPtr` 64 :: Ptr Word32))
commandBuffer <- peek @(Ptr CommandBuffer_T) ((p `plusPtr` 72 :: Ptr (Ptr CommandBuffer_T)))
pure $ DefragmentationInfo2
flags pAllocations' pAllocationsChanged pPools' maxCpuBytesToMove maxCpuAllocationsToMove maxGpuBytesToMove maxGpuAllocationsToMove commandBuffer
instance Zero DefragmentationInfo2 where
zero = DefragmentationInfo2
zero
mempty
zero
mempty
zero
zero
zero
zero
zero
data DefragmentationPassMoveInfo = DefragmentationPassMoveInfo
{
allocation :: Allocation
,
memory :: DeviceMemory
,
offset :: DeviceSize
}
deriving (Typeable)
deriving instance Show DefragmentationPassMoveInfo
instance ToCStruct DefragmentationPassMoveInfo where
withCStruct x f = allocaBytesAligned 24 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p DefragmentationPassMoveInfo{..} f = do
poke ((p `plusPtr` 0 :: Ptr Allocation)) (allocation)
poke ((p `plusPtr` 8 :: Ptr DeviceMemory)) (memory)
poke ((p `plusPtr` 16 :: Ptr DeviceSize)) (offset)
f
cStructSize = 24
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr Allocation)) (zero)
poke ((p `plusPtr` 8 :: Ptr DeviceMemory)) (zero)
poke ((p `plusPtr` 16 :: Ptr DeviceSize)) (zero)
f
instance FromCStruct DefragmentationPassMoveInfo where
peekCStruct p = do
allocation <- peek @Allocation ((p `plusPtr` 0 :: Ptr Allocation))
memory <- peek @DeviceMemory ((p `plusPtr` 8 :: Ptr DeviceMemory))
offset <- peek @DeviceSize ((p `plusPtr` 16 :: Ptr DeviceSize))
pure $ DefragmentationPassMoveInfo
allocation memory offset
instance Storable DefragmentationPassMoveInfo where
sizeOf ~_ = 24
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero DefragmentationPassMoveInfo where
zero = DefragmentationPassMoveInfo
zero
zero
zero
data DefragmentationPassInfo = DefragmentationPassInfo
{
moveCount :: Word32
,
moves :: Ptr DefragmentationPassMoveInfo
}
deriving (Typeable)
deriving instance Show DefragmentationPassInfo
instance ToCStruct DefragmentationPassInfo where
withCStruct x f = allocaBytesAligned 16 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p DefragmentationPassInfo{..} f = do
poke ((p `plusPtr` 0 :: Ptr Word32)) (moveCount)
poke ((p `plusPtr` 8 :: Ptr (Ptr DefragmentationPassMoveInfo))) (moves)
f
cStructSize = 16
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr Word32)) (zero)
poke ((p `plusPtr` 8 :: Ptr (Ptr DefragmentationPassMoveInfo))) (zero)
f
instance FromCStruct DefragmentationPassInfo where
peekCStruct p = do
moveCount <- peek @Word32 ((p `plusPtr` 0 :: Ptr Word32))
pMoves <- peek @(Ptr DefragmentationPassMoveInfo) ((p `plusPtr` 8 :: Ptr (Ptr DefragmentationPassMoveInfo)))
pure $ DefragmentationPassInfo
moveCount pMoves
instance Storable DefragmentationPassInfo where
sizeOf ~_ = 16
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero DefragmentationPassInfo where
zero = DefragmentationPassInfo
zero
zero
data DefragmentationInfo = DefragmentationInfo
{
maxBytesToMove :: DeviceSize
,
maxAllocationsToMove :: Word32
}
deriving (Typeable)
deriving instance Show DefragmentationInfo
instance ToCStruct DefragmentationInfo where
withCStruct x f = allocaBytesAligned 16 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p DefragmentationInfo{..} f = do
poke ((p `plusPtr` 0 :: Ptr DeviceSize)) (maxBytesToMove)
poke ((p `plusPtr` 8 :: Ptr Word32)) (maxAllocationsToMove)
f
cStructSize = 16
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 8 :: Ptr Word32)) (zero)
f
instance FromCStruct DefragmentationInfo where
peekCStruct p = do
maxBytesToMove <- peek @DeviceSize ((p `plusPtr` 0 :: Ptr DeviceSize))
maxAllocationsToMove <- peek @Word32 ((p `plusPtr` 8 :: Ptr Word32))
pure $ DefragmentationInfo
maxBytesToMove maxAllocationsToMove
instance Storable DefragmentationInfo where
sizeOf ~_ = 16
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero DefragmentationInfo where
zero = DefragmentationInfo
zero
zero
data DefragmentationStats = DefragmentationStats
{
bytesMoved :: DeviceSize
,
bytesFreed :: DeviceSize
,
allocationsMoved :: Word32
,
deviceMemoryBlocksFreed :: Word32
}
deriving (Typeable)
deriving instance Show DefragmentationStats
instance ToCStruct DefragmentationStats where
withCStruct x f = allocaBytesAligned 24 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p DefragmentationStats{..} f = do
poke ((p `plusPtr` 0 :: Ptr DeviceSize)) (bytesMoved)
poke ((p `plusPtr` 8 :: Ptr DeviceSize)) (bytesFreed)
poke ((p `plusPtr` 16 :: Ptr Word32)) (allocationsMoved)
poke ((p `plusPtr` 20 :: Ptr Word32)) (deviceMemoryBlocksFreed)
f
cStructSize = 24
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 8 :: Ptr DeviceSize)) (zero)
poke ((p `plusPtr` 16 :: Ptr Word32)) (zero)
poke ((p `plusPtr` 20 :: Ptr Word32)) (zero)
f
instance FromCStruct DefragmentationStats where
peekCStruct p = do
bytesMoved <- peek @DeviceSize ((p `plusPtr` 0 :: Ptr DeviceSize))
bytesFreed <- peek @DeviceSize ((p `plusPtr` 8 :: Ptr DeviceSize))
allocationsMoved <- peek @Word32 ((p `plusPtr` 16 :: Ptr Word32))
deviceMemoryBlocksFreed <- peek @Word32 ((p `plusPtr` 20 :: Ptr Word32))
pure $ DefragmentationStats
bytesMoved bytesFreed allocationsMoved deviceMemoryBlocksFreed
instance Storable DefragmentationStats where
sizeOf ~_ = 24
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero DefragmentationStats where
zero = DefragmentationStats
zero
zero
zero
zero