optimize allocations

This commit is contained in:
nek0 2023-04-29 02:10:27 +02:00
parent 744a8ddc55
commit cde6d15245
10 changed files with 182 additions and 268 deletions

View file

@ -55,12 +55,8 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout obj
frames <- V.mapM
(\_ -> do
commandPool <- snd <$> allocate
(Vk.createCommandPool logicalDevice poolCreateInfo Nothing)
(\commandPool -> do
putStrLn "destroying command pool"
Vk.destroyCommandPool logicalDevice commandPool Nothing
)
commandPool <- snd <$>
(Vk.withCommandPool logicalDevice poolCreateInfo Nothing allocate)
let commandBufferAllocationInfo = Vk.zero
{ Vk.commandPool = commandPool
@ -68,7 +64,7 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout obj
, Vk.commandBufferCount = 1
}
commandBuffer <- Vk.allocateCommandBuffers logicalDevice commandBufferAllocationInfo
(_, commandBuffer) <- Vk.withCommandBuffers logicalDevice commandBufferAllocationInfo allocate
let semaphoreCreateInfo = Vk.zero
fenceCreateInfo = Vk.zero
@ -76,19 +72,11 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout obj
} :: Vk.FenceCreateInfo '[]
[presentSemaphore, renderSemaphore] <- replicateM 2
(snd <$> allocate
(Vk.createSemaphore logicalDevice semaphoreCreateInfo Nothing)
(\semaphore -> do
putStrLn "destroying semaphore"
Vk.destroySemaphore logicalDevice semaphore Nothing
)
)
renderFence <- snd <$> allocate
(Vk.createFence logicalDevice fenceCreateInfo Nothing)
(\fence -> do
putStrLn "destroying fence"
Vk.destroyFence logicalDevice fence Nothing
(snd <$>
Vk.withSemaphore logicalDevice semaphoreCreateInfo Nothing allocate
)
renderFence <- snd <$>
Vk.withFence logicalDevice fenceCreateInfo Nothing allocate
cameraBuffer <- createAllocatedBuffer
allocator
@ -207,143 +195,158 @@ recordCommandBuffer
, Vk.inheritanceInfo = Nothing
}
Vk.beginCommandBuffer commandBuffer commandBufferBeginInfo
Vk.useCommandBuffer commandBuffer commandBufferBeginInfo $ do
let renderPassInfo = Vk.zero
{ Vk.renderPass = renderPass
, Vk.framebuffer = frameBuffer
, Vk.renderArea = Vk.Rect2D
{ offset = Vk.Offset2D
{ Vk.x = 0
, Vk.y = 0
}
, extent = Vk.Extent2D
{ Vk.width = fromIntegral width
, Vk.height = fromIntegral height
let renderPassInfo = Vk.zero
{ Vk.renderPass = renderPass
, Vk.framebuffer = frameBuffer
, Vk.renderArea = Vk.Rect2D
{ offset = Vk.Offset2D
{ Vk.x = 0
, Vk.y = 0
}
, extent = Vk.Extent2D
{ Vk.width = fromIntegral width
, Vk.height = fromIntegral height
}
}
, Vk.clearValues = V.fromList
[ Vk.Color (Vk.Float32 0 0 0 1)
, Vk.DepthStencil (Vk.ClearDepthStencilValue 1 0)
]
}
, Vk.clearValues = V.fromList [ Vk.Color (Vk.Float32 0 0 0 1), Vk.DepthStencil (Vk.ClearDepthStencilValue 1 0)]
}
Vk.cmdBeginRenderPass commandBuffer renderPassInfo Vk.SUBPASS_CONTENTS_INLINE
Vk.cmdUseRenderPass commandBuffer renderPassInfo Vk.SUBPASS_CONTENTS_INLINE $ do
Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS graphicsPipeline
liftIO $
prepareRecording width height commandBuffer renderPass frameBuffer graphicsPipeline
let viewport = Vk.zero
{ Vk.x = 0
, Vk.y = 0
, Vk.width = fromIntegral width
, Vk.height = fromIntegral height
, Vk.minDepth = 0
, Vk.maxDepth = 1
}
scissor = Vk.Rect2D
{ Vk.offset = Vk.Offset2D
{ Vk.x = 0
, Vk.y = 0
}
, Vk.extent = Vk.Extent2D
{ Vk.width = fromIntegral width
, Vk.height = fromIntegral height
}
}
Vk.cmdSetViewport commandBuffer 0 (V.singleton viewport)
Vk.cmdSetScissor commandBuffer 0 (V.singleton scissor)
let framed = fromIntegral frameNumber / 120
ambient = normalize $ V4 (sin framed) 0 (cos framed) 1
-- ambient = V4 1 0 1 1
ambientParams = sceneParameters
{ ambientColor = ambient
}
liftIO $ do
let scenePointer = VMA.mappedData (bufferInfo (frameSceneBuffer frame))
liftIO $ poke
(castPtr scenePointer)
ambientParams
renderObjects <- (liftIO . STM.atomically . STM.readTMVar) =<< asks renderables
meshMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary
V.mapM_
(\(index, RenderObject meshID materialID modelMatrix) -> do
let camPosition = V3
(-10 * sin (fromIntegral frameNumber / 90))
(-2)
(-10 * cos (fromIntegral frameNumber / 90))
camCenter = V3 0 0 0
camUp = V3 0 1 0
camView = lookAt camPosition camCenter camUp
camProjection = perspective (pi/4) (fromIntegral width / fromIntegral height) 0.1 200
materialMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks materialLibrary
let cameraData = GPUCameraData
{ view = transpose camView
, projection = transpose camProjection
, viewProjection = transpose $ camProjection !*! camView
let framed = fromIntegral frameNumber / 120
ambient = normalize $ V4 (sin framed) 0 (cos framed) 1
-- ambient = V4 1 0 1 1
ambientParams = sceneParameters
{ ambientColor = ambient
}
constants = MeshPushConstants
{ meshPushData = V4 0 0 0 0
, meshRenderMatrix = transpose modelMatrix
}
mesh = meshMap M.! meshID
material = materialMap M.! materialID
liftIO $ do
let scenePointer = VMA.mappedData (bufferInfo (frameSceneBuffer frame))
liftIO $ VMA.withMappedMemory
allocator
(bufferAllocation $ frameCameraBuffer frame)
bracket
$ \memoryPointer ->
liftIO $ poke
(castPtr scenePointer)
ambientParams
liftIO $ poke (castPtr memoryPointer) cameraData
renderObjects <- (liftIO . STM.atomically . STM.readTMVar) =<< asks renderables
meshMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary
Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS (materialPipeline material)
V.mapM_
(\(index, RenderObject meshID materialID modelMatrix) -> do
Vk.cmdBindDescriptorSets
commandBuffer
Vk.PIPELINE_BIND_POINT_GRAPHICS
(materialPipelineLayout material)
0
(V.singleton $ frameGlobalDescriptor frame)
V.empty
let camPosition = V3
(-10 * sin (fromIntegral frameNumber / 90))
(-2)
(-10 * cos (fromIntegral frameNumber / 90))
camCenter = V3 0 0 0
camUp = V3 0 1 0
camView = lookAt camPosition camCenter camUp
camProjection = perspective
(pi/4)
(fromIntegral width / fromIntegral height)
0.1
200
Vk.cmdBindDescriptorSets
commandBuffer
Vk.PIPELINE_BIND_POINT_GRAPHICS
(materialPipelineLayout material)
1
(V.singleton $ frameObjectDescriptor frame)
V.empty
materialMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks materialLibrary
dataPointer <- liftIO (castPtr <$> new constants)
let cameraData = GPUCameraData
{ view = transpose camView
, projection = transpose camProjection
, viewProjection = transpose $ camProjection !*! camView
}
Vk.cmdPushConstants
commandBuffer
(materialPipelineLayout material)
Vk.SHADER_STAGE_VERTEX_BIT
0
(fromIntegral $ sizeOf constants)
dataPointer
constants = MeshPushConstants
{ meshPushData = V4 0 0 0 0
, meshRenderMatrix = transpose modelMatrix
}
mesh = meshMap M.! meshID
material = materialMap M.! materialID
Vk.cmdBindVertexBuffers
commandBuffer
0
(V.fromList [ allocatedBuffer $ meshBuffer mesh ])
(V.fromList [ 0 ])
liftIO $ VMA.withMappedMemory
allocator
(bufferAllocation $ frameCameraBuffer frame)
bracket
$ \memoryPointer ->
Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices mesh) 1 0 index
)
(V.zip
(V.fromList [0 ..])
renderObjects
)
liftIO $ poke (castPtr memoryPointer) cameraData
Vk.cmdEndRenderPass commandBuffer
Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS (materialPipeline material)
Vk.endCommandBuffer commandBuffer
Vk.cmdBindDescriptorSets
commandBuffer
Vk.PIPELINE_BIND_POINT_GRAPHICS
(materialPipelineLayout material)
0
(V.singleton $ frameGlobalDescriptor frame)
V.empty
Vk.cmdBindDescriptorSets
commandBuffer
Vk.PIPELINE_BIND_POINT_GRAPHICS
(materialPipelineLayout material)
1
(V.singleton $ frameObjectDescriptor frame)
V.empty
dataPointer <- liftIO (castPtr <$> new constants)
Vk.cmdPushConstants
commandBuffer
(materialPipelineLayout material)
Vk.SHADER_STAGE_VERTEX_BIT
0
(fromIntegral $ sizeOf constants)
dataPointer
Vk.cmdBindVertexBuffers
commandBuffer
0
(V.fromList [ allocatedBuffer $ meshBuffer mesh ])
(V.fromList [ 0 ])
Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices mesh) 1 0 index
)
(V.zip
(V.fromList [0 ..])
renderObjects
)
prepareRecording
:: CInt
-> CInt
-> Vk.CommandBuffer
-> Vk.RenderPass
-> Vk.Framebuffer
-> Vk.Pipeline
-> IO ()
prepareRecording width height commandBuffer renderPass frameBuffer graphicsPipeline = do
Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS graphicsPipeline
let viewport = Vk.zero
{ Vk.x = 0
, Vk.y = 0
, Vk.width = fromIntegral width
, Vk.height = fromIntegral height
, Vk.minDepth = 0
, Vk.maxDepth = 1
}
scissor = Vk.Rect2D
{ Vk.offset = Vk.Offset2D
{ Vk.x = 0
, Vk.y = 0
}
, Vk.extent = Vk.Extent2D
{ Vk.width = fromIntegral width
, Vk.height = fromIntegral height
}
}
Vk.cmdSetViewport commandBuffer 0 (V.singleton viewport)
Vk.cmdSetScissor commandBuffer 0 (V.singleton scissor)

View file

@ -106,12 +106,8 @@ createLogicalDevice physDevice surface = do
, Vk.enabledExtensionNames = extensionNames
}
(_, logDevice) <- allocate
(Vk.createDevice physDevice deviceCreateInfo Nothing)
(\logDevice -> do
putStrLn "destroying logical device"
Vk.destroyDevice logDevice Nothing
)
(_, logDevice) <-
Vk.withDevice physDevice deviceCreateInfo Nothing allocate
(result, formats) <- Vk.getPhysicalDeviceSurfaceFormatsKHR physDevice surface
unless (result == Vk.SUCCESS) $
@ -166,12 +162,8 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
, Vk.clipped = True
}
swapchain <- snd <$> allocate
(Vk.createSwapchainKHR logicalDevice createInfo Nothing)
(\swapchain -> do
putStrLn "destroying swapchain"
Vk.destroySwapchainKHR logicalDevice swapchain Nothing
)
swapchain <- snd <$>
Vk.withSwapchainKHR logicalDevice createInfo Nothing allocate
let depthImageExtent =
(\(V2 w h) -> Vk.Extent3D (fromIntegral w) (fromIntegral h) 1)
@ -187,12 +179,8 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
, VMA.requiredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT
}
(depthImage, depthAllocation, _) <- snd <$> allocate
(VMA.createImage allocator depthImageInfo depthImageAllocationInfo)
(\(depthImage, depthAllocation, _) -> do
putStrLn "destroying image"
VMA.destroyImage allocator depthImage depthAllocation
)
(depthImage, depthAllocation, _) <- snd <$>
VMA.withImage allocator depthImageInfo depthImageAllocationInfo allocate
let allocatedImage = AllocatedImage depthImage depthAllocation
depthImageView = imageviewCreate
@ -200,12 +188,8 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
Vk.FORMAT_D32_SFLOAT
Vk.IMAGE_ASPECT_DEPTH_BIT
depthImageview <- snd <$> allocate
(Vk.createImageView logicalDevice depthImageView Nothing)
(\depthImageview -> do
putStrLn "destroying image view"
Vk.destroyImageView logicalDevice depthImageview Nothing
)
depthImageview <- snd <$>
Vk.withImageView logicalDevice depthImageView Nothing allocate
return (swapchain, Vk.SurfaceFormatKHR surfaceFormat colorSpace, depthImageview, allocatedImage)
@ -243,11 +227,7 @@ getImageViewHandles swapchain surfaceFormat logicalDevice = do
, layerCount = 1
}
}
snd <$> allocate
(Vk.createImageView logicalDevice createInfo Nothing)
(\imageView -> do
putStrLn "destroying image view"
Vk.destroyImageView logicalDevice imageView Nothing
)
snd <$>
Vk.withImageView logicalDevice createInfo Nothing allocate
)
handles

View file

@ -77,7 +77,6 @@ drawFrame engineData frameNumber = do
V.singleton $ framePresentSemaphore frame
}
-- liftIO $ putStrLn "submitting to queue"
Vk.queueSubmit
(engineQueue engineData)
(V.singleton (Vk.SomeStruct submitInfo))
@ -89,7 +88,6 @@ drawFrame engineData frameNumber = do
, Khr.imageIndices = V.singleton index
}
-- liftIO $ putStrLn "presenting queue"
presentResult <- Khr.queuePresentKHR (engineQueue engineData) presentInfo
unless (presentResult == Vk.SUCCESS) $

View file

@ -39,11 +39,6 @@ createFramebuffer
let createInfo = framebufferCreateInfo
{ Vk.attachments = V.fromList [ imageView, depthImageView ]
} :: Vk.FramebufferCreateInfo '[]
snd <$> allocate
(Vk.createFramebuffer logicalDevice createInfo Nothing)
(\framebuffer -> do
putStrLn "destroying framebuffer"
Vk.destroyFramebuffer logicalDevice framebuffer Nothing
)
snd <$> Vk.withFramebuffer logicalDevice createInfo Nothing allocate
)
swapchainImageViews

View file

@ -49,12 +49,8 @@ loadShader logicalDevice shaderPath stage = do
{ Vk.code = shader
}
snd <$> allocate
(Vk.createShaderModule logicalDevice createInfo Nothing)
(\shaderModule -> do
putStrLn "destroying shader module"
Vk.destroyShaderModule logicalDevice shaderModule Nothing
)
snd <$>
Vk.withShaderModule logicalDevice createInfo Nothing allocate
createRenderPass
:: (MonadResource m)
@ -126,12 +122,8 @@ createRenderPass
, Vk.dependencies = V.fromList [ subpassDependency, subpassDepthDependency ]
} :: Vk.RenderPassCreateInfo '[]
snd <$> allocate
(Vk.createRenderPass logicalDevice renderPassCreateInfo Nothing)
(\renderPass -> do
putStrLn "destroying render pass"
Vk.destroyRenderPass logicalDevice renderPass Nothing
)
snd <$>
Vk.withRenderPass logicalDevice renderPassCreateInfo Nothing allocate
createShaderStageCreateInfo
:: Vk.ShaderStageFlagBits
@ -300,25 +292,18 @@ createGraphicsPipelines
, Vk.basePipelineIndex = -1
}
pipeline <- snd <$> allocate
pipeline <-
(do
(result, pipelines) <- Vk.createGraphicsPipelines
(result, pipelines) <- snd <$> Vk.withGraphicsPipelines
logicalDevice
Vk.NULL_HANDLE
(V.singleton (Vk.SomeStruct pipelineCreateInfo))
Nothing
allocate
unless (result == Vk.SUCCESS) $
error "createGraphicsPipelines: Failed creating pipelines"
return pipelines
)
(\pipelines -> do
V.mapM_
(\pipeline -> do
putStrLn "destroying pipeline"
Vk.destroyPipeline logicalDevice pipeline Nothing
)
pipelines
)
let material = Material (V.head pipeline) pipelineLayout
matLibraryTMVar <- asks materialLibrary
matLibrary <- liftIO $ STM.atomically $ STM.readTMVar matLibraryTMVar
@ -333,7 +318,7 @@ createMeshPipelineLayout
createMeshPipelineLayout logicalDevice layouts = do
let pushConstantRange = Vk.zero
{ Vk.offset = 0
, Vk.size = fromIntegral (sizeOf (undefinedMeshPushConstants))
, Vk.size = fromIntegral (sizeOf undefinedMeshPushConstants)
, Vk.stageFlags = Vk.SHADER_STAGE_VERTEX_BIT
}
pipelineLayoutCreateInfo = Vk.zero
@ -341,9 +326,5 @@ createMeshPipelineLayout logicalDevice layouts = do
, Vk.setLayouts = layouts
}
snd <$> allocate
(Vk.createPipelineLayout logicalDevice pipelineLayoutCreateInfo Nothing)
(\pipelineLayout -> do
putStrLn "destroying pipeline layout"
Vk.destroyPipelineLayout logicalDevice pipelineLayout Nothing
)
snd <$>
Vk.withPipelineLayout logicalDevice pipelineLayoutCreateInfo Nothing allocate

View file

@ -229,25 +229,13 @@ initDescriptors device = do
]
}
(_, descriptorSetLayout1) <- allocate
(Vk.createDescriptorSetLayout device setInfo Nothing)
(\descriptorLayout -> do
putStrLn "destroying descriptor layout"
Vk.destroyDescriptorSetLayout device descriptorLayout Nothing
)
(_, descriptorSetLayout1) <-
Vk.withDescriptorSetLayout device setInfo Nothing allocate
(_, descriptorSetLayout2) <- allocate
(Vk.createDescriptorSetLayout device setInfo2 Nothing)
(\descriptorLayout -> do
putStrLn "destroying descriptor layout"
Vk.destroyDescriptorSetLayout device descriptorLayout Nothing
)
(_, descriptorSetLayout2) <-
Vk.withDescriptorSetLayout device setInfo2 Nothing allocate
(_, descriptorPool) <- allocate
(Vk.createDescriptorPool device poolInfo Nothing)
(\descriptorPoolInfo -> do
putStrLn "destroying descriptor pool"
Vk.destroyDescriptorPool device descriptorPoolInfo Nothing
)
(_, descriptorPool) <-
Vk.withDescriptorPool device poolInfo Nothing allocate
return (descriptorSetLayout1, descriptorSetLayout2, descriptorPool)

View file

@ -32,11 +32,6 @@ createInstance window = do
, Vk.enabledLayerNames = V.singleton "VK_LAYER_KHRONOS_validation"
}
(_, inst) <- allocate
(Vk.createInstance createInfo Nothing)
(\inst -> do
putStrLn "destroying instance"
Vk.destroyInstance inst Nothing
)
(_, inst) <- Vk.withInstance createInfo Nothing allocate
return inst

View file

@ -80,12 +80,8 @@ createBufferView logicalDevice = do
Vk.BUFFER_USAGE_UNIFORM_TEXEL_BUFFER_BIT
, Vk.sharingMode = Vk.SHARING_MODE_EXCLUSIVE
}
buffer <- snd <$> allocate
(Vk.createBuffer logicalDevice bufferCreateInfo Nothing)
(\buffer -> do
putStrLn "destroying buffer"
Vk.destroyBuffer logicalDevice buffer Nothing
)
buffer <- snd <$>
(Vk.withBuffer logicalDevice bufferCreateInfo Nothing allocate)
let bufferViewCreateInfo = Vk.zero
{ Vk.buffer = buffer
@ -94,12 +90,7 @@ createBufferView logicalDevice = do
, Vk.range = Vk.WHOLE_SIZE
}
allocate
(Vk.createBufferView logicalDevice bufferViewCreateInfo Nothing)
(\bufferView -> do
putStrLn "destroying bufferView"
Vk.destroyBufferView logicalDevice bufferView Nothing
)
Vk.withBufferView logicalDevice bufferViewCreateInfo Nothing allocate
allocateMemory
:: (MonadResource m)
@ -114,9 +105,4 @@ allocateMemory logicalDevice buffer = do
, Vk.memoryTypeIndex = error ("createBuffer: TODO: populate memoryTypeIndex!" :: String)
}
allocate
(Vk.allocateMemory logicalDevice memoryAllocateInfo Nothing)
(\memory -> do
putStrLn "Freeing memory"
Vk.freeMemory logicalDevice memory Nothing
)
Vk.withMemory logicalDevice memoryAllocateInfo Nothing allocate

View file

@ -68,11 +68,7 @@ createAllocatedBuffer allocator allocationSize usage memoryUsage = do
, VMA.preferredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT
} :: VMA.AllocationCreateInfo
(_, (buffer, newAllocation, info)) <- allocate
(VMA.createBuffer allocator bufferCreateInfo vmaAllocationInfo)
(\(buffer, newAllocation, _) -> do
putStrLn "destroying buffer"
VMA.destroyBuffer allocator buffer newAllocation
)
(_, (buffer, newAllocation, info)) <-
VMA.withBuffer allocator bufferCreateInfo vmaAllocationInfo allocate
return $ AllocatedBuffer buffer newAllocation info

View file

@ -62,21 +62,13 @@ uploadMesh vertices allocator = do
allocationCreateInfo = Vk.zero
{ VMA.usage = VMA.MEMORY_USAGE_CPU_TO_GPU
} :: VMA.AllocationCreateInfo
(_, mesh) <- allocate
(do
(buffer, bAllocation, bInfo) <- VMA.createBuffer allocator bufferCreateInfo allocationCreateInfo
mesh <- do
(buffer, bAllocation, bInfo) <- snd <$>
VMA.withBuffer allocator bufferCreateInfo allocationCreateInfo allocate
return (Mesh vertices (AllocatedBuffer buffer bAllocation bInfo))
)
(\(Mesh _ (AllocatedBuffer buffer bAllocation _)) -> do
putStrLn "destroying mesh"
VMA.destroyBuffer allocator buffer bAllocation
)
(dataReleaseKey, dataPtr) <- allocate
(VMA.mapMemory allocator (bufferAllocation $ meshBuffer mesh))
(\_ -> do
VMA.unmapMemory allocator (bufferAllocation $ meshBuffer mesh)
)
(dataReleaseKey, dataPtr) <-
VMA.withMappedMemory allocator (bufferAllocation $ meshBuffer mesh) allocate
liftIO $ mapM_ (\(idx, vertex) ->
poke (castPtr (dataPtr `plusPtr` (idx * sizeOf vertex))) vertex