diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs index a3ba4321..8d487cc5 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs @@ -40,8 +40,10 @@ ncqStorageOpen fp upd = do let ncqIdleThrsh = 50.0 let ncqPostponeService = 20 let ncqSweepTime = 30.00 - let ncqMergeTimeA = 10.00 - let ncqMergeTimeB = 60.00 + let ncqMergeTimeA = 20.00 + let ncqMergeTimeB = 120.00 + let ncqCompactTimeA = 10.00 + let ncqCompactTimeB = 60.00 let ncqSalt = "EstEFasxrCFqsGDxcY4haFcha9e4ZHRzsPbGUmDfdxLk" cap <- getNumCapabilities @@ -65,6 +67,7 @@ ncqStorageOpen fp upd = do ncqSyncReq <- newTVarIO False ncqSweepReq <- newTVarIO False ncqMergeReq <- newTVarIO False + ncqCompactReq <- newTVarIO False ncqOnRunWriteIdle <- newTVarIO none ncqSyncNo <- newTVarIO 0 ncqState <- newTVarIO mempty 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 5b2e5a13..1f364d00 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs @@ -242,9 +242,11 @@ ncqStorageRun ncq@NCQStorage{..} = withSem ncqRunSem $ flip runContT pure do spawnActivity $ postponed ncqPostponeService $ compactLoop ncqMergeReq ncqMergeTimeA ncqMergeTimeB $ withSem ncqServiceSem do - a <- ncqFossilMergeStep ncq - b <- ncqIndexCompactStep ncq - pure $ a || b + ncqFossilMergeStep ncq + + spawnActivity $ postponed ncqPostponeService + $ compactLoop ncqCompactReq ncqCompactTimeA ncqCompactTimeB $ withSem ncqServiceSem do + ncqIndexCompactStep ncq flip fix RunNew $ \loop s -> do -- debug $ viaShow s @@ -434,12 +436,14 @@ ncqStorageRun ncq@NCQStorage{..} = withSem ncqRunSem $ flip runContT pure do ncqClearFlag flag compacted <- lift what - when compacted mzero + when compacted do + ncqSetFlag ncqSweepReq + mzero k0 <- readTVarIO ncqStateKey void $ lift $ race (pause @'Seconds t2) do flip fix k0 $ \waitState k1 -> do - pause @'Seconds 60 + pause @'Seconds t2 k2 <- readTVarIO ncqStateKey when (k2 == k1) $ waitState k2 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 f259d85f..7858ca71 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs @@ -91,6 +91,8 @@ data NCQStorage = , ncqSweepTime :: Timeout 'Seconds , ncqMergeTimeA :: Timeout 'Seconds , ncqMergeTimeB :: Timeout 'Seconds + , ncqCompactTimeA :: Timeout 'Seconds + , ncqCompactTimeB :: Timeout 'Seconds , ncqFsync :: Int , ncqWriteQLen :: Int , ncqWriteBlock :: Int @@ -118,6 +120,7 @@ data NCQStorage = , ncqSyncReq :: TVar Bool , ncqSweepReq :: TVar Bool , ncqMergeReq :: TVar Bool + , ncqCompactReq :: TVar Bool , ncqOnRunWriteIdle :: TVar (IO ()) , ncqSyncNo :: TVar Int , ncqServiceSem :: TSem