diff --git a/gpu-vulkan.cabal b/gpu-vulkan.cabal --- a/gpu-vulkan.cabal +++ b/gpu-vulkan.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: gpu-vulkan -version: 0.1.0.159 +version: 0.1.0.160 synopsis: Vulkan library description: Please see the README on GitHub at category: GPU diff --git a/src/Gpu/Vulkan.hs b/src/Gpu/Vulkan.hs --- a/src/Gpu/Vulkan.hs +++ b/src/Gpu/Vulkan.hs @@ -82,6 +82,8 @@ Size(..), + DependencyInfo(..), + -- * ENUM module Gpu.Vulkan.Enum, diff --git a/src/Gpu/Vulkan/Buffer.hs b/src/Gpu/Vulkan/Buffer.hs --- a/src/Gpu/Vulkan/Buffer.hs +++ b/src/Gpu/Vulkan/Buffer.hs @@ -32,6 +32,7 @@ -- * MEMORY BARRIER MemoryBarrier(..), MemoryBarrierListToMiddle, + MemoryBarrier2(..), MemoryBarrier2ListToMiddle, -- * UNSAFE diff --git a/src/Gpu/Vulkan/Buffer/Internal.hs b/src/Gpu/Vulkan/Buffer/Internal.hs --- a/src/Gpu/Vulkan/Buffer/Internal.hs +++ b/src/Gpu/Vulkan/Buffer/Internal.hs @@ -37,6 +37,7 @@ -- * MEMORY BARRIER MemoryBarrier(..), MemoryBarrierListToMiddle(..), + MemoryBarrier2(..), MemoryBarrier2ListToMiddle(..), -- * UNSAFE @@ -78,6 +79,8 @@ import Control.Concurrent.STM.TSem import Data.Map qualified as Map +import qualified Gpu.Vulkan.Pipeline as Pipeline + data CreateInfo mn objs = CreateInfo { createInfoNext :: TMaybe.M mn, createInfoFlags :: CreateFlags, @@ -326,20 +329,18 @@ MemoryBarrier n sm sb nm obj -> M.MemoryBarrier n memoryBarrierToMiddle MemoryBarrier { memoryBarrierNext = mnxt, - memoryBarrierSrcAccessMask = sam, - memoryBarrierDstAccessMask = dam, + memoryBarrierSrcAccessMask = sam, memoryBarrierDstAccessMask = dam, memoryBarrierSrcQueueFamilyIndex = sqfi, memoryBarrierDstQueueFamilyIndex = dqfi, - memoryBarrierBuffer = Binded lns b :: Binded sm sb nm objs } = - M.MemoryBarrier { - M.memoryBarrierNext = mnxt, - M.memoryBarrierSrcAccessMask = sam, - M.memoryBarrierDstAccessMask = dam, - M.memoryBarrierSrcQueueFamilyIndex = sqfi, - M.memoryBarrierDstQueueFamilyIndex = dqfi, - M.memoryBarrierBuffer = b, - M.memoryBarrierOffset = ost, - M.memoryBarrierSize = sz } + memoryBarrierBuffer = Binded lns b } = M.MemoryBarrier { + M.memoryBarrierNext = mnxt, + M.memoryBarrierSrcAccessMask = sam, + M.memoryBarrierDstAccessMask = dam, + M.memoryBarrierSrcQueueFamilyIndex = sqfi, + M.memoryBarrierDstQueueFamilyIndex = dqfi, + M.memoryBarrierBuffer = b, + M.memoryBarrierOffset = ost, + M.memoryBarrierSize = sz } where (ost, sz) = VObj.offsetRange @obj @_ @0 0 lns class MemoryBarrierListToMiddle nsmsbnmobjs where @@ -354,6 +355,49 @@ MemoryBarrierListToMiddle ('(mn, sm, sb, nm, obj) ': nsmsbnmobjs) where memoryBarrierListToMiddle (U5 mb :** mbs) = memoryBarrierToMiddle mb :** memoryBarrierListToMiddle mbs + +data MemoryBarrier2 mn sm sb nm obj = forall objs . ( + VObj.OffsetRange obj objs 0, VObj.LengthOf obj objs ) => + MemoryBarrier2 { + memoryBarrier2Next :: TMaybe.M mn, + memoryBarrier2SrcStageMask :: Pipeline.StageFlags2, + memoryBarrier2SrcAccessMask :: AccessFlags2, + memoryBarrier2DstStageMask :: Pipeline.StageFlags2, + memoryBarrier2DstAccessMask :: AccessFlags2, + memoryBarrier2SrcQueueFamilyIndex :: QueueFamily.Index, + memoryBarrier2DstQueueFamilyIndex :: QueueFamily.Index, + memoryBarrier2Buffer :: Binded sm sb nm objs } + +memoryBarrier2ToMiddle :: forall mn sm sb nm obj . + MemoryBarrier2 mn sm sb nm obj -> M.MemoryBarrier2 mn +memoryBarrier2ToMiddle MemoryBarrier2 { + memoryBarrier2Next = mnxt, + memoryBarrier2SrcStageMask = ssm, memoryBarrier2SrcAccessMask = sam, + memoryBarrier2DstStageMask = dsm, memoryBarrier2DstAccessMask = dam, + memoryBarrier2SrcQueueFamilyIndex = sqfi, + memoryBarrier2DstQueueFamilyIndex = dqfi, + memoryBarrier2Buffer = Binded lns b } = M.MemoryBarrier2 { + M.memoryBarrier2Next = mnxt, + M.memoryBarrier2SrcStageMask = ssm, M.memoryBarrier2SrcAccessMask = sam, + M.memoryBarrier2DstStageMask = dsm, M.memoryBarrier2DstAccessMask = dam, + M.memoryBarrier2SrcQueueFamilyIndex = sqfi, + M.memoryBarrier2DstQueueFamilyIndex = dqfi, + M.memoryBarrier2Buffer = b, + M.memoryBarrier2Offset = ost, M.memoryBarrier2Size = sz } + where (ost, sz) = VObj.offsetRange @obj @_ @0 0 lns + +class MemoryBarrier2ListToMiddle nsmsbnmobjs where + memoryBarrier2ListToMiddle :: + HeteroParList.PL (U5 MemoryBarrier2) nsmsbnmobjs -> + HeteroParList.PL M.MemoryBarrier2 (TMapIndex.M0_5 nsmsbnmobjs) + +instance MemoryBarrier2ListToMiddle '[] where + memoryBarrier2ListToMiddle HeteroParList.Nil = HeteroParList.Nil + +instance MemoryBarrier2ListToMiddle nsmsbnmobjs => + MemoryBarrier2ListToMiddle ('(mn, sm, sb, nm, obj) ': nsmsbnmobjs) where + memoryBarrier2ListToMiddle (U5 mb :** mbs) = + memoryBarrier2ToMiddle mb :** memoryBarrier2ListToMiddle mbs data ImageCopy img inm = ImageCopy { imageCopyImageSubresource :: Image.M.SubresourceLayers, diff --git a/src/Gpu/Vulkan/Buffer/Internal.hs-boot b/src/Gpu/Vulkan/Buffer/Internal.hs-boot new file mode 100644 --- /dev/null +++ b/src/Gpu/Vulkan/Buffer/Internal.hs-boot @@ -0,0 +1,25 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RoleAnnotations #-} +{-# OPTIONS_GHC -Wall -fno-warn-tabs #-} + +module Gpu.Vulkan.Buffer.Internal where + +import GHC.TypeLits +import Data.Kind +import Data.TypeLevel.Tuple.Uncurry +import Data.TypeLevel.Tuple.MapIndex qualified as TMapIndex +import Data.HeteroParList qualified as HPList + +import Gpu.Vulkan.Object qualified as VObj +import Gpu.Vulkan.Buffer.Middle qualified as M + +type role MemoryBarrier2 nominal phantom phantom phantom nominal +data MemoryBarrier2 + (mn :: Maybe Type) sm sb (nm :: Symbol) (obj :: VObj.O) + +class MemoryBarrier2ListToMiddle nsmsbnmobjs where + memoryBarrier2ListToMiddle :: + HPList.PL (U5 MemoryBarrier2) nsmsbnmobjs -> + HPList.PL M.MemoryBarrier2 (TMapIndex.M0_5 nsmsbnmobjs) diff --git a/src/Gpu/Vulkan/Cmd.hs b/src/Gpu/Vulkan/Cmd.hs --- a/src/Gpu/Vulkan/Cmd.hs +++ b/src/Gpu/Vulkan/Cmd.hs @@ -43,7 +43,7 @@ -- * MEMORY DEPENDENCY -pipelineBarrier, +pipelineBarrier, pipelineBarrier2, -- * QUERY @@ -66,12 +66,14 @@ import Data.TypeLevel.Tuple.Uncurry import Data.TypeLevel.Tuple.Index qualified as TIndex import Data.TypeLevel.Tuple.MapIndex qualified as TMapIndex +import qualified Data.HeteroParList as HPList import qualified Data.HeteroParList as HeteroParList import Data.HeteroParList (pattern (:**)) import Data.Word import Data.Int import Gpu.Vulkan +import Gpu.Vulkan.Internal import Gpu.Vulkan.TypeEnum qualified as T import qualified Gpu.Vulkan.CommandBuffer as CommandBuffer @@ -290,6 +292,19 @@ M.pipelineBarrier cb ssm dsm dfs mbs (Bffr.I.memoryBarrierListToMiddle bmbs) (Image.I.memoryBarrierListToMiddle imbs) + +pipelineBarrier2 :: ( + WithPoked (TMaybe.M mn), + HPList.ToListWithCCpsM' WithPoked TMaybe.M mbas, Length mbas, + HPList.ToListWithCCpsM' WithPoked TMaybe.M (TMapIndex.M0_5 bmbas), + Length (TMapIndex.M0_5 bmbas), + HPList.ToListWithCCpsM' WithPoked TMaybe.M (TMapIndex.M0_5 imbas), + Length (TMapIndex.M0_5 imbas), + Bffr.I.MemoryBarrier2ListToMiddle bmbas, + Image.I.MemoryBarrier2ListToMiddle imbas ) => + CommandBuffer.C scb -> DependencyInfo mn mbas bmbas imbas -> IO () +pipelineBarrier2 (CommandBuffer.T.C cb) di = + M.pipelineBarrier2 cb $ dependencyInfoToMiddle di copyBufferToImage :: forall (algn :: Nat) img inms scb smb sbb bnm objs smi si inm . diff --git a/src/Gpu/Vulkan/Image.hs b/src/Gpu/Vulkan/Image.hs --- a/src/Gpu/Vulkan/Image.hs +++ b/src/Gpu/Vulkan/Image.hs @@ -25,7 +25,9 @@ -- * MEMORY BARRIER - MemoryBarrier(..), SubresourceRange(..), MemoryBarrierListToMiddle, + MemoryBarrier(..), MemoryBarrierListToMiddle, + MemoryBarrier2(..), MemoryBarrier2ListToMiddle, + SubresourceRange(..), -- * BLIT diff --git a/src/Gpu/Vulkan/Image/Internal.hs b/src/Gpu/Vulkan/Image/Internal.hs --- a/src/Gpu/Vulkan/Image/Internal.hs +++ b/src/Gpu/Vulkan/Image/Internal.hs @@ -26,8 +26,9 @@ -- * MEMORY BARRIER - MemoryBarrier(..), M.SubresourceRange(..), - MemoryBarrierListToMiddle(..), + MemoryBarrier(..), MemoryBarrierListToMiddle(..), + MemoryBarrier2(..), MemoryBarrier2ListToMiddle(..), + M.SubresourceRange(..), -- * BLIT @@ -48,6 +49,7 @@ import Data.TypeLevel.Tuple.MapIndex qualified as TMapIndex import Data.TypeLevel.Maybe qualified as TMaybe import Data.TypeLevel.ParMaybe qualified as TPMaybe +import qualified Data.HeteroParList as HPList import qualified Data.HeteroParList as HeteroParList import Data.HeteroParList (pattern (:**)) import Data.Word @@ -67,6 +69,8 @@ import qualified Gpu.Vulkan.Sample.Enum as Sample import qualified Gpu.Vulkan.Image.Enum as I +import qualified Gpu.Vulkan.Pipeline as Pipeline + create :: ( WithPoked (TMaybe.M mn), T.FormatToValue fmt, AllocationCallbacks.ToMiddle mac ) => @@ -176,6 +180,57 @@ MemoryBarrierListToMiddle ('(mn, si, sm, nm, fmt) ': mbargs) where memoryBarrierListToMiddle (U5 mb :** mbs) = memoryBarrierToMiddle mb :** memoryBarrierListToMiddle mbs + +data MemoryBarrier2 mn sm si nm fmt = MemoryBarrier2 { + memoryBarrier2Next :: TMaybe.M mn, + memoryBarrier2SrcStageMask :: Pipeline.StageFlags2, + memoryBarrier2SrcAccessMask :: AccessFlags2, + memoryBarrier2DstStageMask :: Pipeline.StageFlags2, + memoryBarrier2DstAccessMask :: AccessFlags2, + memoryBarrier2OldLayout :: Layout, memoryBarrier2NewLayout :: Layout, + memoryBarrier2SrcQueueFamilyIndex :: QueueFamily.Index, + memoryBarrier2DstQueueFamilyIndex :: QueueFamily.Index, + memoryBarrier2Image :: Binded sm si nm fmt, + memoryBarrier2SubresourceRange :: M.SubresourceRange } + +memoryBarrier2ToMiddle :: MemoryBarrier2 mn si sm nm fmt -> M.MemoryBarrier2 mn +memoryBarrier2ToMiddle MemoryBarrier2 { + memoryBarrier2Next = mnxt, + memoryBarrier2SrcStageMask = ssm, + memoryBarrier2SrcAccessMask = sam, + memoryBarrier2DstStageMask = dsm, + memoryBarrier2DstAccessMask = dam, + memoryBarrier2OldLayout = ol, + memoryBarrier2NewLayout = nl, + memoryBarrier2SrcQueueFamilyIndex = sqfi, + memoryBarrier2DstQueueFamilyIndex = dqfi, + memoryBarrier2Image = Binded img, + memoryBarrier2SubresourceRange = srr } = M.MemoryBarrier2 { + M.memoryBarrier2Next = mnxt, + M.memoryBarrier2SrcStageMask = ssm, + M.memoryBarrier2SrcAccessMask = sam, + M.memoryBarrier2DstStageMask = dsm, + M.memoryBarrier2DstAccessMask = dam, + M.memoryBarrier2OldLayout = ol, + M.memoryBarrier2NewLayout = nl, + M.memoryBarrier2SrcQueueFamilyIndex = sqfi, + M.memoryBarrier2DstQueueFamilyIndex = dqfi, + M.memoryBarrier2Image = img, + M.memoryBarrier2SubresourceRange = srr } + +class MemoryBarrier2ListToMiddle + (mbargs :: [(Maybe Type, Type, Type, Symbol, T.Format)]) where + memoryBarrier2ListToMiddle :: + HeteroParList.PL (U5 MemoryBarrier2) mbargs -> + HeteroParList.PL M.MemoryBarrier2 (TMapIndex.M0_5 mbargs) + +instance MemoryBarrier2ListToMiddle '[] where + memoryBarrier2ListToMiddle HPList.Nil = HPList.Nil + +instance MemoryBarrier2ListToMiddle mbargs => + MemoryBarrier2ListToMiddle ('(mn, si, sm, nm, fmt) ': mbargs) where + memoryBarrier2ListToMiddle (U5 mb :** mbs) = + memoryBarrier2ToMiddle mb :** memoryBarrier2ListToMiddle mbs data CreateInfo mn (fmt :: T.Format) = CreateInfo { createInfoNext :: TMaybe.M mn, diff --git a/src/Gpu/Vulkan/Internal.hs b/src/Gpu/Vulkan/Internal.hs --- a/src/Gpu/Vulkan/Internal.hs +++ b/src/Gpu/Vulkan/Internal.hs @@ -80,24 +80,33 @@ -- * OTHERS - M.Size(..) + M.Size(..), + DependencyInfo(..), dependencyInfoToMiddle + ) where import Foreign.Storable.PeekPoke import Data.Kind import Data.TypeLevel.Maybe qualified as TMaybe import Data.TypeLevel.Tuple.Uncurry +import Data.TypeLevel.Tuple.MapIndex qualified as TMapIndex import Data.HeteroParList qualified as HeteroParList +import Data.HeteroParList qualified as HPList import Data.HeteroParList (pattern (:**)) import Data.Text qualified as T import qualified Gpu.Vulkan.Middle as M +import Gpu.Vulkan.Enum import qualified Gpu.Vulkan.Semaphore.Type as Semaphore import qualified Gpu.Vulkan.Semaphore.Middle as Semaphore.M import qualified Gpu.Vulkan.CommandBuffer.Type as CommandBuffer import qualified Gpu.Vulkan.Pipeline.Enum as Pipeline +import Gpu.Vulkan.Memory.Middle qualified as Memory.M +import {-# SOURCE #-} Gpu.Vulkan.Buffer.Internal qualified as Buffer +import Gpu.Vulkan.Image.Internal qualified as Image + data SubmitInfo n sss ss ssss = SubmitInfo { submitInfoNext :: TMaybe.M n, submitInfoWaitSemaphoreDstStageMasks :: @@ -200,3 +209,32 @@ layerKhronosValidation :: LayerName layerKhronosValidation = LayerName "VK_LAYER_KHRONOS_validation" + +data DependencyInfo mn mbas bmbas imbas = DependencyInfo { + dependencyInfoNext :: TMaybe.M mn, + dependencyInfoDependencyFlags :: DependencyFlags, + dependencyInfoMemoryBarriers :: HPList.PL Memory.M.Barrier2 mbas, + dependencyInfoBufferMemoryBarriers :: + HPList.PL (U5 Buffer.MemoryBarrier2) bmbas, + dependencyInfoImageMemoryBarriers :: + HPList.PL (U5 Image.MemoryBarrier2) imbas } + +dependencyInfoToMiddle :: ( + Buffer.MemoryBarrier2ListToMiddle bmbas, + Image.MemoryBarrier2ListToMiddle imbas ) => + DependencyInfo mn mbas bmbas imbas -> + M.DependencyInfo mn mbas (TMapIndex.M0_5 bmbas) (TMapIndex.M0_5 imbas) +dependencyInfoToMiddle DependencyInfo { + dependencyInfoNext = mnxt, + dependencyInfoDependencyFlags = fs, + dependencyInfoMemoryBarriers = mbs, + dependencyInfoBufferMemoryBarriers = bmbs, + dependencyInfoImageMemoryBarriers = imbs + } = M.DependencyInfo { + M.dependencyInfoNext = mnxt, + M.dependencyInfoDependencyFlags = fs, + M.dependencyInfoMemoryBarriers = mbs, + M.dependencyInfoBufferMemoryBarriers = + Buffer.memoryBarrier2ListToMiddle bmbs, + M.dependencyInfoImageMemoryBarriers = + Image.memoryBarrier2ListToMiddle imbs } diff --git a/src/Gpu/Vulkan/Memory.hs b/src/Gpu/Vulkan/Memory.hs --- a/src/Gpu/Vulkan/Memory.hs +++ b/src/Gpu/Vulkan/Memory.hs @@ -44,7 +44,7 @@ -- * BARRIER - M.Barrier(..), + M.Barrier(..), M.Barrier2(..), -- * OTHERS