From 617ad99912fc6aa8571657de8e79f55ab718f957 Mon Sep 17 00:00:00 2001 From: voidlizard Date: Thu, 31 Jul 2025 16:22:48 +0300 Subject: [PATCH] wip, fixed merge O(E(K)) > O(ENTRY) => skip entry --- .../lib/HBS2/Storage/NCQ3/Internal.hs | 6 ---- .../lib/HBS2/Storage/NCQ3/Internal/Fossil.hs | 16 +++++++--- .../lib/HBS2/Storage/NCQ3/Internal/Run.hs | 29 +++++++++---------- .../lib/HBS2/Storage/NCQ3/Internal/Sweep.hs | 12 ++++---- .../lib/HBS2/Storage/NCQ3/Internal/Types.hs | 9 ++++++ hbs2-tests/test/NCQ3.hs | 2 +- 6 files changed, 43 insertions(+), 31 deletions(-) diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs index 4252c849..022940f8 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs @@ -203,12 +203,6 @@ ncqTryLoadState me@NCQStorage3{..} = do pure True -ncqTombEntrySize :: NCQSize -ncqTombEntrySize = ncqSLen + ncqKeyLen + ncqPrefixLen - -ncqIsTombEntrySize :: Integral a => a -> Bool -ncqIsTombEntrySize s = fromIntegral s <= ncqTombEntrySize -{-# INLINE ncqIsTombEntrySize #-} ncqEntryUnwrap :: ByteString -> (ByteString, Either ByteString (NCQSectionType, ByteString)) diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fossil.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fossil.hs index 52f64a31..e4a5a7b5 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fossil.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fossil.hs @@ -53,7 +53,7 @@ ncqFossilMergeStep me@NCQStorage3{..} = withSem ncqServiceSem $ flip runContT p r@(sumSize, f1, f2) <- ContT $ maybe1 r' (pure False) - debug $ "for compacting" <+> pretty f1 <+> pretty f2 <+> pretty r <+> pretty ncqMaxLog + debug $ yellow "for compacting" <+> pretty f1 <+> pretty f2 <+> pretty r <+> pretty ncqMaxLog when (fromIntegral sumSize > ncqMaxLog) $ exit False @@ -75,13 +75,21 @@ ncqFossilMergeStep me@NCQStorage3{..} = withSem ncqServiceSem $ flip runContT p ncqLocate_ False me k >>= \case Nothing -> pure False Just (InMemory{}) -> pure False - Just (InFossil fk o1 _) -> do - let skip = fk > fik || (fk == fik && o1 < fromIntegral o) + Just (InFossil fk oi si) -> do + let skip = fk > fik || (fk == fik && o < fromIntegral oi) let beWritten = not skip + + -- let c = if skip then green else id + -- when (si == ncqTombEntrySize) do + -- debug $ red "fucking TOMB found!" + -- <+> pretty k + -- <+> viaShow (fk, oi, fik, o) + -- <+> "write" <+> c (pretty beWritten) + atomically do here <- readTVar already <&> HS.member k let proceed = not here && beWritten - when proceed (modifyTVar already (HS.insert k)) + modifyTVar already (HS.insert k) pure proceed appendTailSection fd diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs index ebbeb48a..f26126bb 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs @@ -94,29 +94,28 @@ ncqStorageRun3 ncq@NCQStorage3{..} = flip runContT pure do -- spawnActivity (ncqStateUpdateLoop ncq) - spawnActivity $ postponed 10 $ forever do - - ema <- readTVarIO ncqWriteEMA - - when ( ema < ncqIdleThrsh ) do - ncqSweepObsoleteStates ncq - - -- FIXME: timeout-hardcode - pause @'Seconds 60 - spawnActivity $ forever do pause @'Seconds 30 ema <- readTVarIO ncqWriteEMA debug $ "EMA" <+> pretty (realToFrac @_ @(Fixed E3) ema) spawnActivity $ postponed 10 $ forever do - ema <- readTVarIO ncqWriteEMA + lsInit <- ncqLiveKeys ncq <&> HS.size + void $ race (pause @'Seconds 60) do + flip fix lsInit $ \next ls0 -> do + (lsA,lsB) <- atomically do + ema <- readTVar ncqWriteEMA + ls1 <- ncqLiveKeysSTM ncq <&> HS.size - when ( ema < ncqIdleThrsh ) do - ncqSweepFiles ncq + if ls1 /= ls0 && ema < ncqIdleThrsh then + pure (ls0,ls1) + else + STM.retry - -- FIXME: timeout-hardcode - pause @'Seconds 60 + debug $ "do sweep" <+> pretty lsA <+> pretty lsB + ncqSweepObsoleteStates ncq + ncqSweepFiles ncq + next lsB spawnActivity $ postponed 10 $ compactLoop 10 300 do ncqIndexCompactStep ncq diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Sweep.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Sweep.hs index 3c88a72b..47377075 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Sweep.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Sweep.hs @@ -15,15 +15,17 @@ import System.Posix.Files qualified as PFS import Control.Monad.Trans.Maybe import Data.HashMap.Strict qualified as HM -ncqLiveKeys :: forall m . MonadUnliftIO m => NCQStorage3 -> m (HashSet FileKey) -ncqLiveKeys NCQStorage3{..} = do +ncqLiveKeysSTM :: NCQStorage3 -> STM (HashSet FileKey) +ncqLiveKeysSTM NCQStorage3{..} = do - merged <- atomically do - s0 <- readTVar ncqState - readTVar ncqStateUse <&> (s0<>) . foldMap fst . HM.elems + s0 <- readTVar ncqState + merged <- readTVar ncqStateUse <&> (s0<>) . foldMap fst . HM.elems pure $ HS.fromList $ universeBi @_ @FileKey merged +ncqLiveKeys :: forall m . MonadIO m => NCQStorage3 -> m (HashSet FileKey) +ncqLiveKeys ncq = atomically $ ncqLiveKeysSTM ncq + ncqSweepFiles :: forall m . MonadUnliftIO m => NCQStorage3 -> m () ncqSweepFiles me@NCQStorage3{..} = withSem ncqServiceSem do diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs index e786b42b..7c9b62c4 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs @@ -190,3 +190,12 @@ instance Pretty NCQState where pf (P (PData (DataFile a) s)) = "fp" <+> pretty a <+> pretty s + + +ncqTombEntrySize :: NCQSize +ncqTombEntrySize = ncqSLen + ncqKeyLen + ncqPrefixLen + +ncqIsTombEntrySize :: Integral a => a -> Bool +ncqIsTombEntrySize s = fromIntegral s <= ncqTombEntrySize +{-# INLINE ncqIsTombEntrySize #-} + diff --git a/hbs2-tests/test/NCQ3.hs b/hbs2-tests/test/NCQ3.hs index d36429b6..d367cedc 100644 --- a/hbs2-tests/test/NCQ3.hs +++ b/hbs2-tests/test/NCQ3.hs @@ -389,7 +389,7 @@ ncq3Tests = do let tnum = sum [ 1 | x <- tombs, x ] - notice $ "should be deleted" <+> pretty (HS.size deleted) <+> "/" <+> pretty tnum + notice $ "should be deleted" <+> pretty (HS.size deleted) <+> "/" <+> pretty tnum <+> "of" <+> pretty n ncqWithStorage3 dir $ \sto@NCQStorage3{..} -> do