diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright IC Rainbow (c) 2026 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of IC Rainbow nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,47 @@ +# vulkan-utils-framegraph + +Vulkan adapter for the [`fragr`](https://gitlab.com/dpwiz/fragr) frame graph: +resource types whose `preRead` / `preWrite` hooks place `cmdPipelineBarrier` +image transitions automatically, so passes declare *what* they access and the +graph records the barriers. + +`Vulkan.Utils.FrameGraph.Image` provides `ManagedImage` — an image plus a +tracked `ImageState` (layout, stage, access). Declare an access with a `Usage` +(encoded into `Fragr.Flags` via `usageFlags`); the hook diffs the tracked +state against the usage's target and emits the transition, then updates the +tracked state. + +```haskell +import Fragr qualified as FG +import Vulkan.Utils.FrameGraph.Image (ImageDesc (..), Usage (..), newManagedImage, usageFlags) + +offscreen <- newManagedImage image Vk.IMAGE_ASPECT_COLOR_BIT +h <- FG.importResource g "offscreen" (ImageDesc "offscreen") offscreen +h' <- -- in a pass setup: FG.writeWith h (usageFlags ColorAttachment) + -- a later pass: FG.readWith h' (usageFlags SampledFragment) +``` + +`Ctx ManagedImage` is the `CommandBuffer` the barriers record into; run the +graph with `FG.execute g cmdBuffer ()`. + +## Scope + +`ManagedImage` participates as an *imported* resource: the graph tracks its +layout and places barriers but does not own its allocation. Graph-owned +transient images with deferred (frames-in-flight-safe) reclamation are future +work — that needs `FG.executeQueued` + a `RecycleQueue`, since single-queue +`execute` would free a transient during recording, before the GPU has run. + +The layout-diff model inserts a barrier whenever the target `ImageState` +differs from the tracked one, and also for every write access with the state +unchanged (same-state WAW); only read-after-read skips the barrier. + +When consecutive accesses land on different queues the barrier's source scope +is replaced by the destination stage with no access mask: execution ordering +and memory availability must come from the driver's inter-queue semaphore, and +the barrier chains to its wait. Two caveats follow: the submit wait's +`dstStageMask` must cover the consuming usage's stage, and cross-queue-family +access is only supported for CONCURRENT-shared images — no ownership +release/acquire pair is emitted (`PassSync` acquires/releases are dropped by +`recordingBackend`), so an EXCLUSIVE image's contents are undefined on the new +family. diff --git a/package.yaml b/package.yaml new file mode 100644 --- /dev/null +++ b/package.yaml @@ -0,0 +1,58 @@ +name: vulkan-utils-framegraph +version: "0.1.0.0" +synopsis: Vulkan barrier-placement and resource adapter for the fragr frame graph +category: Graphics +maintainer: IC Rainbow +license: BSD-3-Clause +github: haskell-game/vulkan +license-file: LICENSE +extra-source-files: +- README.md +- package.yaml + +library: + source-dirs: src + dependencies: + - base >= 4.16 && <5 + - containers + - fragr + - resourcet + - text + - transformers + - vector + - vulkan >= 3.27 && < 3.28 + - vulkan-utils + +ghc-options: +- -Wall + +default-extensions: +- BlockArguments +- DerivingStrategies +- DuplicateRecordFields +- ImportQualifiedPost +- LambdaCase +- NamedFieldPuns +- NoFieldSelectors +- OverloadedLists +- OverloadedRecordDot +- OverloadedStrings +- RecordWildCards +- ScopedTypeVariables +- StrictData +- TypeApplications +- TypeFamilies + +tests: + vulkan-utils-framegraph-test: + main: Spec.hs + source-dirs: test + dependencies: + - base + - containers + - vector + - vulkan + - vulkan-utils-framegraph + - fragr + - tasty + - tasty-hunit diff --git a/src/Vulkan/Utils/FrameGraph/Aliasing.hs b/src/Vulkan/Utils/FrameGraph/Aliasing.hs new file mode 100644 --- /dev/null +++ b/src/Vulkan/Utils/FrameGraph/Aliasing.hs @@ -0,0 +1,151 @@ +{-| Plan-time memory aliasing for graph-owned transients. + +Two entries whose lifetimes cannot overlap may share one allocation, decided +from the compiled schedule before anything is recorded — no run-time +reclamation, because a backend's @destroyResource@ fires while /recording/, +long before the GPU is done with the memory. + +The raw material is 'FG.EntryInfo.live': each entry's first and last +executing pass, as positions in execution order. Disjoint ranges are +necessary but __not sufficient__, and the gap is the whole point of this +module: positions order the executing passes /globally/, while passes on +different queues run concurrently. Two ranges can be disjoint in position +and still overlap in time. + +So aliasing rides on the schedule's happens-before relation, not on the +positions: entry @a@ may hand its memory to @b@ only if @a@'s last pass +happens-before @b@'s first — same queue (submission order, plus the takeover +barrier), or a timeline wait that transitively orders the two. 'happensBefore' +derives exactly that from the 'FG.PassSync' waits the compiler already emits. + +The caller supplies the compatibility classes (size, alignment, memory type): +'planAliases' only answers "may these share", and returns each group in +takeover order so the backend can seed the newcomer's barrier from its +predecessor's final state. +-} +module Vulkan.Utils.FrameGraph.Aliasing + ( Candidate (..) + , planAliases + , happensBefore + , Schedule + , scheduleOf + ) where + +import Data.List (sortOn) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Vector qualified as V +import Data.Word (Word64) + +import Fragr qualified as FG + +{- | An entry in the running for aliasing: its id and its live range, as +inclusive positions into the executing passes ('FG.EntryInfo.live'). + +Only entries the graph /owns/ belong here — an import's memory is the +caller's whatever its range says ('FG.EntryInfo.imported' tells them apart). +-} +data Candidate = Candidate + { entryId :: Int + , live :: (Int, Int) + } + deriving (Eq, Show) + +{- | The happens-before relation over one run's executing passes, indexed by +position (the same positions 'FG.EntryInfo.live' reports). + +Per pass: the timeline value it signals on its own queue, and a vector clock +of what it has necessarily observed on every queue. +-} +newtype Schedule = Schedule (V.Vector (FG.QueueId, Word64, Map FG.QueueId Word64)) + +{- | Derive the relation from the compiled schedule. + +Takes the executing passes /in execution order/ — the driver's +@mapMaybe (.sync) snapshot.passes@, which is the very list +'FG.EntryInfo.live' indexes. + +Each pass observes its queue predecessor's clock and, for every 'FG.Wait', +the clock of the pass whose signal it waits on; then it stamps its own +signal. Waits carry a watermark value rather than an exact signal, so the +lookup takes the latest signal at or below it. + +A wait can only name a value an earlier pass signalled (a consumer cannot +hold a handle its producer has not yet made), so the lookup always lands. +Were it ever to miss, the clock stays empty and the pass looks ordered after +nothing — fewer aliases, never an unsound one. +-} +scheduleOf :: [FG.PassSync] -> Schedule +scheduleOf syncs = Schedule (V.fromList (reverse clocks)) + where + -- Fold in execution order, carrying: each queue's latest clock, and the + -- clock at each (queue, signalled value) so a wait can look one up. + (_, _, clocks) = foldl step (Map.empty, Map.empty, []) syncs + + step + :: ( Map FG.QueueId (Map FG.QueueId Word64) + , Map (FG.QueueId, Word64) (Map FG.QueueId Word64) + , [(FG.QueueId, Word64, Map FG.QueueId Word64)] + ) + -> FG.PassSync + -> ( Map FG.QueueId (Map FG.QueueId Word64) + , Map (FG.QueueId, Word64) (Map FG.QueueId Word64) + , [(FG.QueueId, Word64, Map FG.QueueId Word64)] + ) + step (latest, atValue, acc) s = + let + inherited = Map.findWithDefault Map.empty s.queue latest + waited = + [ Map.findWithDefault Map.empty (q, v') atValue + | w <- s.waits + , let q = w.queue + , -- the newest signal on q at or below the watermark + Just (v', _) <- [Map.lookupLE (q, w.value) atValue >>= keyOn q] + ] + merged = Map.unionsWith max (inherited : waited) + clock = Map.insertWith max s.queue s.signal merged + in + ( Map.insert s.queue clock latest + , Map.insert (s.queue, s.signal) clock atValue + , (s.queue, s.signal, clock) : acc + ) + + -- lookupLE crosses queue boundaries in the (queue, value) key order; + -- keep it only when it landed on the queue we asked about. + keyOn q ((q', v), c) = if q == q' then Just (v, c) else Nothing + +{- | Does the pass at the first position necessarily complete before the pass +at the second begins? + +True when the second's clock has observed the first's signal — same queue +(submission order), or a wait chain that transitively reaches it. +-} +happensBefore :: Schedule -> Int -> Int -> Bool +happensBefore (Schedule passes) i j + | i == j = False + | otherwise = case (passes V.!? i, passes V.!? j) of + (Just (queue, signal, _), Just (_, _, after)) -> + Map.findWithDefault 0 queue after >= signal + _ -> False + +{- | Pack candidates into groups that may share one allocation. + +The caller has already split them into a compatibility class (same memory +type, and a block big enough for the largest). Within a class, two entries +may share only if the schedule orders one's last pass before the other's +first — 'happensBefore', not merely disjoint positions. + +Each group comes back in takeover order, so the backend can seed a +newcomer's aliasing barrier from its predecessor's final state (its contents +are undefined, but the memory dependency on the previous user is real). +-} +planAliases :: Schedule -> [Candidate] -> [[Candidate]] +planAliases sched = foldl place [] . sortOn (fst . (.live)) + where + -- Greedy: first group whose every member is ordered against this one. + place groups c = case break (all (compatible c)) groups of + (before, g : after) -> before <> ((g <> [c]) : after) + (before, []) -> before <> [[c]] + + compatible c m = ordered m c || ordered c m + ordered x y = happensBefore sched (snd x.live) (fst y.live) diff --git a/src/Vulkan/Utils/FrameGraph/Buffer.hs b/src/Vulkan/Utils/FrameGraph/Buffer.hs new file mode 100644 --- /dev/null +++ b/src/Vulkan/Utils/FrameGraph/Buffer.hs @@ -0,0 +1,412 @@ +{-| A 'FG.Resource' for Vulkan buffers that places memory barriers automatically. + +The buffer sibling of "Vulkan.Utils.FrameGraph.Image": a 'ManagedBuffer' +carries the buffer plus its tracked 'BufferState' (stage, access — buffers +have no layout), a pass declares an access with a 'Usage', and the hooks diff +the tracked state against the usage's target and queue a +@VkBufferMemoryBarrier@ into the 'Recorder''s per-pass batch. Barriers cover +the whole buffer; queue hops chain to the driver's semaphore exactly as the +image adapter's do (and cross-family access likewise needs CONCURRENT +sharing). + +Import-only: the graph tracks the state and places barriers but does not own +the allocation. +-} +module Vulkan.Utils.FrameGraph.Buffer + ( ManagedBuffer (..) + , newManagedBuffer + , BufferDesc (..) + , importManagedBuffer + , importScratchBuffer + , importOwnedBuffer + , describedAs + , sharedAcrossQueues + , BufferState (..) + , freshState + , Usage (..) + , usageState + , transitionBufferTo + , transitionBuffersTo + , queueTransition + , transferOwnership + ) where + +import Control.Monad (foldM, unless, when) +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Bits ((.&.), (.|.)) +import Data.Foldable (traverse_) +import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.Maybe (fromMaybe, isNothing) +import Data.Text (Text) +import Data.Vector qualified as V + +import Fragr qualified as FG +import Vulkan.CStruct.Extends (SomeStruct (..)) +import Vulkan.Core10 qualified as Vk +import Vulkan.Utils.FrameGraph.Recorder (Accessor (..), Recorder, TransferSide (..), chainedNode, flushBarriers, markChained, queueBufferBarrier, recorderFamily, recorderHost, recorderQueue, recorderSameFamily) +import Vulkan.Zero (zero) + +-- | A buffer whose stage/access the frame graph tracks and barriers. +data ManagedBuffer = ManagedBuffer + { buffer :: Vk.Buffer + , stateRef :: IORef BufferState + , queueRef :: IORef (Maybe FG.QueueId) + -- ^ The device queue that last accessed it; 'Nothing' until one has. + , releasedRef :: IORef (Maybe BufferState) + {- ^ The state a pending ownership release saw, so the acquiring half can + build the barrier that matches it exactly. + -} + , shared :: Bool + {- ^ The allocation is @SHARING_MODE_CONCURRENT@ across the families the + graph uses it on ('sharedAcrossQueues'). An unmarked resource accessed + across queues is fatal: no ownership transfer is emitted, so its contents + would be undefined on the new family. + -} + , info :: Text + -- ^ Human-readable summary shown by visualization output; attach with 'describedAs'. + } + +-- | Wrap a buffer, starting from 'freshState'. +{-# INLINE newManagedBuffer #-} +newManagedBuffer :: (MonadIO m) => Vk.Buffer -> m ManagedBuffer +newManagedBuffer buffer = liftIO do + stateRef <- newIORef freshState + queueRef <- newIORef Nothing + releasedRef <- newIORef Nothing + pure ManagedBuffer{releasedRef, buffer, stateRef, queueRef, shared = False, info = ""} + +-- | Attach a summary shown next to the resource's name in visualization output. +describedAs :: Text -> ManagedBuffer -> ManagedBuffer +describedAs t mb = mb{info = t} + +{- | Mark the allocation as @SHARING_MODE_CONCURRENT@ across the families it +is used on. + +Required before any cross-family access the graph cannot transfer +ownership for: an @EXCLUSIVE@ resource's contents are undefined on the new +family, so crossing without this is fatal, not silent. Apply before +importing — imports read it through 'FG.isShared', exempting the buffer +from the schedule's single-owner validation. +-} +sharedAcrossQueues :: ManagedBuffer -> ManagedBuffer +sharedAcrossQueues mb = mb{shared = True} + +instance FG.Resource ManagedBuffer where + type Desc ManagedBuffer = BufferDesc + type Alloc ManagedBuffer = () + type Ctx ManagedBuffer = Recorder + type Flags ManagedBuffer = Usage + + createResource _ _ = + error "ManagedBuffer is import-only: allocate the buffer and use importResource" + + destroyResource _ _ _ = pure () + + preRead h _ usage rec mb = queueTransition rec (FG.handleId h) mb usage + preWrite h _ usage rec mb = queueTransition rec (FG.handleId h) mb usage + + -- The two halves of a cross-queue hand-off, as in the image adapter. + preRelease h _ usage peer rec mb = transferOwnership Release rec (FG.handleId h) peer mb usage + preAcquire h _ usage peer rec mb = transferOwnership Acquire rec (FG.handleId h) peer mb usage + + isShared mb = mb.shared + + describeDesc d = d.info + +-- | The synchronization state a buffer's last access left it in. +data BufferState = BufferState + { stage :: Vk.PipelineStageFlags + , access :: Vk.AccessFlags + } + deriving stock (Eq, Show) + +{- | Never accessed on the device since the last host-synchronized point (a +fence-waited setup submit): top of pipe, no access to make available. +-} +freshState :: BufferState +freshState = BufferState Vk.PIPELINE_STAGE_TOP_OF_PIPE_BIT zero + +-- | How a pass uses a buffer, i.e. the 'BufferState' it must be in for that access. +data Usage + = -- | @vkCmdDraw*Indirect@ / @vkCmdDispatchIndirect@ command source. + IndirectRead + | TransferSrc + | TransferDst + | -- | Storage read/write in the given shader stage (compute, vertex, …). + StorageRead Vk.PipelineStageFlags + | StorageWrite Vk.PipelineStageFlags + | -- | Read-modify-write storage access (atomics). + StorageReadWrite Vk.PipelineStageFlags + | -- | Read by the host, after the schedule's timeline wait reaches it. + HostRead + | -- | Written by the host (a mapped upload) before device consumers. + HostWrite + deriving stock (Eq, Ord, Show) + +-- | The target state each 'Usage' requires. +usageState :: Usage -> BufferState +usageState = \case + IndirectRead -> BufferState Vk.PIPELINE_STAGE_DRAW_INDIRECT_BIT Vk.ACCESS_INDIRECT_COMMAND_READ_BIT + TransferSrc -> BufferState Vk.PIPELINE_STAGE_TRANSFER_BIT Vk.ACCESS_TRANSFER_READ_BIT + TransferDst -> BufferState Vk.PIPELINE_STAGE_TRANSFER_BIT Vk.ACCESS_TRANSFER_WRITE_BIT + StorageRead stage -> BufferState stage Vk.ACCESS_SHADER_READ_BIT + StorageWrite stage -> BufferState stage Vk.ACCESS_SHADER_WRITE_BIT + StorageReadWrite stage -> BufferState stage (Vk.ACCESS_SHADER_READ_BIT .|. Vk.ACCESS_SHADER_WRITE_BIT) + HostRead -> BufferState Vk.PIPELINE_STAGE_HOST_BIT Vk.ACCESS_HOST_READ_BIT + HostWrite -> BufferState Vk.PIPELINE_STAGE_HOST_BIT Vk.ACCESS_HOST_WRITE_BIT + +{- | Whether the 'Usage' writes the buffer (and so needs a barrier even when the +state is unchanged — only read-after-read can skip it). +-} +usageWrites :: Usage -> Bool +usageWrites = \case + TransferDst -> True + StorageWrite _ -> True + StorageReadWrite _ -> True + HostWrite -> True + IndirectRead -> False + TransferSrc -> False + StorageRead _ -> False + HostRead -> False + +{- | Record the barrier bringing the buffer into the 'Usage''s state and update +the tracked state. Standalone counterpart to the hook path, for barriers +recorded outside a pass; treats the access as same-queue. +-} +transitionBufferTo :: (MonadIO m) => Vk.CommandBuffer -> ManagedBuffer -> Usage -> m () +{-# INLINE transitionBufferTo #-} +transitionBufferTo cb mb usage = transitionBuffersTo cb [(mb, usage)] + +{- | 'transitionBufferTo' over a batch: one @vkCmdPipelineBarrier@, OR-ed stage masks. + +The buffers must be distinct: barriers in one command are unordered, so two +entries for the same buffer would race. +-} +transitionBuffersTo :: (MonadIO m) => Vk.CommandBuffer -> [(ManagedBuffer, Usage)] -> m () +transitionBuffersTo cb accesses = do + (srcs, dsts, barriers) <- foldM collect (zero, zero, []) accesses + unless (null barriers) $ + Vk.cmdPipelineBarrier cb srcs dsts zero [] (V.fromList barriers) [] + where + collect acc@(srcs, dsts, barriers) (mb, usage) = do + lastQueue <- liftIO (readIORef mb.queueRef) + nextTransition (maybe HostAccess DeviceQueue lastQueue) (\_ _ -> True) False mb usage >>= \case + Nothing -> pure acc + Just (src, dst, barrier) -> pure (srcs .|. src, dsts .|. dst, barrier : barriers) + +{- | The hook path: 'transitionBufferTo' rules, but queued and queue-aware. + +Queue hops chain to the driver's semaphore, like the image adapter's: the +prior synchronization's scope must cover the usage's stage. Same-family +queues share freely; crossing to another /family/ needs CONCURRENT sharing +or an ownership acquire this pass performed. +-} +queueTransition :: (MonadIO m) => Recorder -> Int -> ManagedBuffer -> Usage -> m () +queueTransition rec node mb usage = do + queue <- recorderQueue rec + chained0 <- chainedNode rec node + hosted <- recorderHost rec + sameFamily <- recorderSameFamily rec + nextTransition (if hosted then HostAccess else DeviceQueue queue) sameFamily chained0 mb usage >>= traverse_ \(srcStage, dstStage, barrier) -> + queueBufferBarrier rec srcStage dstStage barrier + +{- | The producer- and consumer-side halves of a cross-queue hand-off. + +The image adapter's rules, minus the layout: on a @CONCURRENT@ buffer the +semaphore alone orders the two sides and both halves are no-ops; on an +@EXCLUSIVE@ one they are a real queue-family ownership transfer, the same +barrier recorded in each queue's buffer with both family indices named. +The acquire advances the tracked state and marks the node chained. + +A hand-off to the host is neither: the release carries the full dependency +(a semaphore signal makes device writes available to the device domain +only, so the host half needs a real @HOST@ destination scope), and the +acquire is bookkeeping. +-} +transferOwnership :: (MonadIO m) => TransferSide -> Recorder -> Int -> FG.QueueId -> ManagedBuffer -> Usage -> m () +transferOwnership side rec node peer mb usage = do + hosted <- recorderHost rec + queue <- recorderQueue rec + ourFamily <- recorderFamily rec queue + peerFamily <- recorderFamily rec peer + cur <- liftIO (readIORef mb.stateRef) + released <- liftIO (readIORef mb.releasedRef) + let + next = usageState usage + (srcFamily, dstFamily) = case side of + Release -> (ourFamily, peerFamily) + Acquire -> (peerFamily, ourFamily) + -- The host owns nothing (it is not a family), and a CONCURRENT buffer is + -- owned by no one. + owned = + not mb.shared + && not hosted + && srcFamily /= dstFamily + && srcFamily /= Vk.QUEUE_FAMILY_IGNORED + && dstFamily /= Vk.QUEUE_FAMILY_IGNORED + -- The consumer is the host: only the release's barrier can make the + -- device's writes visible to it (the schedule's timeline wait cannot). + toHost = next.stage .&. Vk.PIPELINE_STAGE_HOST_BIT /= zero + from = case side of + Release -> cur + Acquire -> fromMaybe cur released + barrier = + SomeStruct + zero + { Vk.srcAccessMask = case side of + Release -> from.access + Acquire -> zero + , Vk.dstAccessMask = case side of + Release -> if toHost then next.access else zero + Acquire -> next.access + , Vk.srcQueueFamilyIndex = if owned then srcFamily else Vk.QUEUE_FAMILY_IGNORED + , Vk.dstQueueFamilyIndex = if owned then dstFamily else Vk.QUEUE_FAMILY_IGNORED + , Vk.buffer = mb.buffer + , Vk.offset = 0 + , Vk.size = Vk.WHOLE_SIZE + } + (srcStage, dstStage) = case side of + Release -> (from.stage, if toHost then next.stage else Vk.PIPELINE_STAGE_BOTTOM_OF_PIPE_BIT) + Acquire -> (Vk.PIPELINE_STAGE_TOP_OF_PIPE_BIT, next.stage) + case side of + Release -> do + when (owned || toHost) $ queueBufferBarrier rec srcStage dstStage barrier + liftIO (writeIORef mb.releasedRef (Just cur)) + Acquire -> do + -- An owned acquire without its armed release half would record an + -- unmatched barrier from a guessed state: a schedule bug, not a + -- recoverable condition. + when (owned && isNothing released) $ + error + ( "Vulkan.Utils.FrameGraph: ownership acquire of " + <> show mb.info + <> " without a pending release; the schedule must pair the halves" + ) + when owned $ queueBufferBarrier rec srcStage dstStage barrier + liftIO do + -- The host is not a device queue: recording it as the last one would + -- make the next device access look cross-queue (cf. 'nextTransition'), + -- and the driver defers host passes — a late write here would rewind + -- the device-side tracking. + unless hosted do + writeIORef mb.stateRef next + writeIORef mb.queueRef (Just queue) + -- Only the owned half consumed the hand-off; a melted acquire (host, + -- shared, same family) must leave the slot for a pending owned one. + when owned $ writeIORef mb.releasedRef Nothing + markChained rec node + +{- | Diff the tracked state against the 'Usage''s target and advance it. + +A read whose state differs from the previous one still emits a barrier (the +chain through it is what orders a later write after both reads); only a read +of an already-matching state skips it. +-} +nextTransition + :: (MonadIO m) + => Accessor + -> (FG.QueueId -> FG.QueueId -> Bool) + -- ^ whether two queues belong to one family (share ownership) + -> Bool + -- ^ an ownership acquire already synchronized it ('chainedNode') + -> ManagedBuffer + -> Usage + -> m (Maybe (Vk.PipelineStageFlags, Vk.PipelineStageFlags, SomeStruct Vk.BufferMemoryBarrier)) +nextTransition accessor sameFamily marked mb usage = liftIO do + cur <- readIORef mb.stateRef + lastQueue <- readIORef mb.queueRef + let + next = usageState usage + -- A first access owns nothing yet, and the host is not a queue family (its + -- accesses order through the schedule's timeline and the producer's + -- release barrier), so neither crosses ownership. + crossQueue = case (accessor, lastQueue) of + (DeviceQueue q, Just prev) -> q /= prev + _ -> False + crossFamily = + crossQueue && case (accessor, lastQueue) of + (DeviceQueue q, Just prev) -> not (sameFamily q prev) + _ -> False + -- A cross-queue hop rides the driver's semaphore even within one family. + chained = crossQueue || marked + srcStage = if chained then next.stage else cur.stage + srcAccess = if chained then zero else cur.access + -- Semaphore/event-ordered same-state accesses need no barrier of their + -- own; unchained writes need one even with the state unchanged. + needed = cur /= next || (usageWrites usage && not chained) + -- An unshared (EXCLUSIVE) resource reaching another family without an + -- ownership transfer ('transferOwnership') has undefined contents there. A + -- write that does not read them is still fine — it acquires by discarding + -- them — but a read would see garbage, so it is fatal. + when (crossFamily && not mb.shared && not (usageWrites usage)) $ + error + ( "Vulkan.Utils.FrameGraph: cross-family read of an unshared resource (" + <> show mb.info + <> ") the graph never handed over: it must be produced on the reading family, " + <> "marked 'sharedAcrossQueues' (CONCURRENT), or written by a pass the graph " + <> "can transfer ownership from" + ) + case accessor of + DeviceQueue q -> writeIORef mb.queueRef (Just q) + HostAccess -> pure () + if needed + then do + writeIORef mb.stateRef next + pure $ + Just + ( srcStage + , next.stage + , SomeStruct + zero + { Vk.srcAccessMask = srcAccess + , Vk.dstAccessMask = next.access + , Vk.srcQueueFamilyIndex = Vk.QUEUE_FAMILY_IGNORED + , Vk.dstQueueFamilyIndex = Vk.QUEUE_FAMILY_IGNORED + , Vk.buffer = mb.buffer + , Vk.offset = 0 + , Vk.size = Vk.WHOLE_SIZE + } + ) + else + pure Nothing + +{- | Descriptor for a 'ManagedBuffer'; carries the buffer's 'describedAs' +summary for visualization output (the resource name travels separately). +-} +newtype BufferDesc = BufferDesc {info :: Text} + +{- | Import a 'ManagedBuffer' under @name@, as an observed resource. + +Claims the graph's 'FG.addPreExec slot for 'flushBarriers' like the image +imports do — the adapters share that slot; wrap the flush rather than +replacing it. +-} +importManagedBuffer :: (MonadIO m) => FG.FrameGraph Recorder () -> Text -> ManagedBuffer -> m (FG.Handle ManagedBuffer) +importManagedBuffer graph name mb = do + FG.addPreExec graph flushBarriers + disarmHandOff mb + FG.importResource graph name (BufferDesc mb.info) mb + +-- | 'Vulkan.Utils.FrameGraph.Image.disarmHandOff' for the buffer lane. +disarmHandOff :: (MonadIO m) => ManagedBuffer -> m () +disarmHandOff mb = liftIO (writeIORef mb.releasedRef Nothing) + +-- | 'importManagedBuffer' via 'FG.importScratch', keeping writers subject to demand culling. +importScratchBuffer :: (MonadIO m) => FG.FrameGraph Recorder () -> Text -> ManagedBuffer -> m (FG.Handle ManagedBuffer) +importScratchBuffer graph name mb = do + FG.addPreExec graph flushBarriers + disarmHandOff mb + FG.importScratch graph name (BufferDesc mb.info) mb + +{- | The buffer counterpart of 'Vulkan.Utils.FrameGraph.Image.importOwnedImage': +'FG.importOwned' under the wrapper's tracked last queue, so a cross-family +first touch gets its release / acquire pair across the frame boundary. +-} +importOwnedBuffer :: (MonadIO m) => FG.FrameGraph Recorder () -> Text -> ManagedBuffer -> m (FG.Handle ManagedBuffer) +importOwnedBuffer graph name mb = + liftIO (readIORef mb.queueRef) >>= \case + Nothing -> importManagedBuffer graph name mb + Just owner -> do + FG.addPreExec graph flushBarriers + disarmHandOff mb + FG.importOwned graph name (BufferDesc mb.info) mb owner diff --git a/src/Vulkan/Utils/FrameGraph/Driver.hs b/src/Vulkan/Utils/FrameGraph/Driver.hs new file mode 100644 --- /dev/null +++ b/src/Vulkan/Utils/FrameGraph/Driver.hs @@ -0,0 +1,460 @@ +{-# LANGUAGE DataKinds #-} + +{-| Package-level multi-queue submit driver. + +'submitGraphQueued' turns a compiled graph into one submit per executing +device queue: a one-time primary begun from each queue's pool, cross-queue +ordering realised with per-run timeline semaphores straight off the +schedule — each wait's value from 'FG.Wait' and its stage decoded from the +accesses it protects ('waitStage'), the same stages the resource adapters +chain their cross-queue barriers to. + +The host is just another queue: passes assigned to the designated host +'FG.QueueId' execute on the CPU after the submits, each waiting its +schedule waits on the real timelines and signalling its own — so readbacks +and mapped uploads take part in the same dependency graph, with the +device-side transitions landing producer-side ('FG.preRelease') and the +host-side hooks tracking state without recording ('setRecorderHost'). + +Frame-level synchronization is the caller's and arrives as 'SubmitExtras': +swapchain acquire/present semaphores, frames-in-flight timelines, and any +cross-frame hazard on a resource the graphs share (a previous frame's +still-in-flight read is not a pass the compiler can see). Everything inside +one graph is derived; everything between graphs is an extra. + +Synchronization is timeline semaphores and synchronization2, and nothing +else: submits go through @vkQueueSubmit2@, so a wait carries its value and +its stage in one 'SemaphoreSubmitInfo'. The schedule's split-barrier events +are deliberately not realised as @VkEvent@s — they only ever bought overlap, +and each access already places a self-sufficient barrier. Binary semaphores +survive only where WSI mandates them (acquire/present), as 'SubmitExtras'. + +Cross-queue hand-offs of an @EXCLUSIVE@ resource are realised as queue-family +ownership transfers: the adapters' release and acquire hooks emit the matching +barrier pair, naming the families from this driver's 'QueueSlot's. A +@CONCURRENT@ resource ('sharedAcrossQueues') owns nothing and rides the +semaphore alone. + +Each queue's pass stream is cut into segments at wait boundaries +('planSegments'), one submit per segment, so mid-stream cross-queue +dependencies — device ping-pong, device→host→device round trips — schedule +instead of deadlocking. +-} +module Vulkan.Utils.FrameGraph.Driver + ( submitGraphQueued + , SubmitConfig (..) + , QueueSlot (..) + , submitConfig + , frameSubmitConfig + , Submitted (..) + , waitSubmitted + , waitStage + , accessScopes + ) where + +import Control.Monad (unless, void) +import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.Trans.Resource (MonadResource) +import Data.Bits ((.&.), (.|.)) +import Data.Coerce (coerce) +import Data.Foldable (foldl', for_, toList, traverse_) +import Data.IORef (atomicModifyIORef', modifyIORef', newIORef, readIORef) +import Data.List (partition) +import Data.List.NonEmpty qualified as NE +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Maybe (mapMaybe) +import Data.Sequence qualified as Seq +import Data.Set qualified as Set +import Data.Traversable (for) +import Data.Vector qualified as V +import Data.Word (Word32, Word64) +import Type.Reflection (eqTypeRep, typeRep, type (:~~:) (HRefl)) + +import Fragr qualified as FG +import Vulkan.CStruct.Extends (SomeStruct (..)) +import Vulkan.Core10 qualified as Vk +import Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore (signalSemaphore, waitSemaphoresSafe) +import Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore qualified as SemaphoreSignalInfo (SemaphoreSignalInfo (..)) +import Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore qualified as SemaphoreWaitInfo (SemaphoreWaitInfo (..)) +import Vulkan.Core13.Enums.AccessFlags2 (AccessFlagBits2 (..), AccessFlags2) +import Vulkan.Core13.Enums.PipelineStageFlags2 (PipelineStageFlagBits2 (..), PipelineStageFlags2) +import Vulkan.Core13.Promoted_From_VK_KHR_synchronization2 (SubmitInfo2 (..), queueSubmit2) +import Vulkan.Core13.Promoted_From_VK_KHR_synchronization2 qualified as CommandBufferSubmitInfo (CommandBufferSubmitInfo (..)) +import Vulkan.Core13.Promoted_From_VK_KHR_synchronization2 qualified as SemaphoreSubmitInfo (SemaphoreSubmitInfo (..)) +import Vulkan.Utils.Frame (Frame (..), SubmitExtras (..), allocatePrimary, allocateTimelineSemaphore, frameSubmitExtras, noExtras) +import Vulkan.Utils.FrameGraph.Buffer qualified as Buffer +import Vulkan.Utils.FrameGraph.Image qualified as Image +import Vulkan.Utils.FrameGraph.Recorder (Recorder, clearChained, flushBarriers, newRecorder, setRecorder, setRecorderFamilies, setRecorderHost) +import Vulkan.Zero (zero) + +{- | One queue's completion handle. + +Its per-run timeline reaches @value@ once every pass submitted there has +executed. Feed into frames-in-flight bookkeeping, or block on it with +'waitSubmitted'. +-} +data Submitted = Submitted + { queue :: FG.QueueId + , semaphore :: Vk.Semaphore + , value :: Word64 + } + +{- | The device side of one 'FG.QueueId': where its passes submit, which +family owns their resources, and the pool their buffers come from. +-} +data QueueSlot = QueueSlot + { queue :: Vk.Queue + , family :: Word32 + -- ^ names the sides of an ownership transfer across it + , pool :: Vk.CommandPool + } + +{- | How 'submitGraphQueued' maps a graph onto the device. + +'submitConfig' fills everything but the queue table with inert defaults. + +The queue table maps the graph's 'FG.QueueId's to real queues and the pools +to take this run's one-time command buffers from (reset the pool to reclaim +them, e.g. per frame in flight). @extras@ adds the frame-level waits and +signals — waits on the queue's first segment, signals on its last (ignored +for the host queue, which has no submit to splice into). +-} +data SubmitConfig = SubmitConfig + { device :: Vk.Device + , queues :: FG.QueueId -> QueueSlot + , hostQueue :: Maybe FG.QueueId + -- ^ the host queue: its passes execute on the CPU after the submits + , extras :: FG.QueueId -> SubmitExtras + , register :: [Submitted] -> IO () + {- ^ Called with every queue's completion once the graph is recorded and + before anything is submitted: + wire it to the frame's GPU-work list ('Vulkan.Utils.Frame.fGPUWork') and + reclamation waits the whole graph with no hand-rolled sync — and no race + when a submit fails midway, since a registered-but-never-signalled value + degrades to the recycler's wait timeout instead of reclaiming under + in-flight work. + -} + , deferHost :: Maybe (IO () -> IO ()) + {- ^ Hand the ordered host-pass tail to this runner (e.g. the frame's + deferred work, executed on the recycle thread) instead of executing it + before returning; the caller's thread then never blocks on the GPU. + + A deferred host pass must not gate a presented image: at + @vkQueuePresentKHR@ time every signal the present wait depends on must + already be submitted (VUID 03268), and the deferred signal is not. + Meter/readback sinks are fine; a host pass feeding the swapchain chain + must run inline. + -} + } + +-- | A 'SubmitConfig' with no host queue, no extras, and no completion sink. +submitConfig :: Vk.Device -> (FG.QueueId -> QueueSlot) -> SubmitConfig +submitConfig device queues = + SubmitConfig + { device + , queues + , hostQueue = Nothing + , extras = const noExtras + , register = const (pure ()) + , deferHost = Nothing + } + +{- | A 'SubmitConfig' wired to the frame. + +The canonical frame extras ('frameSubmitExtras') ride 'FG.defaultQueue', +completions register into 'fGPUWork' before anything submits, and the host +tail lands in 'fDeferredWork' — the frame's recycle thread runs it, so the +render thread never blocks on the GPU (mind 'deferHost''s presentation +caveat). Override 'extras' by wrapping the field (it is per-queue) rather +than replacing it. +-} +frameSubmitConfig :: Vk.Device -> Frame rr -> Word32 -> (FG.QueueId -> QueueSlot) -> SubmitConfig +frameSubmitConfig dev f imageIndex queues = + (submitConfig dev queues) + { extras = \q -> if q == FG.defaultQueue then frameSubmitExtras f imageIndex else noExtras + , register = \submitted -> + for_ submitted \s -> + atomicModifyIORef' (fGPUWork f) (\jobs -> ((s.semaphore, s.value) : jobs, ())) + , deferHost = Just (\hostTail -> modifyIORef' (fDeferredWork f) (hostTail :)) + } + +{- | Record a compiled graph and submit it, one submit per segment, then +execute the host queue's passes. + +The per-run timelines live in the current 'MonadResource' scope, so keep it +open until the returned 'Submitted' values are waited on. + +A queue's passes are cut into segments at wait boundaries ('planSegments'), +so mid-stream cross-queue dependencies — device ping-pong, +device→host→device round trips — schedule instead of deadlocking; each +segment's waits hoist to its own front. + +Passes on the designated host queue record nothing: after the device +submits go out, each runs on the calling thread (or the 'deferHost' runner) +— its schedule waits realised as a host timeline wait, its body as plain IO +(peek a readback mapping, write an upload one), its signal as +'signalSemaphore', which already-submitted device work may be waiting on. +The graph must have at least one device pass. +-} +submitGraphQueued + :: (MonadResource m) + => FG.FrameGraph Recorder () + -> SubmitConfig + -> m [Submitted] +submitGraphQueued graph config = do + let + dev = config.device + queueTable = config.queues + hostQueue = config.hostQueue + extras = config.extras + snap <- FG.snapshot graph + let + syncs = mapMaybe (.sync) snap.passes + (hostSyncs, deviceSyncs) = partition (\s -> Just s.queue == hostQueue) syncs + (segments, routes) = planSegments deviceSyncs + case syncs of + [] -> pure [] + _ -> do + segmentSlots <- for segments \seg -> do + let slot = queueTable seg.queue + cb <- allocatePrimary dev slot.pool + pure (seg, slot.queue, cb) + let deviceQids = ordNub [seg.queue | seg <- segments] + timelines <- + Map.fromList <$> for (deviceQids <> ordNub [s.queue | s <- hostSyncs]) \qid -> do + (_, timeline) <- allocateTimelineSemaphore dev 0 + pure (qid, timeline) + buffers <- case NE.nonEmpty [cb | (_, _, cb) <- segmentSlots] of + Nothing -> error "submitGraphQueued: a host-only graph has nothing to submit" + Just ne -> pure ne + let + timelineOf qid = + Map.findWithDefault (error "submitGraphQueued: wait on a queue with no executing pass") qid timelines + -- Indexed: 'cbFor' runs per pass, and the segment list is a list. + slotsV = V.fromList segmentSlots + cbFor pid = case Map.lookup pid routes of + Just ix -> let (_, _, cb) = slotsV V.! ix in cb + Nothing -> error "submitGraphQueued: pass outside the planned schedule" + + let + deviceDone = + [ Submitted{queue = qid, semaphore = timelineOf qid, value = v} + | qid <- deviceQids + , let v = maximum [seg.signal | seg <- segments, seg.queue == qid] + ] + hostDone = + [ Submitted{queue = qid, semaphore = timelineOf qid, value = v} + | qid <- ordNub [s.queue | s <- hostSyncs] + , let v = maximum [s.signal | s <- hostSyncs, s.queue == qid] + ] + done = deviceDone <> hostDone + + recorder <- newRecorder (NE.head buffers) + -- The families an ownership transfer names its two sides from; the host + -- queue is not a family and owns nothing. + setRecorderFamilies recorder \q -> + if Just q == hostQueue then Vk.QUEUE_FAMILY_IGNORED else + -- GHC 9.2 can't parse ".family" (special identifier) + let QueueSlot{family} = queueTable q in family + deferredRef <- liftIO (newIORef []) + FG.addPreExec graph flushBarriers + -- The release hooks queue producer-side barriers after the pass body. + FG.addPostExec graph flushBarriers + let backend = + FG.QueueBackend + { FG.beforePass = \psync -> + if Just psync.queue == hostQueue + then setRecorderHost recorder psync.queue + else do + setRecorder recorder psync.queue (cbFor psync.passId) + -- Only an ownership acquire chains a node ('markChained'); + -- clear it, or a stale mark suppresses a later pass's barrier. + clearChained recorder + , FG.afterPass = \_psync -> pure () + , FG.invoke = \psync body -> + if Just psync.queue == hostQueue + then modifyIORef' deferredRef ((psync, body) :) + else body + , FG.completed = pure [] + } + FG.executeQueued graph backend Nothing recorder () + traverse_ Vk.endCommandBuffer buffers + + -- Recorded, nothing submitted yet: registering here means a failure while + -- recording never leaves the recycler waiting on timelines the unwinding + -- scope destroys, while a submit failing midway still only costs it the + -- wait timeout. + liftIO (config.register done) + + let + firstSeg = Map.fromListWith (\_ old -> old) [(seg.queue, ix) | (ix, (seg, _, _)) <- zip [0 :: Int ..] segmentSlots] + lastSeg = Map.fromList [(seg.queue, ix) | (ix, (seg, _, _)) <- zip [0 ..] segmentSlots] + liftIO $ for_ (zip [0 ..] segmentSlots) \(ix, (seg, vkQueue, cb)) -> do + let + ex = extras seg.queue + derived = [(timelineOf p, stages, value) | (p, (value, stages)) <- Map.toAscList seg.fronts] + submitWaits = derived <> (if Map.lookup seg.queue firstSeg == Just ix then ex.waits else []) + submitSignals = + (timelineOf seg.queue, seg.signal) + : (if Map.lookup seg.queue lastSeg == Just ix then ex.signals else []) + -- A binary semaphore (the WSI pair) ignores the value; a timeline + -- ignores nothing, and carries its stage in the same struct. + waitInfo (sem, st, v) = zero{SemaphoreSubmitInfo.semaphore = sem, SemaphoreSubmitInfo.stageMask = st, SemaphoreSubmitInfo.value = v} + signalInfo (sem, v) = zero{SemaphoreSubmitInfo.semaphore = sem, SemaphoreSubmitInfo.stageMask = PIPELINE_STAGE_2_ALL_COMMANDS_BIT, SemaphoreSubmitInfo.value = v} + submit = + zero + { waitSemaphoreInfos = V.fromList (map waitInfo submitWaits) + , commandBufferInfos = [SomeStruct zero{CommandBufferSubmitInfo.commandBuffer = Vk.commandBufferHandle cb}] + , signalSemaphoreInfos = V.fromList (map signalInfo submitSignals) + } + :: SubmitInfo2 '[] + queueSubmit2 vkQueue [SomeStruct submit] Vk.NULL_HANDLE + + -- The host passes, in schedule order: wait, run, signal — inline, or + -- handed whole to the 'deferHost' runner. + liftIO do + deferred <- reverse <$> readIORef deferredRef + let hostTail = for_ deferred \(psync, body) -> do + unless (null psync.waits) $ + void $ + waitSemaphoresSafe + dev + zero + { SemaphoreWaitInfo.semaphores = V.fromList [timelineOf w.queue | w <- psync.waits] + , SemaphoreWaitInfo.values = V.fromList [w.value | w <- psync.waits] + } + maxBound + body + signalSemaphore dev zero{SemaphoreSignalInfo.semaphore = timelineOf psync.queue, SemaphoreSignalInfo.value = psync.signal} + case config.deferHost of + Nothing -> hostTail + Just runner -> unless (null deferred) (runner hostTail) + pure done + +{- | One planned submit: a contiguous run of one queue's passes whose +cross-queue waits all hoist to its front. +-} +data SegmentPlan = SegmentPlan + { queue :: FG.QueueId + , fronts :: Map FG.QueueId (Word64, PipelineStageFlags2) + {- ^ per producer queue: the timeline value to wait for, at the covered + accesses' stages + -} + , signal :: Word64 + -- ^ the value the segment's submit signals (its passes' max) + } + +{- | Cut each queue's pass stream into segments at wait boundaries. + +A pass joins its queue's open segment when every wait it carries is already +implied by the segment's front (same producer, value not above the front's; +its stages widen the mask). Anything else — a higher value, a producer the +segment has not waited on — closes the segment and opens a new one fronted +by the pass's own waits. Front waits therefore only reference passes +registered before the segment's first pass, which makes the segment graph +acyclic by construction: no cycle check, no rejected schedules. + +Waiting a mid-segment value completes when that segment's submit does — a +timeline wait is @>=@, so coarsening the signal points is sound. +-} +planSegments :: [FG.PassSync] -> ([SegmentPlan], Map Int Int) +planSegments syncs = (toList segs, routes) + where + (_, segs, routes) = foldl' step (Map.empty, Seq.empty, Map.empty) syncs + step + :: (Map FG.QueueId Int, Seq.Seq SegmentPlan, Map Int Int) + -> FG.PassSync + -> (Map FG.QueueId Int, Seq.Seq SegmentPlan, Map Int Int) + step (open, acc, rts) s = + let + -- An acquire barrier is only ordered after its release if the wait's dst + -- scope covers it, and its src half comes from the pre-release state — + -- a stage the consuming accesses need not name. Widen, or the two halves + -- of the transition race (WAW on the layout transition). + acquiring = if null s.acquires then zero else PIPELINE_STAGE_2_ALL_COMMANDS_BIT + needs = Map.fromListWith mergeWait [(w.queue, (w.value, waitStage w .|. acquiring)) | w <- s.waits] + covered seg = + Map.foldrWithKey + (\p (v, _) ok -> ok && maybe False ((v <=) . fst) (Map.lookup p seg.fronts)) + True + needs + in + case Map.lookup s.queue open of + Just ix + | seg <- Seq.index acc ix + , covered seg -> + ( open + , Seq.adjust + (\sg -> SegmentPlan{queue = sg.queue, fronts = Map.unionWith mergeWait sg.fronts needs, signal = max sg.signal s.signal}) + ix + acc + , Map.insert s.passId ix rts + ) + _ -> + let ix = Seq.length acc + in ( Map.insert s.queue ix open + , acc Seq.|> SegmentPlan{queue = s.queue, fronts = needs, signal = s.signal} + , Map.insert s.passId ix rts + ) + mergeWait (v1, st1) (v2, st2) = (max v1 v2, st1 .|. st2) + +-- | Order-preserving dedup for the short queue lists. +ordNub :: (Ord a) => [a] -> [a] +ordNub = go Set.empty + where + go _ [] = [] + go seen (x : xs) + | x `Set.member` seen = go seen xs + | otherwise = x : go (Set.insert x seen) xs + +-- | Block until every 'Submitted' timeline reaches its value. +waitSubmitted :: (MonadIO m) => Vk.Device -> Word64 -> [Submitted] -> m Vk.Result +waitSubmitted _ _ [] = pure Vk.SUCCESS +waitSubmitted dev timeout submitted = + waitSemaphoresSafe + dev + zero + { SemaphoreWaitInfo.semaphores = V.fromList [s.semaphore | s <- submitted] + , SemaphoreWaitInfo.values = V.fromList [s.value | s <- submitted] + } + timeout + +{- | The stage a schedule wait is consumed at ('SemaphoreSubmitInfo.stageMask'). + +The OR of its protected accesses' stages. Matches the adapters' cross-queue +barrier chaining ('Image.queueTransition' hands over at exactly the +consuming usage's stage), so the semaphore and the barrier meet. An access +declared without flags carries no scope: over-synchronize. +-} +waitStage :: FG.Wait -> PipelineStageFlags2 +waitStage w + | null w.covers = PIPELINE_STAGE_2_ALL_COMMANDS_BIT + | otherwise = foldl' (\acc a -> acc .|. fst (accessScopes a)) zero w.covers + +{- | An access's synchronization2 scope (stage + access mask). + +Dispatched on the access's resource type; an adapter this module does not +know about carries no decodable scope and over-synchronizes. +-} +accessScopes :: FG.Access -> (PipelineStageFlags2, AccessFlags2) +accessScopes (FG.Access (_ :: FG.Handle r) flags) = case flags of + Nothing -> fullScope + Just f + | Just HRefl <- eqTypeRep (typeRep @r) (typeRep @Image.ManagedImage) -> + fromState (Image.usageState f).stage (Image.usageState f).access + | Just HRefl <- eqTypeRep (typeRep @r) (typeRep @Buffer.ManagedBuffer) -> + fromState (Buffer.usageState f).stage (Buffer.usageState f).access + | otherwise -> fullScope + where + fullScope = (PIPELINE_STAGE_2_ALL_COMMANDS_BIT, ACCESS_2_MEMORY_READ_BIT .|. ACCESS_2_MEMORY_WRITE_BIT) + fromState st ac + | st == zero || st .&. Vk.PIPELINE_STAGE_HOST_BIT /= zero = fullScope + | otherwise = (stage2 st, access2 ac) + +-- The synchronization1 bits are valid synchronization2 bits verbatim. +stage2 :: Vk.PipelineStageFlags -> PipelineStageFlags2 +stage2 s = coerce (fromIntegral (coerce s :: Word32) :: Word64) + +access2 :: Vk.AccessFlags -> AccessFlags2 +access2 a = coerce (fromIntegral (coerce a :: Word32) :: Word64) diff --git a/src/Vulkan/Utils/FrameGraph/Image.hs b/src/Vulkan/Utils/FrameGraph/Image.hs new file mode 100644 --- /dev/null +++ b/src/Vulkan/Utils/FrameGraph/Image.hs @@ -0,0 +1,680 @@ +{-| A 'FG.Resource' for Vulkan images that places layout-transition barriers +automatically. + +A 'ManagedImage' carries the image plus its tracked 'ImageState' (layout, +stage, access). A pass declares an access with a 'Usage' (the instance's +'FG.Flags' type); the 'FG.preRead' / 'FG.preWrite' hooks diff the +tracked state against the usage's target and queue the barrier into the +'Recorder''s per-pass batch, one @vkCmdPipelineBarrier@ per pass — the +'transitionImageTo' rules, plus semaphore chaining when the access hops +queues. + +Import-only: the graph tracks the layout and places barriers but does not own +the allocation (see the package README). +-} +module Vulkan.Utils.FrameGraph.Image + ( ManagedImage (..) + , newManagedImage + , newManagedImageMip + , newManagedImageLayer + , newManagedImageSlice + , SliceRegistry + , newSliceRegistry + , forgetImage + , claimOwnership + , ImageDesc (..) + , importManagedImage + , importScratchImage + , importOwnedImage + , describedAs + , sharedAcrossQueues + , imageInfo + , describedImage + , describedMip + , describedSlice + , ImageState (..) + , undefinedState + , Usage (..) + , usageState + , transitionImageTo + , transitionImagesTo + , queueTransition + , transferOwnership + , sliceLayers + , copyManagedImageToHost + ) where + +import Control.Monad (filterM, foldM, unless, when) +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Bits ((.&.), (.|.)) +import Data.Foldable (traverse_) +import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef, writeIORef) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Maybe (fromMaybe, isJust, isNothing) +import Data.Text (Text) +import Data.Text qualified as Text +import Data.Vector qualified as V +import Data.Word (Word32) +import GHC.Stack (HasCallStack) +import System.Mem (performGC) +import System.Mem.Weak (Weak, deRefWeak) + +import Fragr qualified as FG +import Vulkan.CStruct.Extends (SomeStruct (..)) +import Vulkan.Core10 qualified as Vk +import Vulkan.Utils.FrameGraph.Recorder (Accessor (..), Recorder, TransferSide (..), chainedNode, flushBarriers, markChained, overlappingRanges, queueBarrier, recorderFamily, recorderHost, recorderQueue, recorderSameFamily) +import Vulkan.Zero (zero) + +{- | An image, or an arbitrary @(mip × array-layer)@ slice of it, whose +layout/stage/access the frame graph tracks and transitions. + +The @range@ is the barrier's subresource range, so any slicing granularity is one +'ManagedImage' per slice over the same 'Vk.Image', each tracked independently — the +intra-image barriers fall out of that. A whole-image wrapper ('newManagedImage') +covers all mips+layers as one unit (e.g. a multiview render); per-mip +('newManagedImageMip', a bloom pyramid) or per-layer ('newManagedImageLayer', a +cubemap face / array element) wrappers give finer control. Slices tracked +separately must not overlap — wrapping checks that against the image's live +wrappers in the renderer's 'SliceRegistry' and fails fast, since two trackers +over one subresource diverge silently (wrong old layouts, missed barriers). +-} +data ManagedImage = ManagedImage + { image :: Vk.Image + , range :: Vk.ImageSubresourceRange + , stateRef :: IORef ImageState + , queueRef :: IORef (Maybe FG.QueueId) + -- ^ The device queue that last accessed it; 'Nothing' until one has. + , releasedRef :: IORef (Maybe ImageState) + {- ^ The state a pending ownership release saw, so the acquiring half can + build the barrier that matches it exactly. + -} + , shared :: Bool + {- ^ The allocation is @SHARING_MODE_CONCURRENT@ across the families the + graph uses it on ('sharedAcrossQueues'). An unmarked resource accessed + across queues is fatal: no ownership transfer is emitted, so its contents + would be undefined on the new family. + -} + , info :: Text + {- ^ Human-readable summary (format/extent, see 'imageInfo') shown by + visualization output; attach with 'describedAs'. + -} + } + +-- | Wrap a whole image (all mips + layers, monolithic), starting from 'undefinedState'. +newManagedImage :: (HasCallStack, MonadIO m) => SliceRegistry -> Vk.Image -> Vk.ImageAspectFlags -> m ManagedImage +{-# INLINE newManagedImage #-} +newManagedImage reg image aspect = newManaged reg image (Vk.ImageSubresourceRange aspect 0 Vk.REMAINING_MIP_LEVELS 0 Vk.REMAINING_ARRAY_LAYERS) + +-- | Wrap a single mip level (all its layers), tracked independently of the others. +newManagedImageMip :: (HasCallStack, MonadIO m) => SliceRegistry -> Vk.Image -> Vk.ImageAspectFlags -> Word32 -> m ManagedImage +{-# INLINE newManagedImageMip #-} +newManagedImageMip reg image aspect mip = newManaged reg image (Vk.ImageSubresourceRange aspect mip 1 0 1) + +-- | Wrap a single array layer / cubemap face (mip 0), tracked independently. +newManagedImageLayer :: (HasCallStack, MonadIO m) => SliceRegistry -> Vk.Image -> Vk.ImageAspectFlags -> Word32 -> m ManagedImage +{-# INLINE newManagedImageLayer #-} +newManagedImageLayer reg image aspect layer = newManaged reg image (Vk.ImageSubresourceRange aspect 0 1 layer 1) + +-- | Wrap an arbitrary @(mip × layer)@ slice (e.g. one light's 6 cube faces in an array). +newManagedImageSlice :: (HasCallStack, MonadIO m) => SliceRegistry -> Vk.Image -> Vk.ImageAspectFlags -> Word32 -> Word32 -> Word32 -> Word32 -> m ManagedImage +{-# INLINE newManagedImageSlice #-} +newManagedImageSlice reg image aspect baseMip levelCount baseLayer layerCount = + newManaged reg image (Vk.ImageSubresourceRange aspect baseMip levelCount baseLayer layerCount) + +newManaged :: (HasCallStack, MonadIO m) => SliceRegistry -> Vk.Image -> Vk.ImageSubresourceRange -> m ManagedImage +{-# INLINE newManaged #-} +newManaged reg image range = liftIO do + stateRef <- newIORef undefinedState + registerSlice reg image range stateRef + queueRef <- newIORef Nothing + releasedRef <- newIORef Nothing + pure ManagedImage{releasedRef, image, range, stateRef, queueRef, shared = False, info = ""} + +{- | A registry of live wrappers per image, enforcing the non-overlap +contract at wrap time ('registerSlice'). + +One per renderer, created where the images' owning scope begins (the +@ResourceT@ the render loop runs in): replacing the renderer replaces the +registry, so a dead scope's wrappers cannot poison the next one's over the +persisting Vulkan context. +-} +newtype SliceRegistry = SliceRegistry (IORef (Map Vk.Image [SliceEntry])) + +-- | One live wrapper's range in a 'SliceRegistry' bucket. +data SliceEntry = SliceEntry + { range :: Vk.ImageSubresourceRange + , weak :: Weak (IORef ImageState) + } + +newSliceRegistry :: (MonadIO m) => m SliceRegistry +newSliceRegistry = liftIO (SliceRegistry <$> newIORef Map.empty) + +{- | Check the range against the image's live wrappers and record it, fatally +on overlap. + +Entries are weak, keyed on each wrapper's 'stateRef': a dropped wrapper's +tracker can never diverge again, so its range frees on collection. That also +keeps a recycled 'Vk.Image' handle (destroy, then create getting the same +value) from clashing with the destroyed image's wrappers. +-} +registerSlice :: (HasCallStack) => SliceRegistry -> Vk.Image -> Vk.ImageSubresourceRange -> IORef ImageState -> IO () +registerSlice (SliceRegistry registry) image range stateRef = do + live0 <- pruneLive + -- A clash may be a dropped wrapper the GC has not reached yet: collect + -- before accusing. + live <- if any clash live0 then performGC *> pruneLive else pure live0 + case filter clash live of + [] -> pure () + clashes -> + error + ( "Vulkan.Utils.FrameGraph: wrapping " + <> show range + <> " of " + <> show image + <> " overlaps a live ManagedImage over " + <> show (map (.range) clashes) + <> "; slices tracked separately must not overlap" + ) + -- No finalizer: dead entries are pruned on the image's next wrap (or by + -- 'forgetImage'), keeping this insert the map's only writer — a finalizer + -- racing it could resurrect the entry it just removed. + weak <- mkWeakIORef stateRef (pure ()) + atomicModifyIORef' registry \m -> (Map.insert image (SliceEntry{range, weak} : live) m, ()) + where + clash e = overlappingRanges range e.range + pruneLive = do + m <- readIORef registry + filterM (fmap isJust . deRefWeak . (.weak)) (Map.findWithDefault [] image m) + +{- | Drop every wrapper registered over the image, reachable or not. + +The deterministic half of deregistration: weak entries only free once +nothing holds the wrapper, but a destroyed image's wrappers may stay +reachable through scopes that outlive it (another in-flight frame's slot). +Register this next to the image's destruction so a recycled handle cannot +clash with them. +-} +forgetImage :: (MonadIO m) => SliceRegistry -> Vk.Image -> m () +forgetImage (SliceRegistry registry) image = + liftIO (atomicModifyIORef' registry \m -> (Map.delete image m, ())) + +{- | Attach a summary (e.g. 'imageInfo') shown next to the resource's name +in visualization output. +-} +describedAs :: Text -> ManagedImage -> ManagedImage +describedAs t ManagedImage{..} = ManagedImage{info = t, ..} + +{- | Mark the allocation as @SHARING_MODE_CONCURRENT@ across the families it +is used on. + +Required before any cross-family access the graph cannot transfer +ownership for: an @EXCLUSIVE@ image's contents are undefined on the new +family, so crossing without this is fatal, not silent. Apply before +importing — imports read it through 'FG.isShared', exempting the image +from the schedule's single-owner validation. +-} +sharedAcrossQueues :: ManagedImage -> ManagedImage +sharedAcrossQueues mi = mi{shared = True} + +-- | The conventional 'describedAs' summary: the format (sans prefix) and extent. +imageInfo :: Vk.Format -> Vk.Extent2D -> Text +imageInfo format (Vk.Extent2D w h) = + Text.pack (drop (Text.length "FORMAT_") (show format) <> " " <> show w <> "x" <> show h) + +{- | 'newManagedImage' with the 'imageInfo' description attached, stating the +allocation's format/extent once. +-} +describedImage :: (HasCallStack, MonadIO m) => SliceRegistry -> Vk.Format -> Vk.Extent2D -> Vk.Image -> Vk.ImageAspectFlags -> m ManagedImage +describedImage reg format ext image aspect = describedAs (imageInfo format ext) <$> newManagedImage reg image aspect + +-- | 'newManagedImageMip' with the mip's 'imageInfo' description attached. +describedMip :: (HasCallStack, MonadIO m) => SliceRegistry -> Vk.Format -> Vk.Extent2D -> Vk.Image -> Vk.ImageAspectFlags -> Word32 -> m ManagedImage +describedMip reg format ext image aspect mip = describedAs (imageInfo format ext) <$> newManagedImageMip reg image aspect mip + +-- | A mip-0 layer range via 'newManagedImageSlice', with the 'imageInfo' description attached. +describedSlice :: (HasCallStack, MonadIO m) => SliceRegistry -> Vk.Format -> Vk.Extent2D -> Vk.Image -> Vk.ImageAspectFlags -> Word32 -> Word32 -> m ManagedImage +describedSlice reg format ext image aspect baseLayer layerCount = describedAs (imageInfo format ext) <$> newManagedImageSlice reg image aspect 0 1 baseLayer layerCount + +instance FG.Resource ManagedImage where + type Desc ManagedImage = ImageDesc + type Alloc ManagedImage = () + type Ctx ManagedImage = Recorder + type Flags ManagedImage = Usage + + createResource _ _ = + error "ManagedImage is import-only: allocate the image and use importResource" + + destroyResource _ _ _ = pure () + + preRead h _ usage rec mi = queueTransition rec (FG.handleId h) mi usage + preWrite h _ usage rec mi = queueTransition rec (FG.handleId h) mi usage + + -- The two halves of a cross-queue hand-off, fired on the producing and the + -- consuming side of each data edge. + preRelease h _ usage peer rec mi = transferOwnership Release rec (FG.handleId h) peer mi usage + preAcquire h _ usage peer rec mi = transferOwnership Acquire rec (FG.handleId h) peer mi usage + + isShared mi = mi.shared + + describeDesc d = d.info + +-- | The synchronization state an image is currently left in. +data ImageState = ImageState + { layout :: Vk.ImageLayout + , stage :: Vk.PipelineStageFlags + , access :: Vk.AccessFlags + } + deriving stock (Eq, Show) + +-- | Freshly created / never-transitioned: undefined layout, top of pipe. +undefinedState :: ImageState +undefinedState = + ImageState + { layout = Vk.IMAGE_LAYOUT_UNDEFINED + , stage = Vk.PIPELINE_STAGE_TOP_OF_PIPE_BIT + , access = zero + } + +{- | How a pass uses an image, i.e. the 'ImageState' it must be in for that +access. The per-access payload of 'FG.readWith' / 'FG.writeWith'. +-} +data Usage + = ColorAttachment + | DepthAttachment + | TransferSrc + | TransferDst + | Present + | -- | Storage read/write in the given shader stage (compute, fragment, …). + StorageRead Vk.PipelineStageFlags + | StorageWrite Vk.PipelineStageFlags + | -- | Sampled in the given shader stage (fragment, compute, …). + Sampled Vk.PipelineStageFlags + | -- | Read by the host after a fence (@GENERAL@, the layout mapped linear images live in). + HostRead + deriving stock (Eq, Ord, Show) + +{- | The target state each 'Usage' requires. Stage/access mirror the +@Vulkan.Utils.Barrier@ @transition*@ helpers. +-} +usageState :: Usage -> ImageState +usageState = \case + -- READ covers @LOAD_OP_LOAD@ and blending, as DepthAttachment's covers the depth test. + ColorAttachment -> + ImageState + Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL + Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT + (Vk.ACCESS_COLOR_ATTACHMENT_READ_BIT .|. Vk.ACCESS_COLOR_ATTACHMENT_WRITE_BIT) + DepthAttachment -> + ImageState + Vk.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL + (Vk.PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT .|. Vk.PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT) + (Vk.ACCESS_DEPTH_STENCIL_ATTACHMENT_READ_BIT .|. Vk.ACCESS_DEPTH_STENCIL_ATTACHMENT_WRITE_BIT) + TransferSrc -> + ImageState + Vk.IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL + Vk.PIPELINE_STAGE_TRANSFER_BIT + Vk.ACCESS_TRANSFER_READ_BIT + TransferDst -> + ImageState + Vk.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL + Vk.PIPELINE_STAGE_TRANSFER_BIT + Vk.ACCESS_TRANSFER_WRITE_BIT + Present -> + ImageState + Vk.IMAGE_LAYOUT_PRESENT_SRC_KHR + Vk.PIPELINE_STAGE_BOTTOM_OF_PIPE_BIT + zero + StorageRead stage -> + ImageState Vk.IMAGE_LAYOUT_GENERAL stage Vk.ACCESS_SHADER_READ_BIT + StorageWrite stage -> + ImageState Vk.IMAGE_LAYOUT_GENERAL stage Vk.ACCESS_SHADER_WRITE_BIT + Sampled stage -> + ImageState Vk.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL stage Vk.ACCESS_SHADER_READ_BIT + HostRead -> + ImageState Vk.IMAGE_LAYOUT_GENERAL Vk.PIPELINE_STAGE_HOST_BIT Vk.ACCESS_HOST_READ_BIT + +{- | Whether the 'Usage' writes the image (and so needs a barrier even when the +state is unchanged — only read-after-read can skip it). +-} +usageWrites :: Usage -> Bool +usageWrites = \case + ColorAttachment -> True + DepthAttachment -> True + TransferDst -> True + StorageWrite _ -> True + TransferSrc -> False + Present -> False + StorageRead _ -> False + Sampled _ -> False + HostRead -> False + +{- | Record the barrier bringing the image into the 'Usage''s state and update +the tracked state. Standalone counterpart to the hook path, for barriers +recorded outside a pass; treats the access as same-queue. + +A write 'Usage' records the barrier even when the state is unchanged — a +same-state write still needs the execution+memory dependency against the +previous access. Only a read of an already-matching state skips it. +-} +transitionImageTo :: (MonadIO m) => Vk.CommandBuffer -> ManagedImage -> Usage -> m () +{-# INLINE transitionImageTo #-} +transitionImageTo cb mi usage = transitionImagesTo cb [(mi, usage)] + +{- | 'transitionImageTo' over a batch: one @vkCmdPipelineBarrier@, OR-ed stage masks. + +The images must be tracked separately (distinct non-overlapping slices): +barriers in one command are unordered, so two entries for the same slice +would race. +-} +transitionImagesTo :: (MonadIO m) => Vk.CommandBuffer -> [(ManagedImage, Usage)] -> m () +transitionImagesTo cb accesses = do + (srcs, dsts, barriers) <- foldM collect (zero, zero, []) accesses + unless (null barriers) $ + Vk.cmdPipelineBarrier cb srcs dsts zero [] [] (V.fromList barriers) + where + collect acc@(srcs, dsts, barriers) (mi, usage) = do + lastQueue <- liftIO (readIORef mi.queueRef) + nextTransition (maybe HostAccess DeviceQueue lastQueue) (\_ _ -> True) False mi usage >>= \case + Nothing -> pure acc + Just (src, dst, barrier) -> pure (srcs .|. src, dsts .|. dst, barrier : barriers) + +{- | Copy an image into a host-readable one via the trackers. + +The source moves to @TRANSFER_SRC@ from whatever state it is actually in, the +destination through @TRANSFER_DST@ to 'HostRead' — no assumed layouts, no +hand-rolled host barrier. Copies the first mip and layer of each wrapper's +slice (the aspects must match). +-} +copyManagedImageToHost :: (MonadIO m) => Vk.CommandBuffer -> Vk.Extent2D -> ManagedImage -> ManagedImage -> m () +copyManagedImageToHost cb (Vk.Extent2D w h) src cpu = do + transitionImagesTo cb [(src, TransferSrc), (cpu, TransferDst)] + Vk.cmdCopyImage + cb + src.image + (usageState TransferSrc).layout + cpu.image + (usageState TransferDst).layout + [Vk.ImageCopy (sliceLayers src) (Vk.Offset3D 0 0 0) (sliceLayers cpu) (Vk.Offset3D 0 0 0) (Vk.Extent3D w h 1)] + transitionImageTo cb cpu HostRead + +-- | The slice's first mip and layer, as a transfer command's subresource. +sliceLayers :: ManagedImage -> Vk.ImageSubresourceLayers +sliceLayers mi = Vk.ImageSubresourceLayers mi.range.aspectMask mi.range.baseMipLevel mi.range.baseArrayLayer 1 + +{- | The hook path: 'transitionImageTo' rules, but queued and queue-aware. + +The barrier goes into the 'Recorder''s per-pass batch (flushed before the +exec callback), and when the access rides a prior synchronization — a +cross-queue hop (the driver's semaphore) or a split-barrier event the pass +waited on ('chainedNode') — it chains to it instead: source scope becomes +the destination stage with no access mask, since the semaphore/event +already provides execution ordering and memory availability. The driver's +wait @dstStageMask@ / event scope must cover the usage's stage (both then +chain). Same-family queues share freely; crossing to another /family/ +needs CONCURRENT sharing or an ownership acquire this pass performed — +otherwise an EXCLUSIVE image's contents are undefined there. +-} +queueTransition :: (MonadIO m) => Recorder -> Int -> ManagedImage -> Usage -> m () +queueTransition rec node mi usage = do + queue <- recorderQueue rec + chained0 <- chainedNode rec node + hosted <- recorderHost rec + sameFamily <- recorderSameFamily rec + nextTransition (if hosted then HostAccess else DeviceQueue queue) sameFamily chained0 mi usage >>= traverse_ \(srcStage, dstStage, barrier) -> + queueBarrier rec srcStage dstStage barrier + +{- | The producer- and consumer-side halves of a cross-queue hand-off. + +On a @CONCURRENT@ image ('sharedAcrossQueues') the release half carries the +layout transition producer-side — its source scope stays on a queue that +supports it — and the acquire half is a no-op: the driver's semaphore +already orders the two, and no family owns the image. + +On an @EXCLUSIVE@ image the pair is a real queue-family ownership transfer: +the same barrier is recorded twice, once in each queue's buffer, with both +family indices named. The halves must match exactly, so both are computed +from the state the release saw — the acquire is what advances the tracked +state, and it marks the node chained so the consumer's own declared access +does not place a second barrier on top of it. + +Same-family queues own nothing to transfer: the release still moves the +layout, the acquire still just advances the tracking. + +A hand-off to the host is neither: the release carries the full dependency +(a semaphore signal makes device writes available to the device domain +only, so the host half needs a real @HOST@ destination scope), and the +acquire is bookkeeping. +-} +transferOwnership :: (MonadIO m) => TransferSide -> Recorder -> Int -> FG.QueueId -> ManagedImage -> Usage -> m () +transferOwnership side rec node peer mi usage = do + hosted <- recorderHost rec + queue <- recorderQueue rec + ourFamily <- recorderFamily rec queue + peerFamily <- recorderFamily rec peer + cur <- liftIO (readIORef mi.stateRef) + released <- liftIO (readIORef mi.releasedRef) + let + next = usageState usage + -- The producer is the release's queue and the acquire's peer. + (srcFamily, dstFamily) = case side of + Release -> (ourFamily, peerFamily) + Acquire -> (peerFamily, ourFamily) + -- The host owns nothing (it is not a family), and a CONCURRENT image is + -- owned by no one: those hand-offs ride the semaphore alone. + owned = + not mi.shared + && not hosted + && srcFamily /= dstFamily + && srcFamily /= Vk.QUEUE_FAMILY_IGNORED + && dstFamily /= Vk.QUEUE_FAMILY_IGNORED + -- The consumer is the host: only the release's barrier can make the + -- device's writes visible to it (the schedule's timeline wait cannot). + toHost = next.stage .&. Vk.PIPELINE_STAGE_HOST_BIT /= zero + -- Both halves describe the same barrier, so the acquire builds its own + -- from the state the release saw. + from = case side of + Release -> cur + Acquire -> fromMaybe cur released + barrier = + SomeStruct + zero + { Vk.srcAccessMask = case side of + Release -> from.access + Acquire -> zero + , Vk.dstAccessMask = case side of + Release -> if toHost then next.access else zero + Acquire -> next.access + , Vk.oldLayout = from.layout + , Vk.newLayout = next.layout + , Vk.srcQueueFamilyIndex = if owned then srcFamily else Vk.QUEUE_FAMILY_IGNORED + , Vk.dstQueueFamilyIndex = if owned then dstFamily else Vk.QUEUE_FAMILY_IGNORED + , Vk.image = mi.image + , Vk.subresourceRange = mi.range + } + -- A release's destination scope and an acquire's source scope are ignored + -- by the spec; the halves must otherwise be identical. + (srcStage, dstStage) = case side of + Release -> (from.stage, if toHost then next.stage else Vk.PIPELINE_STAGE_BOTTOM_OF_PIPE_BIT) + Acquire -> (Vk.PIPELINE_STAGE_TOP_OF_PIPE_BIT, next.stage) + case side of + Release -> do + -- The release performs the layout transition (its barrier executes on + -- the producer's queue), so the tracked state advances with it. + when (owned || toHost || cur /= next) do + queueBarrier rec srcStage dstStage barrier + liftIO (writeIORef mi.stateRef next) + liftIO (writeIORef mi.releasedRef (Just cur)) + Acquire -> do + -- An owned acquire without its armed release half would record an + -- unmatched barrier from a guessed state: a schedule bug, not a + -- recoverable condition. + when (owned && isNothing released) $ + error + ( "Vulkan.Utils.FrameGraph: ownership acquire of " + <> show mi.info + <> " without a pending release; the schedule must pair the halves" + ) + when owned $ queueBarrier rec srcStage dstStage barrier + liftIO do + -- The host is not a device queue: recording it as the last one would + -- make the next device access look cross-queue (cf. 'nextTransition'), + -- and its release already advanced the state (the @toHost@ arm) — the + -- driver defers host passes, so a late write here would rewind the + -- device-side tracking. + unless hosted do + writeIORef mi.stateRef next + writeIORef mi.queueRef (Just queue) + -- Only the owned half consumed the hand-off; a melted acquire (host, + -- shared, same family) must leave the slot for a pending owned one. + when owned $ writeIORef mi.releasedRef Nothing + markChained rec node + +{- | Diff the tracked state against the 'Usage''s target and advance it. + +Hands back the @(srcStage, dstStage, barrier)@ still to be recorded — the +caller commits to recording it (immediately or batched) before the access +runs. +-} +nextTransition + :: (MonadIO m) + => Accessor + -> (FG.QueueId -> FG.QueueId -> Bool) + -- ^ whether two queues belong to one family (share ownership) + -> Bool + -- ^ an ownership acquire already synchronized it ('chainedNode') + -> ManagedImage + -> Usage + -> m (Maybe (Vk.PipelineStageFlags, Vk.PipelineStageFlags, SomeStruct Vk.ImageMemoryBarrier)) +nextTransition accessor sameFamily marked mi usage = liftIO do + cur <- readIORef mi.stateRef + lastQueue <- readIORef mi.queueRef + let + next = usageState usage + -- A first access owns nothing yet, and the host is not a queue family (its + -- accesses order through the schedule's timeline and the producer's + -- release barrier), so neither crosses ownership. + crossQueue = case (accessor, lastQueue) of + (DeviceQueue q, Just prev) -> q /= prev + _ -> False + crossFamily = + crossQueue && case (accessor, lastQueue) of + (DeviceQueue q, Just prev) -> not (sameFamily q prev) + _ -> False + -- A cross-queue hop rides the driver's semaphore even within one family. + chained = crossQueue || marked + -- Crossing to a new family without a transfer: the contents are undefined + -- there, so the access acquires by discarding them (it writes — the guard + -- below rejects a read). + discards = crossFamily && not mi.shared + srcStage = if chained then next.stage else cur.stage + srcAccess = if chained then zero else cur.access + -- Semaphore/event-ordered same-state accesses need no barrier of their + -- own; unchained writes need one even with the state unchanged. + needed = cur /= next || (usageWrites usage && not chained) + -- An unshared (EXCLUSIVE) resource reaching another family without an + -- ownership transfer ('transferOwnership') has undefined contents there. A + -- write that does not read them is still fine — it acquires by discarding + -- (see 'discards') — but a read would see garbage, so it is fatal. + when (crossFamily && not mi.shared && not (usageWrites usage)) $ + error + ( "Vulkan.Utils.FrameGraph: cross-family read of an unshared resource (" + <> show mi.info + <> ") the graph never handed over: it must be produced on the reading family, " + <> "marked 'sharedAcrossQueues' (CONCURRENT), or written by a pass the graph " + <> "can transfer ownership from" + ) + case accessor of + DeviceQueue q -> writeIORef mi.queueRef (Just q) + HostAccess -> pure () + if needed + then do + writeIORef mi.stateRef next + pure $ + Just + ( srcStage + , next.stage + , SomeStruct + zero + { Vk.srcAccessMask = srcAccess + , Vk.dstAccessMask = next.access + , Vk.oldLayout = if discards then Vk.IMAGE_LAYOUT_UNDEFINED else cur.layout + , Vk.newLayout = next.layout + , -- IGNORED (not 0): a plain transition, not an ownership + -- transfer ('transferOwnership' emits those). + Vk.srcQueueFamilyIndex = Vk.QUEUE_FAMILY_IGNORED + , Vk.dstQueueFamilyIndex = Vk.QUEUE_FAMILY_IGNORED + , Vk.image = mi.image + , Vk.subresourceRange = mi.range + } + ) + else + pure Nothing + +{- | Descriptor for a 'ManagedImage'; carries the image's 'describedAs' +summary for visualization output (the resource name travels separately). +-} +newtype ImageDesc = ImageDesc {info :: Text} + +{- | Import a 'ManagedImage' under @name@, as an observed resource. + +Also claims the graph's 'FG.addPreExec slot for 'flushBarriers', so the +hook-queued barriers are recorded under any driver — the adapter owns that +slot; wrap the flush rather than replacing it. + +Writers of the image become side effects ('FG.importResource'): right for +presentables and anything read outside the graph (readbacks, a next-frame +sampler). For targets only this graph's passes consume, use +'importScratchImage' so demand culling applies. +-} +importManagedImage :: (MonadIO m) => FG.FrameGraph Recorder () -> Text -> ManagedImage -> m (FG.Handle ManagedImage) +importManagedImage graph name mi = do + FG.addPreExec graph flushBarriers + disarmHandOff mi + FG.importResource graph name (ImageDesc mi.info) mi + +{- | Drop a hand-off a previous graph's melted acquire left armed. + +Run at import, so the unpaired-acquire check sees only this graph's +releases — a stale slot would let it pass and record a barrier from a +frames-old state. +-} +disarmHandOff :: (MonadIO m) => ManagedImage -> m () +disarmHandOff mi = liftIO (writeIORef mi.releasedRef Nothing) + +{- | 'importManagedImage' via 'FG.importScratch', keeping writers subject to demand culling. + +The image (and its layout tracking) persists between graphs, but its contents +are only ever consumed through this graph. Passes that feed a between-graphs +consumer must say 'FG.setSideEffect' themselves. +-} +importScratchImage :: (MonadIO m) => FG.FrameGraph Recorder () -> Text -> ManagedImage -> m (FG.Handle ManagedImage) +importScratchImage graph name mi = do + FG.addPreExec graph flushBarriers + disarmHandOff mi + FG.importScratch graph name (ImageDesc mi.info) mi + +{- | 'importManagedImage' declaring the queue that owns the image across the +frame boundary ('FG.importOwned'), read off the wrapper's own tracking: a +first touch on another family this frame derives a real release / acquire +pair — the release recorded on the owning queue — instead of the fatal +cross-family read. An image no device queue has touched yet imports +plainly. +-} +importOwnedImage :: (MonadIO m) => FG.FrameGraph Recorder () -> Text -> ManagedImage -> m (FG.Handle ManagedImage) +importOwnedImage graph name mi = + liftIO (readIORef mi.queueRef) >>= \case + Nothing -> importManagedImage graph name mi + Just owner -> do + FG.addPreExec graph flushBarriers + disarmHandOff mi + FG.importOwned graph name (ImageDesc mi.info) mi owner + +{- | Declare the queue that owns the image, established outside any graph. + +For producers the adapters cannot see — a fenced one-shot bake, an upload +queue — so 'importOwnedImage' has an owner to derive the first hand-off +from. In-graph accesses track this themselves. +-} +claimOwnership :: (MonadIO m) => FG.QueueId -> ManagedImage -> m () +claimOwnership queue mi = liftIO (writeIORef mi.queueRef (Just queue)) diff --git a/src/Vulkan/Utils/FrameGraph/Recorder.hs b/src/Vulkan/Utils/FrameGraph/Recorder.hs new file mode 100644 --- /dev/null +++ b/src/Vulkan/Utils/FrameGraph/Recorder.hs @@ -0,0 +1,354 @@ +{-| Command-buffer routing and barrier batching for driving 'FG.executeQueued'. + +A 'Recorder' is a mutable slot holding the command buffer the current pass — and +the barrier hooks it fires — record into, plus the batch of barriers those hooks +have queued for the pass ('queueBarrier', emitted as one command by +'flushBarriers' from the graph's 'FG.addPreExec point). 'recordingBackend' is +the topology-agnostic 'FG.QueueBackend' that points the recorder at each pass's +queue buffer; 'recordGraph' wraps the whole record step (fresh recorder, flush +installed, run, close every buffer), leaving each driver to supply only its own +submit policy. + +Nothing here is resource-specific beyond the barrier payload types (one lane +per kind): it is the execution seam any 'FG.Resource' adapter records through. +-} +module Vulkan.Utils.FrameGraph.Recorder + ( Recorder + , newRecorder + , setRecorder + , setRecorderHost + , clearChained + , chainedNode + , markChained + , recorderHost + , setRecorderFamilies + , recorderFamily + , recorderSameFamily + , Accessor (..) + , TransferSide (..) + , recorderCommandBuffer + , recorderQueue + , Barriers (..) + , queueBarrier + , queueBufferBarrier + , overlappingRanges + , flushBarriers + , takeBarriers + , recordingCommandBuffer + , recordingBackend + , recordGraph + , recordGraphSyncs + ) where + +import Control.Monad (unless, void, when) +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Bits ((.&.), (.|.)) +import Data.Foldable (traverse_) +import Data.IORef (IORef, atomicModifyIORef', modifyIORef', newIORef, readIORef, writeIORef) +import Data.IntSet (IntSet) +import Data.IntSet qualified as IntSet +import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty qualified as NE +import Data.Vector qualified as V +import Data.Word (Word32) + +import Fragr qualified as FG +import Vulkan.CStruct.Extends (SomeStruct (..)) +import Vulkan.Core10 qualified as Vk +import Vulkan.Zero (zero) + +{- | The command buffer the barrier hooks (and a pass's exec callback) record +into, tagged with its queue so resource adapters can tell when consecutive +accesses cross queues, plus the pass's pending barrier batch. For single-queue +'FG.execute' it holds one buffer for the whole frame; the multi-queue +'FG.executeQueued' driver swaps it per pass so each queue's work lands in that +queue's buffer. +-} +data Recorder = Recorder + { slot :: IORef (FG.QueueId, Vk.CommandBuffer) + , pending :: IORef Barriers + , host :: IORef Bool + -- ^ Host mode: the current pass has no command buffer ('setRecorderHost'). + , chained :: IORef IntSet + {- ^ Nodes whose dependency this pass already synchronized: a split-barrier + event it waited on, or an ownership acquire it performed. + -} + , familyOf :: IORef (Maybe (FG.QueueId -> Word32)) + {- ^ The queue family behind each 'FG.QueueId' ('setRecorderFamilies'); + 'Nothing' until a driver provides one, when distinct queues are + conservatively treated as distinct families. + -} + } + +-- | The barriers queued for the current pass, OR-ing the stage scopes. +data Barriers = Barriers + { srcStage :: !Vk.PipelineStageFlags + , dstStage :: !Vk.PipelineStageFlags + , images :: [SomeStruct Vk.ImageMemoryBarrier] + , buffers :: [SomeStruct Vk.BufferMemoryBarrier] + } + +noBarriers :: Barriers +noBarriers = Barriers zero zero [] [] + +-- | A recorder pointed at an initial buffer on queue 0; swap it with 'setRecorder'. +newRecorder :: (MonadIO m) => Vk.CommandBuffer -> m Recorder +newRecorder cb = + liftIO $ + Recorder + <$> newIORef (FG.QueueId 0, cb) + <*> newIORef noBarriers + <*> newIORef False + <*> newIORef IntSet.empty + <*> newIORef Nothing + +-- | Point the recorder at the queue's command buffer the next passes record into. +setRecorder :: (MonadIO m) => Recorder -> FG.QueueId -> Vk.CommandBuffer -> m () +setRecorder rec queue cb = liftIO do + writeIORef rec.slot (queue, cb) + writeIORef rec.host False + +{- | Point the recorder at a host-executed pass. + +Host work records no commands: the hooks still fire — advancing each +resource's tracked state so later device accesses diff correctly — but the +barriers they queue are dropped. The device-side half of a host access is +the producer's ('FG.preRelease' transitions the resource into the host +state in the producing queue's buffer), and its ordering is the schedule's +timeline wait, realised by the driver executing the pass. +-} +setRecorderHost :: (MonadIO m) => Recorder -> FG.QueueId -> m () +setRecorderHost rec queue = liftIO do + modifyIORef' rec.slot (\(_, cb) -> (queue, cb)) + writeIORef rec.host True + +{- | Drop the chained marks, at the start of each pass. + +They are per-pass: a mark left over from the previous one would suppress a +barrier this pass genuinely needs. +-} +clearChained :: (MonadIO m) => Recorder -> m () +clearChained rec = liftIO (writeIORef rec.chained mempty) + +-- | Whether the node's dependency this pass already synchronized. +chainedNode :: (MonadIO m) => Recorder -> Int -> m Bool +chainedNode rec node = liftIO (IntSet.member node <$> readIORef rec.chained) + +{- | Mark a node as already synchronized for the current pass. + +The ownership-acquire hook does this: the acquire barrier it emitted carries +the full dependency, so the pass's own declared access must not re-place one. +-} +markChained :: (MonadIO m) => Recorder -> Int -> m () +markChained rec node = liftIO (modifyIORef' rec.chained (IntSet.insert node)) + +-- | The queue-family table an ownership transfer names its two sides from. +setRecorderFamilies :: (MonadIO m) => Recorder -> (FG.QueueId -> Word32) -> m () +setRecorderFamilies rec families = liftIO (writeIORef rec.familyOf (Just families)) + +{- | The family behind a 'FG.QueueId'. + +@QUEUE_FAMILY_IGNORED@ when no table was set: ownership transfers then melt +to plain transitions, matching a driver that never crosses families. +-} +recorderFamily :: (MonadIO m) => Recorder -> FG.QueueId -> m Word32 +recorderFamily rec queue = liftIO (maybe Vk.QUEUE_FAMILY_IGNORED ($ queue) <$> readIORef rec.familyOf) + +{- | Whether two queues belong to one family, for per-access comparisons. + +Without a table ('setRecorderFamilies') this is queue identity: distinct +queues must be assumed to be distinct families, or an EXCLUSIVE resource +crossing them would silently lose the fatal unshared-read diagnostic. +-} +recorderSameFamily :: (MonadIO m) => Recorder -> m (FG.QueueId -> FG.QueueId -> Bool) +recorderSameFamily rec = liftIO (maybe (==) (\f a b -> f a == f b) <$> readIORef rec.familyOf) + +{- | Who is performing an access: a device queue, or the host. + +The host is not a queue family — its accesses order through the schedule's +timeline and the producer's release barrier, so they never transfer +ownership. +-} +data Accessor + = DeviceQueue FG.QueueId + | HostAccess + deriving stock (Eq, Show) + +-- | Which half of a cross-queue hand-off a barrier is. +data TransferSide = Release | Acquire + deriving stock (Eq, Show) + +-- | Whether the current pass runs on the host ('setRecorderHost'). +recorderHost :: (MonadIO m) => Recorder -> m Bool +recorderHost rec = liftIO (readIORef rec.host) + +-- | The command buffer currently selected. +recorderCommandBuffer :: (MonadIO m) => Recorder -> m Vk.CommandBuffer +{-# INLINE recorderCommandBuffer #-} +recorderCommandBuffer rec = liftIO (snd <$> readIORef rec.slot) + +-- | The queue the current pass records on. +recorderQueue :: (MonadIO m) => Recorder -> m FG.QueueId +{-# INLINE recorderQueue #-} +recorderQueue rec = liftIO (fst <$> readIORef rec.slot) + +{- | Queue a barrier into the current pass's batch instead of recording it. + +A barrier overlapping a subresource already in the batch flushes it first: +barriers in one command are unordered, and an overlapping pair (a pass +reading then writing one image) is a dependent chain of layout transitions +that needs the command split to stay ordered. + +The batch is emitted by 'flushBarriers', which the graph must fire between +the hooks and the exec callback (installed via 'FG.addPreExec by the image +adapter's import and by 'recordGraph') — a driver whose resources queue +through another path must install it itself, or the queued barriers are +never recorded. +-} +queueBarrier + :: (MonadIO m) + => Recorder + -> Vk.PipelineStageFlags + -> Vk.PipelineStageFlags + -> SomeStruct Vk.ImageMemoryBarrier + -> m () +queueBarrier rec src dst barrier = do + hosted <- liftIO (readIORef rec.host) + unless hosted do + Barriers{images} <- liftIO (readIORef rec.pending) + when (any (overlapping barrier) images) (flushBarriers rec) + liftIO $ modifyIORef' rec.pending \b -> + b{srcStage = b.srcStage .|. src, dstStage = b.dstStage .|. dst, images = barrier : b.images} + +-- | 'queueBarrier' for the buffer lane; overlap is per whole buffer. +queueBufferBarrier + :: (MonadIO m) + => Recorder + -> Vk.PipelineStageFlags + -> Vk.PipelineStageFlags + -> SomeStruct Vk.BufferMemoryBarrier + -> m () +queueBufferBarrier rec src dst barrier@(SomeStruct new) = do + hosted <- liftIO (readIORef rec.host) + unless hosted do + Barriers{buffers} <- liftIO (readIORef rec.pending) + when (any (\(SomeStruct b) -> b.buffer == new.buffer) buffers) (flushBarriers rec) + liftIO $ modifyIORef' rec.pending \b -> + b{srcStage = b.srcStage .|. src, dstStage = b.dstStage .|. dst, buffers = barrier : b.buffers} + +-- | Whether two image barriers touch overlapping subresources. +overlapping :: SomeStruct Vk.ImageMemoryBarrier -> SomeStruct Vk.ImageMemoryBarrier -> Bool +overlapping (SomeStruct a) (SomeStruct b) = + a.image == b.image && overlappingRanges a.subresourceRange b.subresourceRange + +-- | Whether two subresource ranges of one image intersect. +overlappingRanges :: Vk.ImageSubresourceRange -> Vk.ImageSubresourceRange -> Bool +overlappingRanges ra rb = + ra.aspectMask .&. rb.aspectMask /= zero + && spans ra.baseMipLevel ra.levelCount rb.baseMipLevel rb.levelCount + && spans ra.baseArrayLayer ra.layerCount rb.baseArrayLayer rb.layerCount + where + -- The REMAINING_* sentinels are maxBound: treat as extending to the end. + spans baseA countA baseB countB = baseA < end baseB countB && baseB < end baseA countA + end base count = if count == maxBound then maxBound else base + count + +{- | Drain the queued batch without recording it. + +What 'flushBarriers' would have emitted, handed to the caller instead: the +seam for verifying the hooks' barriers without a device (see the test +suite's ownership-transfer group). +-} +takeBarriers :: (MonadIO m) => Recorder -> m Barriers +takeBarriers rec = liftIO (atomicModifyIORef' rec.pending \b -> (noBarriers, b)) + +{- | Record the pending batch as one @vkCmdPipelineBarrier@ into the current +buffer and clear it; a no-op when nothing is queued. + +The stage masks are the OR of every queued barrier's — a slightly wider (never +weaker) dependency than per-barrier commands, the price of batching. +-} +flushBarriers :: (MonadIO m) => Recorder -> m () +flushBarriers rec = liftIO do + -- Peek before draining: this runs once per import per pass, nearly always + -- on an empty batch, so the empty case must stay a plain read. + peeked <- readIORef rec.pending + case (peeked.images, peeked.buffers) of + ([], []) -> pure () + _ -> do + Barriers{srcStage, dstStage, images, buffers} <- takeBarriers rec + (_queue, cb) <- readIORef rec.slot + Vk.cmdPipelineBarrier cb srcStage dstStage zero [] (V.fromList buffers) (V.fromList images) + +-- | The command buffer the executing pass records into ('recorderCommandBuffer' of the 'FG.Exec' context). +recordingCommandBuffer :: FG.Exec Recorder alloc Vk.CommandBuffer +{-# INLINE recordingCommandBuffer #-} +recordingCommandBuffer = recorderCommandBuffer =<< FG.askCtx + +{- | A 'FG.QueueBackend' that routes each pass's recording to its queue's command +buffer (via @cbFor@) and does nothing else. + +The topology-agnostic core an 'FG.executeQueued' driver is built on: it only +points the 'Recorder' at the right buffer before each pass. The rest of a +schedule — timeline waits/signals, split-barrier events, queue-family ownership +— is the caller's to realise from 'FG.PassSync' / 'FG.snapshot' around it. On a +single-queue schedule @cbFor = const theOnlyBuffer@ and it degenerates to +recording everything into one buffer. +-} +recordingBackend :: Recorder -> (FG.QueueId -> Vk.CommandBuffer) -> FG.QueueBackend +recordingBackend recorder cbFor = + FG.QueueBackend + { FG.beforePass = \psync -> do + -- Chained marks are per-pass; a stale one would suppress a barrier. + clearChained recorder + setRecorder recorder psync.queue (cbFor psync.queue) + , FG.afterPass = \_ -> pure () + , FG.invoke = \_ body -> body + , FG.completed = pure [] + } + +{- | Record a compiled graph into the given per-queue command buffers: point a +fresh recorder at the first buffer, install the 'flushBarriers' flush, drive +'FG.executeQueued' (routing each pass to @cbFor@), then end every buffer. The +caller supplies only the submit that follows. + +Runs without a 'FG.RecycleQueue': import-only adapters never retire a +resource, so there is nothing to reclaim (allocate transients in the frame's own +resource scope instead). The first buffer is the primary the recorder starts on; +all buffers are ended. +-} +recordGraph + :: (MonadIO m) + => (FG.QueueId -> Vk.CommandBuffer) + -> NonEmpty Vk.CommandBuffer + -> FG.FrameGraph Recorder () + -> m () +recordGraph cbFor buffers graph = void (recordGraphSyncs cbFor buffers graph) + +{- | 'recordGraph', handing back each executed pass's 'FG.PassSync'. + +In execution order, for a caller deriving its submits from the schedule +(see "Vulkan.Utils.FrameGraph.Driver" for the packaged one). +-} +recordGraphSyncs + :: (MonadIO m) + => (FG.QueueId -> Vk.CommandBuffer) + -> NonEmpty Vk.CommandBuffer + -> FG.FrameGraph Recorder () + -> m [FG.PassSync] +recordGraphSyncs cbFor buffers graph = do + recorder <- newRecorder (NE.head buffers) + syncs <- liftIO (newIORef []) + FG.addPreExec graph flushBarriers + -- The release hooks queue producer-side barriers after the pass body. + FG.addPostExec graph flushBarriers + let + routing = recordingBackend recorder cbFor + collecting = + routing + { FG.beforePass = \psync -> do + modifyIORef' syncs (psync :) + routing.beforePass psync + } + FG.executeQueued graph collecting Nothing recorder () + traverse_ Vk.endCommandBuffer buffers + liftIO (reverse <$> readIORef syncs) diff --git a/src/Vulkan/Utils/FrameGraph/Swapchain.hs b/src/Vulkan/Utils/FrameGraph/Swapchain.hs new file mode 100644 --- /dev/null +++ b/src/Vulkan/Utils/FrameGraph/Swapchain.hs @@ -0,0 +1,71 @@ +{-| Swapchain images as frame-graph imports. + +Every windowed frame graph ends the same way: some pass writes the acquired +swapchain image and it must reach @PRESENT_SRC@ before the present. +'newSwapchainImages' builds the persistent per-image 'ManagedImage' table, +'importSwapchain' imports the acquired image from it each frame, and +'presentSwapchain' appends the terminal pass. Skipping the terminal pass (or +reading instead of writing) presents the image stuck in the last writer's +layout, with nothing in the types to catch it. +-} +module Vulkan.Utils.FrameGraph.Swapchain + ( newSwapchainImages + , forgetSwapchainImages + , importSwapchain + , presentSwapchain + ) where + +import Control.Monad.IO.Class (MonadIO) +import Data.Foldable (traverse_) +import Data.Vector (Vector) +import Data.Vector qualified as V +import Data.Word (Word32) + +import Fragr qualified as FG +import Vulkan.Core10 qualified as Vk +import Vulkan.Extensions.VK_KHR_surface qualified +import Vulkan.Utils.FrameGraph.Image (ManagedImage, SliceRegistry, Usage (Present), describedImage, forgetImage, importManagedImage) +import Vulkan.Utils.FrameGraph.Recorder (Recorder) +import Vulkan.Utils.Swapchain (Swapchain (..)) + +{- | Wrap each swapchain image in a layout-tracked 'ManagedImage'. + +The table persists for the swapchain's lifetime — the tracked layouts carry +across frames — so build it once per (re)created swapchain, next to the other +per-swapchain bindings. The images belong to the swapchain; the wrappers need +no release. +-} +newSwapchainImages :: (MonadIO m) => SliceRegistry -> Swapchain -> m (Vector ManagedImage) +newSwapchainImages reg sc = + traverse + (\image -> describedImage reg sc.sFormat.format sc.sExtent image Vk.IMAGE_ASPECT_COLOR_BIT) + sc.sImages + +{- | Drop this swapchain's image wrappers from the registry. + +A retiring swapchain's handles may be recycled into the next one's images; +call this next to 'newSwapchainImages' when recreating, so the old wrappers +are gone before the new table re-wraps whatever handles come back. +-} +forgetSwapchainImages :: (MonadIO m) => SliceRegistry -> Swapchain -> m () +forgetSwapchainImages reg sc = traverse_ (forgetImage reg) sc.sImages + +{- | Import the acquired image (as @swapchain@) into this frame's graph. + +Returns the handle for the graph's writes alongside the wrapper, whose +@.image@ the writing pass records into. +-} +importSwapchain :: (MonadIO m) => FG.FrameGraph Recorder () -> Vector ManagedImage -> Word32 -> m (FG.Handle ManagedImage, ManagedImage) +importSwapchain graph swapImages imageIndex = do + let mi = swapImages V.! fromIntegral imageIndex + h <- importManagedImage graph "swapchain" mi + pure (h, mi) + +{- | Terminal present pass over the written swapchain handle. + +'FG.finalize' registers a side-effecting pass on the writer's queue, so the +chain survives demand culling and the write hook brings the image to +@PRESENT_SRC@ — a no-op barrier when it is already there (an idle re-present). +-} +presentSwapchain :: (MonadIO m) => FG.FrameGraph Recorder () -> FG.Handle ManagedImage -> m () +presentSwapchain graph h = FG.finalize graph h Present diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,586 @@ +module Main (main) where + +import Control.Exception (ErrorCall, try) +import Control.Monad (void) +import Data.Bits ((.|.)) +import Data.IORef (IORef, modifyIORef', newIORef, readIORef) +import Data.IntMap.Strict qualified as IntMap +import Data.IntSet qualified as IntSet +import Data.List (sort, subsequences) +import Data.Word (Word32, Word64) +import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=)) + +import Fragr qualified as FG +import Vulkan.CStruct.Extends (SomeStruct (..)) +import Vulkan.Core10 qualified as Vk +import Vulkan.Utils.FrameGraph.Aliasing (Candidate (..), happensBefore, planAliases, scheduleOf) +import Vulkan.Utils.FrameGraph.Buffer (ManagedBuffer (..), newManagedBuffer) +import Vulkan.Utils.FrameGraph.Buffer qualified as Buffer +import Vulkan.Utils.FrameGraph.Image (ManagedImage (..), newManagedImage, newManagedImageLayer, newManagedImageMip, newSliceRegistry) +import Vulkan.Utils.FrameGraph.Image qualified as Image +import Vulkan.Utils.FrameGraph.Recorder (Barriers (..), Recorder, TransferSide (..), chainedNode, newRecorder, recorderQueue, recordingBackend, setRecorder, setRecorderFamilies, setRecorderHost, takeBarriers) +import Vulkan.Zero (zero) + +main :: IO () +main = defaultMain (testGroup "vulkan-utils-framegraph" [ordering, aliasing, exhaustive, slices, transfers, boundary]) + +---------------------------------------------------------------- +-- Slice wrap registry +---------------------------------------------------------------- + +{- | Expect the wrap to be rejected; touch @alive@ after, so the clashing +wrapper stays reachable through the check's garbage collection. +-} +rejectedOver :: ManagedImage -> IO ManagedImage -> IO () +rejectedOver alive wrap = + try @ErrorCall wrap >>= \case + Left _ -> void (readIORef alive.stateRef) + Right _ -> assertFailure "overlapping wrap accepted" + +img :: Vk.Image +img = Vk.Image 1 + +slices :: TestTree +slices = + testGroup + "slice wrap registry" + [ testCase "disjoint mips of one image wrap fine" do + reg <- newSliceRegistry + _ <- newManagedImageMip reg img Vk.IMAGE_ASPECT_COLOR_BIT 0 + void (newManagedImageMip reg img Vk.IMAGE_ASPECT_COLOR_BIT 1) + , testCase "a second wrapper over a live mip is fatal" do + reg <- newSliceRegistry + a <- newManagedImageMip reg img Vk.IMAGE_ASPECT_COLOR_BIT 0 + rejectedOver a (newManagedImageMip reg img Vk.IMAGE_ASPECT_COLOR_BIT 0) + , testCase "a whole-image wrapper clashes with a live mip" do + reg <- newSliceRegistry + a <- newManagedImageMip reg img Vk.IMAGE_ASPECT_COLOR_BIT 3 + rejectedOver a (newManagedImage reg img Vk.IMAGE_ASPECT_COLOR_BIT) + , testCase "disjoint aspects of one subresource wrap fine" do + reg <- newSliceRegistry + _ <- newManagedImage reg img Vk.IMAGE_ASPECT_DEPTH_BIT + void (newManagedImage reg img Vk.IMAGE_ASPECT_STENCIL_BIT) + , testCase "mip vs layer wrappers clash where they intersect" do + reg <- newSliceRegistry + -- Both cover (mip 0, layer 0). + a <- newManagedImageMip reg img Vk.IMAGE_ASPECT_COLOR_BIT 0 + rejectedOver a (newManagedImageLayer reg img Vk.IMAGE_ASPECT_COLOR_BIT 0) + , testCase "dropping the old wrapper legalizes the re-wrap" do + reg <- newSliceRegistry + void (newManagedImage reg img Vk.IMAGE_ASPECT_COLOR_BIT) + -- The registry collects before accusing, so the dropped wrapper's + -- entry dies here instead of poisoning the image forever. + void (newManagedImage reg img Vk.IMAGE_ASPECT_COLOR_BIT) + , -- The renderer-scope semantics: a new scope's registry owes nothing to + -- the old one's wrappers, even while they are still reachable. + testCase "a fresh registry accepts a handle another one holds live" do + old <- newSliceRegistry + a <- newManagedImage old img Vk.IMAGE_ASPECT_COLOR_BIT + reg <- newSliceRegistry + _ <- newManagedImage reg img Vk.IMAGE_ASPECT_COLOR_BIT + void (readIORef a.stateRef) + ] + +---------------------------------------------------------------- +-- Ownership transfer: the QFOT pair semantics, no device +---------------------------------------------------------------- + +-- | Queues 0 and 2 share family 0; queue 1 is family 1; queue 3 is the host. +family :: FG.QueueId -> Word32 +family (FG.QueueId q) = case q of + 0 -> 0 + 1 -> 1 + 2 -> 0 + _ -> Vk.QUEUE_FAMILY_IGNORED + +{- | A recorder over a null command buffer: the hooks' barriers are only ever +drained with 'takeBarriers', never flushed into it — so every hook call is +followed by a drain, keeping the batch's overlap flush unreachable. +-} +fakeRecorder :: IO Recorder +fakeRecorder = do + rec <- newRecorder zero + setRecorderFamilies rec family + pure rec + +onQueue :: Recorder -> Int -> IO () +onQueue rec q = setRecorder rec (FG.QueueId q) zero + +-- | Freshly wrapped (through @wrap@), brought to 'Image.ColorAttachment' on queue 0. +producedImageWith :: (ManagedImage -> ManagedImage) -> Recorder -> IO ManagedImage +producedImageWith wrap rec = do + reg <- newSliceRegistry + mi <- wrap <$> newManagedImage reg img Vk.IMAGE_ASPECT_COLOR_BIT + onQueue rec 0 + Image.queueTransition rec 0 mi Image.ColorAttachment + _ <- takeBarriers rec + pure mi + +producedImage :: Recorder -> IO ManagedImage +producedImage = producedImageWith id + +-- | Freshly wrapped and storage-written on queue 0. +producedBuffer :: Recorder -> IO ManagedBuffer +producedBuffer rec = do + mb <- newManagedBuffer buf + onQueue rec 0 + Buffer.queueTransition rec 0 mb storageWrite + _ <- takeBarriers rec + pure mb + +buf :: Vk.Buffer +buf = Vk.Buffer 2 + +-- | The batch's single image barrier: (families, layouts, access masks). +imageHalf :: Barriers -> IO ((Word32, Word32), (Vk.ImageLayout, Vk.ImageLayout), (Vk.AccessFlags, Vk.AccessFlags)) +imageHalf b = case b.images of + [SomeStruct ib] -> + pure + ( (ib.srcQueueFamilyIndex, ib.dstQueueFamilyIndex) + , (ib.oldLayout, ib.newLayout) + , (ib.srcAccessMask, ib.dstAccessMask) + ) + bs -> assertFailure ("expected one image barrier, got " <> show (length bs)) + +-- | The batch's single buffer barrier: (families, access masks). +bufferHalf :: Barriers -> IO ((Word32, Word32), (Vk.AccessFlags, Vk.AccessFlags)) +bufferHalf b = case b.buffers of + [SomeStruct bb] -> + pure + ( (bb.srcQueueFamilyIndex, bb.dstQueueFamilyIndex) + , (bb.srcAccessMask, bb.dstAccessMask) + ) + bs -> assertFailure ("expected one buffer barrier, got " <> show (length bs)) + +sampled :: Image.Usage +sampled = Image.Sampled Vk.PIPELINE_STAGE_FRAGMENT_SHADER_BIT + +storage :: Image.Usage +storage = Image.StorageRead Vk.PIPELINE_STAGE_COMPUTE_SHADER_BIT + +storageWrite :: Buffer.Usage +storageWrite = Buffer.StorageWrite Vk.PIPELINE_STAGE_COMPUTE_SHADER_BIT + +storageRead :: Buffer.Usage +storageRead = Buffer.StorageRead Vk.PIPELINE_STAGE_COMPUTE_SHADER_BIT + +transfers :: TestTree +transfers = + testGroup + "ownership transfer" + [ testCase "an owned hand-off records matching release/acquire halves" do + rec <- fakeRecorder + mi <- producedImage rec + Image.transferOwnership Release rec 7 (FG.QueueId 1) mi sampled + (relFams, relLayouts, relAccess) <- imageHalf =<< takeBarriers rec + relFams @?= (0, 1) + relLayouts @?= (Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, Vk.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL) + relAccess @?= (Vk.ACCESS_COLOR_ATTACHMENT_READ_BIT .|. Vk.ACCESS_COLOR_ATTACHMENT_WRITE_BIT, zero) + -- The release performs the transition; the slot keeps the state it saw. + readIORef mi.releasedRef >>= (@?= Just (Image.usageState Image.ColorAttachment)) + readIORef mi.stateRef >>= (@?= Image.usageState sampled) + onQueue rec 1 + Image.transferOwnership Acquire rec 7 (FG.QueueId 0) mi sampled + (acqFams, acqLayouts, acqAccess) <- imageHalf =<< takeBarriers rec + -- The spec wants the halves identical up to the ignored scopes. + acqFams @?= relFams + acqLayouts @?= relLayouts + acqAccess @?= (zero, Vk.ACCESS_SHADER_READ_BIT) + readIORef mi.releasedRef >>= (@?= Nothing) + readIORef mi.queueRef >>= (@?= Just (FG.QueueId 1)) + chainedNode rec 7 >>= assertBool "the acquire marks the node chained" + , testCase "a melted acquire leaves the hand-off for a pending owned one" do + rec <- fakeRecorder + mi <- producedImage rec + -- One version, two transfers: a host readback plus an owned hand-off + -- to family 1 — the shape a host + device fan-out compiles to. + Image.transferOwnership Release rec 7 (FG.QueueId 3) mi Image.HostRead + _ <- takeBarriers rec + Image.transferOwnership Release rec 8 (FG.QueueId 1) mi storage + (relFams, relLayouts, _) <- imageHalf =<< takeBarriers rec + relFams @?= (0, 1) + -- The host's melted acquire must not spend the slot the owned one needs. + setRecorderHost rec (FG.QueueId 3) + Image.transferOwnership Acquire rec 7 (FG.QueueId 0) mi Image.HostRead + readIORef mi.releasedRef >>= (@?= Just (Image.usageState Image.HostRead)) + onQueue rec 1 + Image.transferOwnership Acquire rec 8 (FG.QueueId 0) mi storage + (acqFams, acqLayouts, _) <- imageHalf =<< takeBarriers rec + acqFams @?= relFams + acqLayouts @?= relLayouts + readIORef mi.releasedRef >>= (@?= Nothing) + , testCase "a late host acquire does not rewind the device tracking" do + rec <- fakeRecorder + mi <- producedImage rec + -- The same fan-out, but hooks in the Driver's real order: it defers + -- host passes, so the owned acquire lands before the host's melted one. + Image.transferOwnership Release rec 7 (FG.QueueId 3) mi Image.HostRead + _ <- takeBarriers rec + Image.transferOwnership Release rec 8 (FG.QueueId 1) mi storage + _ <- takeBarriers rec + onQueue rec 1 + Image.transferOwnership Acquire rec 8 (FG.QueueId 0) mi storage + _ <- takeBarriers rec + setRecorderHost rec (FG.QueueId 3) + Image.transferOwnership Acquire rec 7 (FG.QueueId 0) mi Image.HostRead + readIORef mi.stateRef >>= (@?= Image.usageState storage) + readIORef mi.queueRef >>= (@?= Just (FG.QueueId 1)) + , testCase "an owned acquire without its release half is fatal" do + rec <- fakeRecorder + mi <- producedImage rec + Image.transferOwnership Release rec 7 (FG.QueueId 1) mi sampled + _ <- takeBarriers rec + onQueue rec 1 + Image.transferOwnership Acquire rec 7 (FG.QueueId 0) mi sampled + _ <- takeBarriers rec + -- The slot is single-use: a duplicate acquire cannot replay the + -- consumed hand-off, and recording a guessed half would be worse. + try @ErrorCall (Image.transferOwnership Acquire rec 8 (FG.QueueId 0) mi sampled) >>= \case + Left _ -> pure () + Right () -> assertFailure "an unpaired owned acquire was accepted" + , testCase "a CONCURRENT hand-off is a producer-side transition, no families named" do + rec <- fakeRecorder + mi <- producedImageWith Image.sharedAcrossQueues rec + Image.transferOwnership Release rec 7 (FG.QueueId 1) mi sampled + (fams, layouts, _) <- imageHalf =<< takeBarriers rec + fams @?= (Vk.QUEUE_FAMILY_IGNORED, Vk.QUEUE_FAMILY_IGNORED) + layouts @?= (Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, Vk.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL) + onQueue rec 1 + Image.transferOwnership Acquire rec 7 (FG.QueueId 0) mi sampled + acq <- takeBarriers rec + assertBool "the acquire half melts" (null acq.images) + , testCase "a same-family hop chains to the semaphore, keeping contents" do + rec <- fakeRecorder + mi <- producedImage rec + onQueue rec 2 + Image.queueTransition rec 1 mi sampled + (fams, layouts, access) <- imageHalf =<< takeBarriers rec + fams @?= (Vk.QUEUE_FAMILY_IGNORED, Vk.QUEUE_FAMILY_IGNORED) + layouts @?= (Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, Vk.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL) + -- The semaphore already made the writes available. + fst access @?= zero + , testCase "a cross-family write acquires by discarding" do + rec <- fakeRecorder + mi <- producedImage rec + onQueue rec 1 + Image.queueTransition rec 1 mi Image.TransferDst + (fams, layouts, _) <- imageHalf =<< takeBarriers rec + fams @?= (Vk.QUEUE_FAMILY_IGNORED, Vk.QUEUE_FAMILY_IGNORED) + layouts @?= (Vk.IMAGE_LAYOUT_UNDEFINED, Vk.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL) + , testCase "a cross-family read of an unshared image is fatal" do + rec <- fakeRecorder + mi <- producedImage rec + onQueue rec 1 + try @ErrorCall (Image.queueTransition rec 1 mi sampled) >>= \case + Left _ -> pure () + Right () -> assertFailure "an unhanded cross-family read was accepted" + , testCase "the buffer pair mirrors the image rules, minus layout" do + rec <- fakeRecorder + mb <- producedBuffer rec + Buffer.transferOwnership Release rec 7 (FG.QueueId 1) mb storageRead + (relFams, relAccess) <- bufferHalf =<< takeBarriers rec + relFams @?= (0, 1) + relAccess @?= (Vk.ACCESS_SHADER_WRITE_BIT, zero) + readIORef mb.releasedRef >>= (@?= Just (Buffer.usageState storageWrite)) + onQueue rec 1 + Buffer.transferOwnership Acquire rec 7 (FG.QueueId 0) mb storageRead + (acqFams, acqAccess) <- bufferHalf =<< takeBarriers rec + acqFams @?= relFams + acqAccess @?= (zero, Vk.ACCESS_SHADER_READ_BIT) + readIORef mb.releasedRef >>= (@?= Nothing) + readIORef mb.queueRef >>= (@?= Just (FG.QueueId 1)) + , testCase "a melted buffer release records nothing but arms the slot" do + rec <- fakeRecorder + mb <- producedBuffer rec + -- No layout to move: a same-family release is pure bookkeeping. + Buffer.transferOwnership Release rec 7 (FG.QueueId 2) mb storageRead + melted <- takeBarriers rec + assertBool "a same-family release records no barrier" (null melted.buffers) + onQueue rec 2 + Buffer.transferOwnership Acquire rec 7 (FG.QueueId 0) mb storageRead + readIORef mb.releasedRef >>= (@?= Just (Buffer.usageState storageWrite)) + ] + +---------------------------------------------------------------- +-- Frame-boundary ownership: importOwned* driven end to end, no device +---------------------------------------------------------------- + +{- | A graph collecting every non-empty barrier batch as (queue, batch). +The drains are installed /before/ the import claims the flush slot, so +'Vulkan.Utils.FrameGraph.Recorder.flushBarriers' always finds an empty +batch and the zero command buffer is never recorded into. +-} +drainingGraph :: IO (FG.FrameGraph Recorder (), IORef [(FG.QueueId, Barriers)]) +drainingGraph = do + g <- FG.newFrameGraph @Recorder @() + batches <- newIORef [] + let drain r = do + q <- recorderQueue r + b <- takeBarriers r + case (b.images, b.buffers) of + ([], []) -> pure () + _ -> modifyIORef' batches ((q, b) :) + FG.addPreExec g drain + FG.addPostExec g drain + pure (g, batches) + +runBoundary :: Recorder -> FG.FrameGraph Recorder () -> [(FG.QueueId, FG.FamilyId)] -> IO () +runBoundary rec g partition = do + FG.compileWith partition g + FG.executeQueued g (recordingBackend rec (const zero)) Nothing rec () + +-- | The collected batches: an acquire on top of the release it consumed. +boundaryPair :: IORef [(FG.QueueId, Barriers)] -> IO ((FG.QueueId, Barriers), (FG.QueueId, Barriers)) +boundaryPair batches = + readIORef batches >>= \case + [acq, rel] -> pure (rel, acq) + bs -> assertFailure ("expected the release and acquire halves, got " <> show (length bs)) + +boundary :: TestTree +boundary = + testGroup + "frame-boundary ownership" + [ testCase "an owned image import pairs a foreign first read across frames" do + rec <- fakeRecorder + mi <- producedImage rec + (g, batches) <- drainingGraph + h <- Image.importOwnedImage g "ext" mi + _ <- FG.addPass g "Sample" (FG.setQueue (FG.QueueId 1) *> FG.readWith h sampled *> FG.setSideEffect) (\_ -> pure ()) + runBoundary rec g [(FG.QueueId 0, FG.FamilyId 0), (FG.QueueId 1, FG.FamilyId 1)] + ((qr, rel), (qa, acq)) <- boundaryPair batches + qr @?= FG.QueueId 0 + qa @?= FG.QueueId 1 + (relFams, relLayouts, _) <- imageHalf rel + (acqFams, acqLayouts, _) <- imageHalf acq + relFams @?= (0, 1) + acqFams @?= relFams + relLayouts @?= (Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, Vk.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL) + acqLayouts @?= relLayouts + readIORef mi.releasedRef >>= (@?= Nothing) + readIORef mi.queueRef >>= (@?= Just (FG.QueueId 1)) + , testCase "the pair melts within the owner's family" do + rec <- fakeRecorder + mi <- producedImage rec + (g, batches) <- drainingGraph + h <- Image.importOwnedImage g "ext" mi + _ <- FG.addPass g "Sample" (FG.setQueue (FG.QueueId 2) *> FG.readWith h sampled *> FG.setSideEffect) (\_ -> pure ()) + runBoundary rec g [(FG.QueueId 0, FG.FamilyId 0), (FG.QueueId 2, FG.FamilyId 0)] + readIORef batches >>= \case + [(q, rel)] -> do + q @?= FG.QueueId 0 + (fams, layouts, _) <- imageHalf rel + -- A same-family hand-off is a producer-side transition, no QFOT. + fams @?= (Vk.QUEUE_FAMILY_IGNORED, Vk.QUEUE_FAMILY_IGNORED) + layouts @?= (Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, Vk.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL) + bs -> assertFailure ("expected one melted release, got " <> show (length bs)) + , testCase "an untouched wrapper imports plainly" do + rec <- fakeRecorder + reg <- newSliceRegistry + mi <- newManagedImage reg img Vk.IMAGE_ASPECT_COLOR_BIT + (g, batches) <- drainingGraph + h <- Image.importOwnedImage g "ext" mi + _ <- FG.addPass g "Draw" (FG.setQueue (FG.QueueId 1) *> FG.writeWith_ h Image.ColorAttachment) (\_ -> pure ()) + runBoundary rec g [(FG.QueueId 0, FG.FamilyId 0), (FG.QueueId 1, FG.FamilyId 1)] + readIORef batches >>= \case + [(q, b)] -> do + q @?= FG.QueueId 1 + (fams, layouts, _) <- imageHalf b + fams @?= (Vk.QUEUE_FAMILY_IGNORED, Vk.QUEUE_FAMILY_IGNORED) + layouts @?= (Vk.IMAGE_LAYOUT_UNDEFINED, Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL) + bs -> assertFailure ("expected one plain transition, got " <> show (length bs)) + , testCase "an owned buffer import pairs the same way, minus layout" do + rec <- fakeRecorder + mb <- producedBuffer rec + (g, batches) <- drainingGraph + h <- Buffer.importOwnedBuffer g "ext" mb + _ <- FG.addPass g "ReadBack" (FG.setQueue (FG.QueueId 1) *> FG.readWith h storageRead *> FG.setSideEffect) (\_ -> pure ()) + runBoundary rec g [(FG.QueueId 0, FG.FamilyId 0), (FG.QueueId 1, FG.FamilyId 1)] + ((qr, rel), (qa, acq)) <- boundaryPair batches + qr @?= FG.QueueId 0 + qa @?= FG.QueueId 1 + (relFams, relAccess) <- bufferHalf rel + (acqFams, acqAccess) <- bufferHalf acq + relFams @?= (0, 1) + acqFams @?= relFams + relAccess @?= (Vk.ACCESS_SHADER_WRITE_BIT, zero) + acqAccess @?= (zero, Vk.ACCESS_SHADER_READ_BIT) + readIORef mb.queueRef >>= (@?= Just (FG.QueueId 1)) + ] + +---------------------------------------------------------------- +-- Exhaustive: every small schedule, against an independent oracle +---------------------------------------------------------------- + +{- | Every schedule of @n@ passes over @q@ queues, with every combination of +waits — a pass may wait each foreign queue's current watermark, or not. + +That is the whole space the compiler can hand us at this size, so the checks +below are not samples: they are closed over it. +-} +schedules :: Int -> Int -> [[FG.PassSync]] +schedules n q = go 0 (replicate q 0) [] + where + go i counters acc + | i == n = [reverse acc] + | otherwise = do + queue <- [0 .. q - 1] + -- Wait on any subset of the other queues' latest signals. + waitMask <- subsequences [j | j <- [0 .. q - 1], j /= queue] + let + signal = (counters !! queue) + 1 + counters' = [if j == queue then signal else c | (j, c) <- zip [0 ..] counters] + waits = [(j, counters !! j) | j <- waitMask, counters !! j > 0] + go (i + 1) counters' (pass i queue signal waits : acc) + +{- | The relation, derived a second way: build the edges explicitly and take +their transitive closure. Deliberately unlike the vector clock it checks — +an oracle that shared the implementation would prove nothing. +-} +oracle :: [FG.PassSync] -> Int -> Int -> Bool +oracle syncs = \i j -> IntSet.member i (IntMap.findWithDefault IntSet.empty j reach) + where + indexed = zip [0 ..] syncs + -- Direct predecessors: the previous pass on the same queue, and every + -- pass whose signal a wait names at or below its watermark. + preds s = + [ i + | (i, p) <- indexed + , p.queue == s.queue && p.signal < s.signal + || or [p.queue == w.queue && p.signal <= w.value | w <- s.waits] + ] + -- Transitive closure, accumulated in position order: every predecessor is + -- at an earlier position, so its own reach set is already in the map. + reach = foldl step IntMap.empty indexed + step m (j, s) = + let ps = preds s + in IntMap.insert j (IntSet.unions (IntSet.fromList ps : [IntMap.findWithDefault IntSet.empty i m | i <- ps])) m + +exhaustive :: TestTree +exhaustive = + testGroup + "exhaustive (5 passes, 3 queues, all wait combinations)" + [ testCase "happensBefore agrees with the closure oracle everywhere" do + let bad = + [ (syncs, i, j) + | syncs <- schedules 5 3 + , let s = scheduleOf syncs + , let ref = oracle syncs + , i <- [0 .. 4] + , j <- [0 .. 4] + , happensBefore s i j /= ref i j + ] + assertBool (show (take 1 bad)) (null bad) + , -- The invariant the whole feature rests on: anything the planner puts in + -- one block must be pairwise ordered, so the tenancies cannot overlap. + testCase "every planned group is pairwise ordered" do + let bad = + [ (syncs, x, y) + | syncs <- schedules 5 3 + , let s = scheduleOf syncs + , -- One entry per pass, plus a long-lived one spanning the run. + cs <- [[Candidate i (i, i) | i <- [0 .. 4]], [Candidate 9 (0, 4), Candidate 0 (1, 1), Candidate 1 (2, 3)]] + , g <- planAliases s cs + , x <- g + , y <- g + , x /= y + , not (happensBefore s (snd x.live) (fst y.live)) + , not (happensBefore s (snd y.live) (fst x.live)) + ] + assertBool (show (take 1 bad)) (null bad) + ] + +-- A pass on a queue, signalling a value, waiting on foreign queues. +pass :: Int -> Int -> Word64 -> [(Int, Word64)] -> FG.PassSync +pass pid queue signal waits = + FG.PassSync + { FG.passId = pid + , FG.name = "p" + , FG.queue = FG.QueueId queue + , FG.waits = [FG.Wait{FG.queue = FG.QueueId q, FG.value = v, FG.covers = []} | (q, v) <- waits] + , FG.signal = signal + , FG.waitEvents = [] + , FG.signalEvents = [] + , FG.acquires = [] + , FG.releases = [] + } + +groupIds :: [[Candidate]] -> [[Int]] +groupIds = sort . map (map (.entryId)) + +ordering :: TestTree +ordering = + testGroup + "happensBefore" + [ testCase "submission order on one queue" do + let s = scheduleOf [pass 0 0 1 [], pass 1 0 2 []] + assertBool "0 before 1" (happensBefore s 0 1) + assertBool "1 not before 0" (not (happensBefore s 1 0)) + , testCase "a pass is not before itself" do + let s = scheduleOf [pass 0 0 1 []] + assertBool "irreflexive" (not (happensBefore s 0 0)) + , -- The case positions alone get wrong: two queues, no wait between them. + -- Position 0 precedes position 1, but they run concurrently. + testCase "concurrent queues are unordered despite positions" do + let s = scheduleOf [pass 0 0 1 [], pass 1 1 1 []] + assertBool "0 not before 1" (not (happensBefore s 0 1)) + assertBool "1 not before 0" (not (happensBefore s 1 0)) + , testCase "a wait orders across queues" do + -- q1's pass waits for q0's value 1. + let s = scheduleOf [pass 0 0 1 [], pass 1 1 1 [(0, 1)]] + assertBool "0 before 1" (happensBefore s 0 1) + assertBool "1 not before 0" (not (happensBefore s 1 0)) + , testCase "ordering is transitive through a third queue" do + -- q0:p0 -> q1:p1 (waits q0) -> q2:p2 (waits q1). p0 must precede p2. + let s = scheduleOf [pass 0 0 1 [], pass 1 1 1 [(0, 1)], pass 2 2 1 [(1, 1)]] + assertBool "0 before 2 transitively" (happensBefore s 0 2) + assertBool "2 not before 0" (not (happensBefore s 2 0)) + , testCase "a wait on a later value still orders the earlier pass" do + -- Watermarked waits name a value, not a pass: waiting q0's 2 must + -- also observe q0's pass that signalled 1. + let s = scheduleOf [pass 0 0 1 [], pass 1 0 2 [], pass 2 1 1 [(0, 2)]] + assertBool "0 before 2" (happensBefore s 0 2) + assertBool "1 before 2" (happensBefore s 1 2) + , testCase "a wait does not order passes after the signal" do + -- q1 waits q0's value 1; q0's *later* pass (value 2) is not ordered. + let s = scheduleOf [pass 0 0 1 [], pass 1 0 2 [], pass 2 1 1 [(0, 1)]] + assertBool "1 not before 2" (not (happensBefore s 1 2)) + ] + +aliasing :: TestTree +aliasing = + testGroup + "planAliases" + [ testCase "sequential lifetimes on one queue share a block" do + let + s = scheduleOf [pass 0 0 1 [], pass 1 0 2 [], pass 2 0 3 []] + cs = [Candidate 10 (0, 0), Candidate 11 (1, 2)] + groupIds (planAliases s cs) @?= [[10, 11]] + , testCase "overlapping lifetimes do not" do + let + s = scheduleOf [pass 0 0 1 [], pass 1 0 2 []] + cs = [Candidate 10 (0, 1), Candidate 11 (1, 1)] + groupIds (planAliases s cs) @?= [[10], [11]] + , -- The silent-corruption case: disjoint positions, concurrent queues. + testCase "disjoint positions on concurrent queues do NOT share" do + let + s = scheduleOf [pass 0 0 1 [], pass 1 1 1 []] + cs = [Candidate 10 (0, 0), Candidate 11 (1, 1)] + groupIds (planAliases s cs) @?= [[10], [11]] + , testCase "a wait makes the same two safe to share" do + let + s = scheduleOf [pass 0 0 1 [], pass 1 1 1 [(0, 1)]] + cs = [Candidate 10 (0, 0), Candidate 11 (1, 1)] + groupIds (planAliases s cs) @?= [[10, 11]] + , testCase "a group admits a third only if ordered against all of it" do + -- p0,p1,p2 on q0 (ordered); p3 on q1, unordered with everything. + let + s = scheduleOf [pass 0 0 1 [], pass 1 0 2 [], pass 2 0 3 [], pass 3 1 1 []] + cs = [Candidate 10 (0, 0), Candidate 11 (1, 1), Candidate 12 (2, 2), Candidate 13 (3, 3)] + groupIds (planAliases s cs) @?= [[10, 11, 12], [13]] + , testCase "groups come back in takeover order" do + let + s = scheduleOf [pass 0 0 1 [], pass 1 0 2 [], pass 2 0 3 []] + cs = [Candidate 12 (2, 2), Candidate 10 (0, 0), Candidate 11 (1, 1)] + map (map (.entryId)) (planAliases s cs) @?= [[10, 11, 12]] + ] diff --git a/vulkan-utils-framegraph.cabal b/vulkan-utils-framegraph.cabal new file mode 100644 --- /dev/null +++ b/vulkan-utils-framegraph.cabal @@ -0,0 +1,103 @@ +cabal-version: 2.2 + +-- This file has been generated from package.yaml by hpack version 0.39.6. +-- +-- see: https://github.com/sol/hpack + +name: vulkan-utils-framegraph +version: 0.1.0.0 +synopsis: Vulkan barrier-placement and resource adapter for the fragr frame graph +category: Graphics +homepage: https://github.com/haskell-game/vulkan#readme +bug-reports: https://github.com/haskell-game/vulkan/issues +maintainer: IC Rainbow +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + package.yaml + +source-repository head + type: git + location: https://github.com/haskell-game/vulkan + +library + exposed-modules: + Vulkan.Utils.FrameGraph.Aliasing + Vulkan.Utils.FrameGraph.Buffer + Vulkan.Utils.FrameGraph.Driver + Vulkan.Utils.FrameGraph.Image + Vulkan.Utils.FrameGraph.Recorder + Vulkan.Utils.FrameGraph.Swapchain + other-modules: + Paths_vulkan_utils_framegraph + autogen-modules: + Paths_vulkan_utils_framegraph + hs-source-dirs: + src + default-extensions: + BlockArguments + DerivingStrategies + DuplicateRecordFields + ImportQualifiedPost + LambdaCase + NamedFieldPuns + NoFieldSelectors + OverloadedLists + OverloadedRecordDot + OverloadedStrings + RecordWildCards + ScopedTypeVariables + StrictData + TypeApplications + TypeFamilies + ghc-options: -Wall + build-depends: + base >=4.16 && <5 + , containers + , fragr + , resourcet + , text + , transformers + , vector + , vulkan ==3.27.* + , vulkan-utils + default-language: Haskell2010 + +test-suite vulkan-utils-framegraph-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_vulkan_utils_framegraph + autogen-modules: + Paths_vulkan_utils_framegraph + hs-source-dirs: + test + default-extensions: + BlockArguments + DerivingStrategies + DuplicateRecordFields + ImportQualifiedPost + LambdaCase + NamedFieldPuns + NoFieldSelectors + OverloadedLists + OverloadedRecordDot + OverloadedStrings + RecordWildCards + ScopedTypeVariables + StrictData + TypeApplications + TypeFamilies + ghc-options: -Wall + build-depends: + base + , containers + , fragr + , tasty + , tasty-hunit + , vector + , vulkan + , vulkan-utils-framegraph + default-language: Haskell2010