mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
parent
4e89506788
commit
689ca15b47
|
@ -40,8 +40,10 @@ ncqStorageOpen fp upd = do
|
||||||
let ncqIdleThrsh = 50.0
|
let ncqIdleThrsh = 50.0
|
||||||
let ncqPostponeService = 20
|
let ncqPostponeService = 20
|
||||||
let ncqSweepTime = 30.00
|
let ncqSweepTime = 30.00
|
||||||
let ncqMergeTimeA = 10.00
|
let ncqMergeTimeA = 20.00
|
||||||
let ncqMergeTimeB = 60.00
|
let ncqMergeTimeB = 120.00
|
||||||
|
let ncqCompactTimeA = 10.00
|
||||||
|
let ncqCompactTimeB = 60.00
|
||||||
let ncqSalt = "EstEFasxrCFqsGDxcY4haFcha9e4ZHRzsPbGUmDfdxLk"
|
let ncqSalt = "EstEFasxrCFqsGDxcY4haFcha9e4ZHRzsPbGUmDfdxLk"
|
||||||
|
|
||||||
cap <- getNumCapabilities
|
cap <- getNumCapabilities
|
||||||
|
@ -65,6 +67,7 @@ ncqStorageOpen fp upd = do
|
||||||
ncqSyncReq <- newTVarIO False
|
ncqSyncReq <- newTVarIO False
|
||||||
ncqSweepReq <- newTVarIO False
|
ncqSweepReq <- newTVarIO False
|
||||||
ncqMergeReq <- newTVarIO False
|
ncqMergeReq <- newTVarIO False
|
||||||
|
ncqCompactReq <- newTVarIO False
|
||||||
ncqOnRunWriteIdle <- newTVarIO none
|
ncqOnRunWriteIdle <- newTVarIO none
|
||||||
ncqSyncNo <- newTVarIO 0
|
ncqSyncNo <- newTVarIO 0
|
||||||
ncqState <- newTVarIO mempty
|
ncqState <- newTVarIO mempty
|
||||||
|
|
|
@ -242,9 +242,11 @@ ncqStorageRun ncq@NCQStorage{..} = withSem ncqRunSem $ flip runContT pure do
|
||||||
|
|
||||||
spawnActivity $ postponed ncqPostponeService
|
spawnActivity $ postponed ncqPostponeService
|
||||||
$ compactLoop ncqMergeReq ncqMergeTimeA ncqMergeTimeB $ withSem ncqServiceSem do
|
$ compactLoop ncqMergeReq ncqMergeTimeA ncqMergeTimeB $ withSem ncqServiceSem do
|
||||||
a <- ncqFossilMergeStep ncq
|
ncqFossilMergeStep ncq
|
||||||
b <- ncqIndexCompactStep ncq
|
|
||||||
pure $ a || b
|
spawnActivity $ postponed ncqPostponeService
|
||||||
|
$ compactLoop ncqCompactReq ncqCompactTimeA ncqCompactTimeB $ withSem ncqServiceSem do
|
||||||
|
ncqIndexCompactStep ncq
|
||||||
|
|
||||||
flip fix RunNew $ \loop s -> do
|
flip fix RunNew $ \loop s -> do
|
||||||
-- debug $ viaShow s
|
-- debug $ viaShow s
|
||||||
|
@ -434,12 +436,14 @@ ncqStorageRun ncq@NCQStorage{..} = withSem ncqRunSem $ flip runContT pure do
|
||||||
ncqClearFlag flag
|
ncqClearFlag flag
|
||||||
compacted <- lift what
|
compacted <- lift what
|
||||||
|
|
||||||
when compacted mzero
|
when compacted do
|
||||||
|
ncqSetFlag ncqSweepReq
|
||||||
|
mzero
|
||||||
|
|
||||||
k0 <- readTVarIO ncqStateKey
|
k0 <- readTVarIO ncqStateKey
|
||||||
void $ lift $ race (pause @'Seconds t2) do
|
void $ lift $ race (pause @'Seconds t2) do
|
||||||
flip fix k0 $ \waitState k1 -> do
|
flip fix k0 $ \waitState k1 -> do
|
||||||
pause @'Seconds 60
|
pause @'Seconds t2
|
||||||
k2 <- readTVarIO ncqStateKey
|
k2 <- readTVarIO ncqStateKey
|
||||||
when (k2 == k1) $ waitState k2
|
when (k2 == k1) $ waitState k2
|
||||||
|
|
||||||
|
|
|
@ -91,6 +91,8 @@ data NCQStorage =
|
||||||
, ncqSweepTime :: Timeout 'Seconds
|
, ncqSweepTime :: Timeout 'Seconds
|
||||||
, ncqMergeTimeA :: Timeout 'Seconds
|
, ncqMergeTimeA :: Timeout 'Seconds
|
||||||
, ncqMergeTimeB :: Timeout 'Seconds
|
, ncqMergeTimeB :: Timeout 'Seconds
|
||||||
|
, ncqCompactTimeA :: Timeout 'Seconds
|
||||||
|
, ncqCompactTimeB :: Timeout 'Seconds
|
||||||
, ncqFsync :: Int
|
, ncqFsync :: Int
|
||||||
, ncqWriteQLen :: Int
|
, ncqWriteQLen :: Int
|
||||||
, ncqWriteBlock :: Int
|
, ncqWriteBlock :: Int
|
||||||
|
@ -118,6 +120,7 @@ data NCQStorage =
|
||||||
, ncqSyncReq :: TVar Bool
|
, ncqSyncReq :: TVar Bool
|
||||||
, ncqSweepReq :: TVar Bool
|
, ncqSweepReq :: TVar Bool
|
||||||
, ncqMergeReq :: TVar Bool
|
, ncqMergeReq :: TVar Bool
|
||||||
|
, ncqCompactReq :: TVar Bool
|
||||||
, ncqOnRunWriteIdle :: TVar (IO ())
|
, ncqOnRunWriteIdle :: TVar (IO ())
|
||||||
, ncqSyncNo :: TVar Int
|
, ncqSyncNo :: TVar Int
|
||||||
, ncqServiceSem :: TSem
|
, ncqServiceSem :: TSem
|
||||||
|
|
Loading…
Reference in New Issue