From c0f8e88b99c97e738025343224d1bf01c1650dbc Mon Sep 17 00:00:00 2001 From: Jens Nolte Date: Wed, 5 Jun 2024 04:18:28 +0200 Subject: [PATCH] Remove redundant Borrowed disposer from ExternalBuffer --- .../src/Quasar/Wayland/Skia.hs | 80 +++++++++---------- .../src/Quasar/Wayland/Server/Surface.hs | 26 +++--- .../src/Quasar/Wayland/Shared/Surface.hs | 12 +-- quasar-wayland/src/Quasar/Wayland/Shm.hs | 37 ++++----- 4 files changed, 75 insertions(+), 80 deletions(-) diff --git a/quasar-wayland-skia/src/Quasar/Wayland/Skia.hs b/quasar-wayland-skia/src/Quasar/Wayland/Skia.hs index f4a1df5..e0d9983 100644 --- a/quasar-wayland-skia/src/Quasar/Wayland/Skia.hs +++ b/quasar-wayland-skia/src/Quasar/Wayland/Skia.hs @@ -192,13 +192,13 @@ instance Disposable (SkiaFrameState s) where getDisposer (SkiaFrameSparked disposer _) = disposer data SkiaFrameOp s - = SkiaFrameExternalDmabuf (Skia s) TDisposer (Rc ExternalDmabuf) + = SkiaFrameExternalDmabuf (Skia s) (Borrowed ExternalDmabuf) --- | SkiaFrameShaderOp --- | SkiaFrameExported (Rc (SkiaExportBuffer s)) | SkiaFrameSinglePixel SinglePixelBuffer instance Disposable (SkiaFrameOp s) where - getDisposer (SkiaFrameExternalDmabuf _ disposer rc) = getDisposer disposer <> getDisposer rc + getDisposer (SkiaFrameExternalDmabuf _ borrowed) = getDisposer borrowed getDisposer (SkiaFrameSinglePixel _) = mempty @@ -209,13 +209,13 @@ data SkiaRenderedFrame s -- Borrowed surface, i.e. a surface that is used by the frame and will be -- "returned" to the owner once the frame is destroyed. | SkiaRenderedFrameBorrowedSurface (Borrowed (SkiaSurface s)) - | SkiaRenderedFrameImportedDmabuf TDisposer (SkiaImage s) (Rc ExternalDmabuf) + | SkiaRenderedFrameImportedDmabuf (SkiaImage s) (Borrowed ExternalDmabuf) | SkiaRenderedFrameSinglePixel SinglePixelBuffer instance Disposable (SkiaRenderedFrame s) where getDisposer (SkiaRenderedFrameOwnedSurface surface) = getDisposer surface getDisposer (SkiaRenderedFrameBorrowedSurface rc) = getDisposer rc - getDisposer (SkiaRenderedFrameImportedDmabuf disposer image rc) = getDisposer disposer <> getDisposer image <> getDisposer rc + getDisposer (SkiaRenderedFrameImportedDmabuf image borrowed) = getDisposer image <> getDisposer borrowed getDisposer (SkiaRenderedFrameSinglePixel _) = mempty newtype SkiaClientBufferManager s = SkiaClientBufferManager { @@ -259,8 +259,7 @@ instance IsSkiaBackend s => ClientBufferBackend (Skia s) where pure (SkiaExportBufferIdUnique (skiaSurfaceKey surface)) getExportBufferId (SkiaRenderedFrameBorrowedSurface (Borrowed _ surface)) = pure (SkiaExportBufferIdUnique (skiaSurfaceKey surface)) - getExportBufferId (SkiaRenderedFrameImportedDmabuf _ _ rc) = do - (ExternalDmabuf key _) <- readRc rc + getExportBufferId (SkiaRenderedFrameImportedDmabuf _ (Borrowed _ (ExternalDmabuf key _))) = do pure (SkiaExportBufferIdUnique key) getExportBufferId (SkiaRenderedFrameSinglePixel pixel) = pure (SkiaExportBufferIdSinglePixel pixel) @@ -268,7 +267,7 @@ instance IsSkiaBackend s => ClientBufferBackend (Skia s) where exportWlBuffer manager renderedFrame = atomicallyC (getExportBuffer renderedFrame) >>= \case SkiaExportBufferSurface surface -> exportSkiaSurface manager surface - SkiaExportBufferImportedDmabuf (ExternalDmabuf _ (Borrowed _ dmabuf)) -> + SkiaExportBufferImportedDmabuf (ExternalDmabuf _ dmabuf) -> atomicallyC $ sharedDmabufExportWlBuffer manager.dmabufSingleton dmabuf SkiaExportBufferSinglePixel pixel -> undefined @@ -295,10 +294,8 @@ getExportBuffer (SkiaRenderedFrameOwnedSurface surface) = pure (SkiaExportBufferSurface surface) getExportBuffer (SkiaRenderedFrameBorrowedSurface (Borrowed _ surface)) = pure (SkiaExportBufferSurface surface) -getExportBuffer (SkiaRenderedFrameImportedDmabuf _ _ rc) = do - tryReadRc rc >>= \case - Nothing -> undefined - Just externalDmabuf -> pure (SkiaExportBufferImportedDmabuf externalDmabuf) +getExportBuffer (SkiaRenderedFrameImportedDmabuf _ (Borrowed _ externalDmabuf)) = do + pure (SkiaExportBufferImportedDmabuf externalDmabuf) getExportBuffer (SkiaRenderedFrameSinglePixel pixel) = pure (SkiaExportBufferSinglePixel pixel) @@ -318,22 +315,24 @@ renderFrameInternal frameRc = do Just (SkiaFrameLazy op) -> do frc <- cacheFuture =<< sparkFrameOp op disposer <- futureDisposerGeneric frc + -- Prevents the SkiaFrameOp from being disposed with the frame, which + -- is correct since ownership of the SkiaFrameOp has been passed to + -- `sparkFrameOp`. tryWriteDisposableVar var (SkiaFrameSparked disposer frc) pure frc renderedFrameRc <- await frc atomically do - tryDuplicateRc renderedFrameRc >>= \case - Nothing -> - -- We are holding an Rc (via `consumeRc`), which holds the SkiaFrame, - -- which holds the Rc for the SkiaRenderedFrame. If this exception - -- is encountered, someone somewhere disposed the SkiaFrame directly, - -- which is a bug. - throwC mkDisposedException - Just duplicatedRc -> pure duplicatedRc - + -- We are holding an Rc (via `consumeRc`), which holds the SkiaFrame, + -- which holds the Rc for the SkiaRenderedFrame. This path therefore + -- _should_ never throw an DisposedException. If this exception is + -- encountered, someone somewhere disposed the SkiaFrame directly + -- (ignoring the Rc-based shared ownership), which would be a bug. + duplicateRc renderedFrameRc + +-- Takes ownership of the SkiaFrameOp. sparkFrameOp :: IsSkiaBackend s => SkiaFrameOp s -> STM (Future '[AsyncException] (Rc (SkiaRenderedFrame s))) -sparkFrameOp (SkiaFrameExternalDmabuf skia frameRelease rc) = - queueSkiaIO skia.thread (importDmabuf skia frameRelease rc) +sparkFrameOp (SkiaFrameExternalDmabuf skia borrowedExternalBuffer) = + queueSkiaIO skia.thread (importDmabuf skia borrowedExternalBuffer) sparkFrameOp (SkiaFrameSinglePixel singlePixelBuffer) = pure <$> newRc (SkiaRenderedFrameSinglePixel singlePixelBuffer) @@ -370,14 +369,12 @@ instance Disposable ExternalShmBuffer where instance IsSkiaBackend s => IsBufferBackend ShmBuffer (Skia s) where type ExternalBuffer ShmBuffer (Skia s) = ExternalShmBuffer - newExternalBuffer :: Skia s -> Borrowed ShmBuffer -> STMc NoRetry '[] ExternalShmBuffer - newExternalBuffer _skia dmabuf = undefined - --key <- newUniqueSTM - --pure (ExternalDmabuf key dmabuf) + newExternalBuffer :: Skia s -> ShmBuffer -> STMc NoRetry '[] ExternalShmBuffer + newExternalBuffer _skia shmBuffer = undefined + + createExternalBufferFrame :: Skia s -> Borrowed ExternalShmBuffer -> STMc NoRetry '[] (SkiaFrame s) + createExternalBufferFrame skia borrowed = undefined - createExternalBufferFrame :: Skia s -> TDisposer -> Rc ExternalShmBuffer -> STMc NoRetry '[] (SkiaFrame s) - createExternalBufferFrame skia tdisposer rc = undefined - --newSkiaFrame (SkiaFrameExternalDmabuf skia tdisposer rc) @@ -387,33 +384,30 @@ data SkiaDmabufProperties = SkiaDmabufProperties { feedback :: CompiledDmabufFeedback } -data ExternalDmabuf = ExternalDmabuf Unique (Borrowed Dmabuf) +data ExternalDmabuf = ExternalDmabuf Unique Dmabuf instance Disposable ExternalDmabuf where - getDisposer (ExternalDmabuf key borrow) = getDisposer borrow + getDisposer (ExternalDmabuf _ borrow) = getDisposer borrow instance IsSkiaBackend s => IsBufferBackend Dmabuf (Skia s) where type ExternalBuffer Dmabuf (Skia s) = ExternalDmabuf - newExternalBuffer :: Skia s -> Borrowed Dmabuf -> STMc NoRetry '[] ExternalDmabuf + newExternalBuffer :: Skia s -> Dmabuf -> STMc NoRetry '[] ExternalDmabuf newExternalBuffer _skia dmabuf = do key <- newUniqueSTM pure (ExternalDmabuf key dmabuf) - createExternalBufferFrame :: Skia s -> TDisposer -> Rc ExternalDmabuf -> STMc NoRetry '[] (SkiaFrame s) - createExternalBufferFrame skia tdisposer rc = do - newSkiaFrame (SkiaFrameExternalDmabuf skia tdisposer rc) + createExternalBufferFrame :: Skia s -> Borrowed ExternalDmabuf -> STMc NoRetry '[] (SkiaFrame s) + createExternalBufferFrame skia borrowed = do + newSkiaFrame (SkiaFrameExternalDmabuf skia borrowed) -importDmabuf :: IsSkiaBackend s => Skia s -> TDisposer -> Rc ExternalDmabuf -> SkiaIO (Rc (SkiaRenderedFrame s)) -importDmabuf skia frameRelease rc = do - atomicallyC (tryReadRc rc) >>= \case - Nothing -> undefined - Just (ExternalDmabuf _ (Borrowed _ dmabuf)) -> do - skImage <- skiaImportDmabuf skia dmabuf - skiaImage <- liftIO $ newSkiaImage skia skImage +importDmabuf :: IsSkiaBackend s => Skia s -> Borrowed ExternalDmabuf -> SkiaIO (Rc (SkiaRenderedFrame s)) +importDmabuf skia x@(Borrowed _ (ExternalDmabuf _ dmabuf)) = do + skImage <- skiaImportDmabuf skia dmabuf + skiaImage <- liftIO $ newSkiaImage skia skImage - liftIO $ newRcIO (SkiaRenderedFrameImportedDmabuf frameRelease skiaImage rc) + liftIO $ newRcIO (SkiaRenderedFrameImportedDmabuf skiaImage x) newSkiaImage :: Skia s -> Ptr SkImage -> IO (SkiaImage s) diff --git a/quasar-wayland/src/Quasar/Wayland/Server/Surface.hs b/quasar-wayland/src/Quasar/Wayland/Server/Surface.hs index 16a4002..d75465b 100644 --- a/quasar-wayland/src/Quasar/Wayland/Server/Surface.hs +++ b/quasar-wayland/src/Quasar/Wayland/Server/Surface.hs @@ -12,6 +12,7 @@ module Quasar.Wayland.Server.Surface ( ) where import Control.Monad.Catch +import Quasar.Exceptions import Quasar.Prelude import Quasar.Resources import Quasar.Resources.Rc @@ -53,7 +54,7 @@ data MappedServerSurface b = MappedServerSurface { data ServerBuffer b = ServerBuffer { wlBuffer :: Object 'Server Interface_wl_buffer, - createFrame :: TDisposer -> STMc NoRetry '[] (Frame b) + createFrame :: TDisposer -> STMc NoRetry '[DisposedException] (Frame b) } newServerSurface :: STMc NoRetry '[] (ServerSurface b) @@ -223,7 +224,7 @@ initializeWlBuffer :: buffer -> STMc NoRetry '[] () initializeWlBuffer backend wlBuffer buffer = do - mappedBuffer <- newExternalBuffer backend (Borrowed (getDisposer buffer) buffer) + mappedBuffer <- newExternalBuffer backend buffer rc <- newRc mappedBuffer let serverBuffer = ServerBuffer { wlBuffer, @@ -234,19 +235,24 @@ initializeWlBuffer backend wlBuffer buffer = do destroy = pure () } -- TODO This removes back pressure for released buffers. We should await the - -- @unmapBufferDisposer@ somewhere in the chain of new buffer allocations. + -- disposer somewhere in the chain of new buffer allocations. -- The best place would probably be to delay the frame callback, but I'm not - -- sure how to do that properly and cleanly. + -- sure how to do that in a clean way. + -- We don't want to delay the whole rendering backend (since that could be + -- rendering content for/from multiple clients). attachOrRunFinalizer wlBuffer (disposeEventually_ rc) where + createFrameImpl :: Rc (ExternalBuffer buffer backend) -> TDisposer -> STMc NoRetry '[DisposedException] (Frame backend) createFrameImpl rc frameRelease = do - tryDuplicateRc rc >>= \case - Nothing -> - -- Frame was created from an unmapped buffer, which would probably be - -- a bug somewhere in this module. - undefined - Just dupedRc -> createExternalBufferFrame @buffer @backend backend frameRelease dupedRc + -- If duplicating the frame rc fails, the frame was created from an + -- unmapped buffer, which would probably be a bug somewhere in this module. + dupedRc <- duplicateRc rc + externalBuffer <- readRc dupedRc + let combinedRelease = getDisposer frameRelease <> getDisposer dupedRc + liftSTMc do + createExternalBufferFrame @buffer @backend backend + (Borrowed combinedRelease externalBuffer) getServerBuffer :: forall b. RenderBackend b => Object 'Server Interface_wl_buffer -> STMc NoRetry '[SomeException] (ServerBuffer b) diff --git a/quasar-wayland/src/Quasar/Wayland/Shared/Surface.hs b/quasar-wayland/src/Quasar/Wayland/Shared/Surface.hs index 16cd4a8..2c48a7f 100644 --- a/quasar-wayland/src/Quasar/Wayland/Shared/Surface.hs +++ b/quasar-wayland/src/Quasar/Wayland/Shared/Surface.hs @@ -35,11 +35,12 @@ class (RenderBackend backend, Disposable (ExternalBuffer buffer backend)) => IsB type ExternalBuffer buffer backend -- | Import an external buffer. The buffer may be mutable shared memory. -- - -- Takes ownership of the provided `Borrowed`-object. + -- Takes ownership of the provided buffer object (the buffer has to be + -- by the ExternalBuffer when that is disposed). -- -- Ownership of the resulting @ExternalBuffer@-object is transferred to the -- caller, who will `dispose` it later. - newExternalBuffer :: backend -> Borrowed buffer -> STMc NoRetry '[] (ExternalBuffer buffer backend) + newExternalBuffer :: Disposable buffer => backend -> buffer -> STMc NoRetry '[] (ExternalBuffer buffer backend) -- | Create a frame from an @ExternalBuffer@. -- @@ -48,7 +49,7 @@ class (RenderBackend backend, Disposable (ExternalBuffer buffer backend)) => IsB -- -- Ownership of the `ExternalBuffer` rc is transferred to the frame, it has -- to be disposed when the frame is disposed. - createExternalBufferFrame :: backend -> TDisposer -> Rc (ExternalBuffer buffer backend) -> STMc NoRetry '[] (Frame backend) + createExternalBufferFrame :: backend -> Borrowed (ExternalBuffer buffer backend) -> STMc NoRetry '[] (Frame backend) -- | Create a new frame by taking ownership of a buffer. The buffer will be @@ -57,9 +58,8 @@ class (RenderBackend backend, Disposable (ExternalBuffer buffer backend)) => IsB -- The caller takes ownership of the resulting frame. newFrameConsumeBuffer :: forall buffer backend. (IsBufferBackend buffer backend, Disposable buffer) => backend -> buffer -> STMc NoRetry '[] (Frame backend) newFrameConsumeBuffer backend buffer = do - externalBuffer <- newExternalBuffer backend (Borrowed (getDisposer buffer) buffer) - rc <- newRc externalBuffer - createExternalBufferFrame @buffer backend mempty rc + externalBuffer <- newExternalBuffer backend buffer + createExternalBufferFrame @buffer backend (Borrowed (getDisposer externalBuffer) externalBuffer) data Damage = DamageAll | DamageList [Rectangle] diff --git a/quasar-wayland/src/Quasar/Wayland/Shm.hs b/quasar-wayland/src/Quasar/Wayland/Shm.hs index cb01dc7..893ee4b 100644 --- a/quasar-wayland/src/Quasar/Wayland/Shm.hs +++ b/quasar-wayland/src/Quasar/Wayland/Shm.hs @@ -29,10 +29,10 @@ import Quasar.Wayland.Utils.Resources -- | Simple buffer backend that only supports shared memory buffers. data ShmBufferBackend = ShmBufferBackend -data ShmBufferFrame = ShmBufferFrame TDisposer (Rc (Borrowed ShmBuffer)) +newtype ShmBufferFrame = ShmBufferFrame (Borrowed ShmBuffer) instance Disposable ShmBufferFrame where - getDisposer (ShmBufferFrame tdisposer rc) = getDisposer tdisposer <> getDisposer rc + getDisposer (ShmBufferFrame borrowed) = getDisposer borrowed instance RenderBackend ShmBufferBackend where type Frame ShmBufferBackend = ShmBufferFrame @@ -40,12 +40,12 @@ instance RenderBackend ShmBufferBackend where type IsShmBufferBackend b = IsBufferBackend ShmBuffer b instance IsBufferBackend ShmBuffer ShmBufferBackend where - type ExternalBuffer ShmBuffer ShmBufferBackend = Borrowed ShmBuffer - newExternalBuffer :: ShmBufferBackend -> Borrowed ShmBuffer -> STMc NoRetry '[] (Borrowed ShmBuffer) - newExternalBuffer ShmBufferBackend borrowed = pure borrowed - createExternalBufferFrame :: ShmBufferBackend -> TDisposer -> Rc (Borrowed ShmBuffer) -> STMc NoRetry '[] ShmBufferFrame - createExternalBufferFrame ShmBufferBackend frameRelease rc = - pure (ShmBufferFrame frameRelease rc) + type ExternalBuffer ShmBuffer ShmBufferBackend = ShmBuffer + newExternalBuffer :: ShmBufferBackend -> ShmBuffer -> STMc NoRetry '[] ShmBuffer + newExternalBuffer ShmBufferBackend shmBuffer = pure shmBuffer + createExternalBufferFrame :: ShmBufferBackend -> Borrowed ShmBuffer -> STMc NoRetry '[] ShmBufferFrame + createExternalBufferFrame ShmBufferBackend borrowed = + pure (ShmBufferFrame borrowed) -- | Wrapper for an externally managed shm pool data ShmPool = ShmPool { @@ -120,26 +120,21 @@ instance ClientBufferBackend ShmBufferBackend where renderFrame :: Rc ShmBufferFrame -> IO (Rc ShmBufferFrame) renderFrame = pure - getExportBufferId :: HasCallStack => ShmBufferFrame -> STMc NoRetry '[DisposedException] Unique - getExportBufferId (ShmBufferFrame _ bufferRc) = do - (Borrowed _ buffer) <- readRc bufferRc - pure buffer.key + getExportBufferId :: ShmBufferFrame -> STMc NoRetry '[DisposedException] Unique + getExportBufferId (ShmBufferFrame (Borrowed _ buffer)) = pure buffer.key exportWlBuffer :: ClientShmManager -> ShmBufferFrame -> IO (NewObject 'Client Interface_wl_buffer) - exportWlBuffer client (ShmBufferFrame _ rc) = atomicallyC do - tryReadRc rc >>= \case - Nothing -> throwM (userError "ShmBufferBackend: Trying to export already disposed frame") - Just (Borrowed _ buffer) -> do - pool <- readRc buffer.pool - wlShmPool <- getClientShmPool client pool - -- NOTE no event handlers are attached here, since the caller (usually `Quasar.Wayland.Surface`) has that responsibility. - wlShmPool.create_buffer buffer.offset buffer.width buffer.height buffer.stride buffer.format + exportWlBuffer client (ShmBufferFrame (Borrowed _ buffer)) = atomicallyC do + pool <- readRc buffer.pool + wlShmPool <- getClientShmPool client pool + -- NOTE no event handlers are attached here, since the caller (usually `Quasar.Wayland.Surface`) has that responsibility. + wlShmPool.create_buffer buffer.offset buffer.width buffer.height buffer.stride buffer.format syncExportBuffer :: ShmBufferFrame -> IO () syncExportBuffer _ = pure () getExportBufferDestroyedFuture :: ShmBufferFrame -> STMc NoRetry '[] (Future '[] ()) - getExportBufferDestroyedFuture (ShmBufferFrame _ shmBuffer) = pure $ isDisposed shmBuffer + getExportBufferDestroyedFuture (ShmBufferFrame (Borrowed _ externalBuffer)) = pure $ isDisposed externalBuffer data ClientShmManager = ClientShmManager { key :: Unique,