Merge pull request #319 from expipiplus1/vma-bump

Bump VMA

VulkanMemoryAllocator/VulkanMemoryAllocator.cabal

@@ -5,7 +5,7 @@ cabal-version: 2.2
 -- see: https://github.com/sol/hpack
 
 name:           VulkanMemoryAllocator
-version:        0.6.0.1
+version:        0.7
 synopsis:       Bindings to the VulkanMemoryAllocator library
 category:       Graphics
 homepage:       https://github.com/expipiplus1/vulkan#readme

VulkanMemoryAllocator/changelog.md

@@ -2,6 +2,9 @@
 
 ## WIP
 
+## [0.7] - 2021-07-23
+- Bump VMA, adds vkaCreateBufferWithAlignment and fixes aligned_alloc on OS X.
+
 ## [0.6.0.1] - 2021-06-26
 - Bump VMA, no functional change
 - Use allocaBytes over allocaBytesAligned where possible

VulkanMemoryAllocator/package.yaml

@@ -1,5 +1,5 @@
 name: VulkanMemoryAllocator
-version: "0.6.0.1"
+version: "0.7"
 synopsis: Bindings to the VulkanMemoryAllocator library
 category: Graphics
 maintainer: Joe Hermaszewski <[email protected]>

VulkanMemoryAllocator/src/VulkanMemoryAllocator.hs

@@ -59,6 +59,7 @@ module VulkanMemoryAllocator  ( createAllocator
                               , bindImageMemory2
                               , createBuffer
                               , withBuffer
+                              , createBufferWithAlignment
                               , destroyBuffer
                               , createImage
                               , withImage
@@ -155,6 +156,7 @@ import Vulkan (CommandBuffer_T)
 import Vulkan (DeviceMemory)
 import Vulkan (DeviceSize)
 import Vulkan (Device_T)
+import Vulkan (ExternalMemoryHandleTypeFlagsKHR)
 import Vulkan (Flags)
 import Vulkan (Image)
 import Vulkan (ImageCreateInfo)
@@ -2261,6 +2263,44 @@ withBuffer allocator pBufferCreateInfo pAllocationCreateInfo b =
     (\(o0, o1, _) -> destroyBuffer allocator o0 o1)
 
 
+foreign import ccall
+#if !defined(SAFE_FOREIGN_CALLS)
+  unsafe
+#endif
+  "vmaCreateBufferWithAlignment" ffiVmaCreateBufferWithAlignment
+  :: Allocator -> Ptr (SomeStruct BufferCreateInfo) -> Ptr AllocationCreateInfo -> DeviceSize -> Ptr Buffer -> Ptr Allocation -> Ptr AllocationInfo -> IO Result
+
+-- | Creates a buffer with additional minimum alignment.
+--
+-- Similar to 'createBuffer' but provides additional parameter
+-- @minAlignment@ which allows to specify custom, minimum alignment to be
+-- used when placing the buffer inside a larger memory block, which may be
+-- needed e.g. for interop with OpenGL.
+createBufferWithAlignment :: forall a io
+                           . (Extendss BufferCreateInfo a, PokeChain a, MonadIO io)
+                          => -- No documentation found for Nested "vmaCreateBufferWithAlignment" "allocator"
+                             Allocator
+                          -> -- No documentation found for Nested "vmaCreateBufferWithAlignment" "pBufferCreateInfo"
+                             (BufferCreateInfo a)
+                          -> -- No documentation found for Nested "vmaCreateBufferWithAlignment" "pAllocationCreateInfo"
+                             AllocationCreateInfo
+                          -> -- No documentation found for Nested "vmaCreateBufferWithAlignment" "minAlignment"
+                             ("minAlignment" ::: DeviceSize)
+                          -> io (Buffer, Allocation, AllocationInfo)
+createBufferWithAlignment allocator bufferCreateInfo allocationCreateInfo minAlignment = 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 $ traceAroundEvent "vmaCreateBufferWithAlignment" ((ffiVmaCreateBufferWithAlignment) (allocator) (forgetExtensions pBufferCreateInfo) pAllocationCreateInfo (minAlignment) (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)
+
+
 foreign import ccall
 #if !defined(SAFE_FOREIGN_CALLS)
   unsafe
@@ -3052,6 +3092,18 @@ data AllocatorCreateInfo = AllocatorCreateInfo
     -- supported by the current implementation. Leaving it initialized to zero
     -- is equivalent to @VK_API_VERSION_1_0@.
     vulkanApiVersion :: Word32
+  , -- | Either null or a pointer to an array of external memory handle types for
+    -- each Vulkan memory type.
+    --
+    -- If not NULL, it must be a pointer to an array of
+    -- @VkPhysicalDeviceMemoryProperties::memoryTypeCount@ elements, defining
+    -- external memory handle types of particular Vulkan memory type, to be
+    -- passed using @VkExportMemoryAllocateInfoKHR@.
+    --
+    -- Any of the elements may be equal to 0, which means not to use
+    -- @VkExportMemoryAllocateInfoKHR@ on this memory type. This is also the
+    -- default in case of @pTypeExternalMemoryHandleTypes@ = NULL.
+    typeExternalMemoryHandleTypes :: Ptr ExternalMemoryHandleTypeFlagsKHR
   }
   deriving (Typeable)
 #if defined(GENERIC_INSTANCES)
@@ -3060,7 +3112,7 @@ deriving instance Generic (AllocatorCreateInfo)
 deriving instance Show AllocatorCreateInfo
 
 instance ToCStruct AllocatorCreateInfo where
-  withCStruct x f = allocaBytes 96 $ \p -> pokeCStruct p x (f p)
+  withCStruct x f = allocaBytes 104 $ \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)
@@ -3086,8 +3138,9 @@ instance ToCStruct AllocatorCreateInfo where
     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 $ poke ((p `plusPtr` 96 :: Ptr (Ptr ExternalMemoryHandleTypeFlagsKHR))) (typeExternalMemoryHandleTypes)
     lift $ f
-  cStructSize = 96
+  cStructSize = 104
   cStructAlignment = 8
   pokeZeroCStruct p f = do
     poke ((p `plusPtr` 0 :: Ptr AllocatorCreateFlags)) (zero)
@@ -3117,8 +3170,9 @@ instance FromCStruct AllocatorCreateInfo where
     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))
+    pTypeExternalMemoryHandleTypes <- peek @(Ptr ExternalMemoryHandleTypeFlagsKHR) ((p `plusPtr` 96 :: Ptr (Ptr ExternalMemoryHandleTypeFlagsKHR)))
     pure $ AllocatorCreateInfo
-             flags physicalDevice device preferredLargeHeapBlockSize pAllocationCallbacks' pDeviceMemoryCallbacks' frameInUseCount pHeapSizeLimit pVulkanFunctions' pRecordSettings' instance' vulkanApiVersion
+             flags physicalDevice device preferredLargeHeapBlockSize pAllocationCallbacks' pDeviceMemoryCallbacks' frameInUseCount pHeapSizeLimit pVulkanFunctions' pRecordSettings' instance' vulkanApiVersion pTypeExternalMemoryHandleTypes
 
 instance Zero AllocatorCreateInfo where
   zero = AllocatorCreateInfo
@@ -3134,6 +3188,7 @@ instance Zero AllocatorCreateInfo where
            Nothing
            zero
            zero
+           zero
 
 
 -- | VmaAllocatorInfo

VulkanMemoryAllocator/src/lib.cpp

@@ -6,6 +6,14 @@
 #pragma clang diagnostic ignored "-Wnullability-completeness"
 #endif
 
+// To match the vulkan headers this is generated against
+#define VMA_DEDICATED_ALLOCATION 1
+#define VMA_BIND_MEMORY2 1
+#define VMA_MEMORY_BUDGET 1
+#define VMA_BUFFER_DEVICE_ADDRESS 1
+#define VMA_MEMORY_PRIORITY 1
+#define VMA_EXTERNAL_MEMORY 1
+
 #include <vk_mem_alloc.h>
 
 #ifdef __clang__

generate-new/vma/Main.hs

@@ -142,6 +142,7 @@ marshalParams handles =
     getBespokeScheme :: Marshalable a => CName -> a -> Maybe (MarshalScheme a)
     getBespokeScheme p a = case (p, name a) of
       ("VmaAllocatorCreateInfo", "pHeapSizeLimit") -> Just $ Preserve (type' a)
+      ("VmaAllocatorCreateInfo", "pTypeExternalMemoryHandleTypes") -> Just $ Preserve (type' a)
       ("vmaBuildStatsString", "ppStatsString") | Ptr _ p <- type' a ->
         Just $ Returned (Preserve p)
       ("vmaGetPoolName", "ppName") | Ptr _ p <- type' a ->

generate-new/vma/VMA/RenderParams.hs

@@ -200,6 +200,7 @@ vulkanManifest getVar structStyle RenderParams {..} =
                    , "VkDeviceMemory"
                    , "VkDeviceSize"
                    , "VkDevice_T"
+                   , "VkExternalMemoryHandleTypeFlagsKHR"
                    , "VkInstance_T"
                    , "VkMemoryPropertyFlags"
                    , "VkPhysicalDevice_T"