voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip

This commit is contained in:
voidlizard 2025-07-30 18:37:06 +03:00
parent 1f2fdde9c7
commit a5d9f4193b
2 changed files with 31 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs
View File

@ -48,7 +48,7 @@ ncqStorageOpen3 fp upd = do
let ncqMinLog = 1 * gigabytes let ncqMinLog = 1 * gigabytes
let ncqMaxLog = 32 * gigabytes let ncqMaxLog = 32 * gigabytes
let ncqWriteBlock = max 128 $ ncqWriteQLen `div` 2 let ncqWriteBlock = max 128 $ ncqWriteQLen `div` 2
let ncqMaxCachedIndex = 16 let ncqMaxCachedIndex = 64
let ncqMaxCachedData = 64 let ncqMaxCachedData = 64
let ncqIdleThrsh = 50.0 let ncqIdleThrsh = 50.0
let ncqPostponeMerge = 300.0 let ncqPostponeMerge = 300.0

51
hbs2-tests/test/NCQ3.hs
View File

@ -1,4 +1,5 @@
{-# Language RecordWildCards #-} {-# Language RecordWildCards #-}
{-# Language MultiWayIf #-}
module NCQ3 where module NCQ3 where
import HBS2.Prelude.Plated import HBS2.Prelude.Plated
@ -394,7 +395,7 @@ testNCQ3Lookup1 syn TestEnv{..} = do
g <- liftIO MWC.createSystemRandom g <- liftIO MWC.createSystemRandom
let (opts, argz) = splitOpts [("-m",0)] syn let (opts, argz) = splitOpts [("-m",0),("-M",0)] syn
let n = headDef 100000 [ fromIntegral x | LitIntVal x <- argz ] let n = headDef 100000 [ fromIntegral x | LitIntVal x <- argz ]
let nt = max 2 . headDef 1 $ [ fromIntegral x | LitIntVal x <- drop 1 argz ] let nt = max 2 . headDef 1 $ [ fromIntegral x | LitIntVal x <- drop 1 argz ]
@ -402,6 +403,7 @@ testNCQ3Lookup1 syn TestEnv{..} = do
let r = (64*1024, 256*1024) let r = (64*1024, 256*1024)
let merge = headDef False [ True | ListVal [StringLike "-m"] <- opts ] let merge = headDef False [ True | ListVal [StringLike "-m"] <- opts ]
let mergeFull = headDef False [ True | ListVal [StringLike "-M"] <- opts ]
notice $ "insert" <+> pretty n <+> "random blocks of size" <+> parens (pretty r) <+> pretty opts notice $ "insert" <+> pretty n <+> "random blocks of size" <+> parens (pretty r) <+> pretty opts
@ -419,37 +421,44 @@ testNCQ3Lookup1 syn TestEnv{..} = do
hs <- atomically $ STM.flushTQueue thashes hs <- atomically $ STM.flushTQueue thashes
when merge do let wrap m = if | mergeFull -> notice "full merge" >> ncqIndexCompactFull sto >> m
notice "COMPACT INDEX" | merge ->
ncqIndexCompactFull sto fix \next -> do
notice "run ncqIndexCompactStep"
left <- ncqIndexCompactStep sto
m
if left then next else none
| otherwise -> m
wrap do
idx <- readTVarIO (ncqState sto) <&> List.length . view #ncqStateIndex idx <- readTVarIO (ncqState sto) <&> List.length . view #ncqStateIndex
replicateM_ nl do replicateM_ nl do
tfound <- newTVarIO 0 tfound <- newTVarIO 0
t0 <- getTimeCoarse
liftIO $ pooledForConcurrentlyN_ nt hs $ \h -> do t0 <- getTimeCoarse
found <- ncqLocate sto h <&> isJust
when found do
atomically $ modifyTVar' tfound succ
t1 <- getTimeCoarse liftIO $ pooledForConcurrentlyN_ nt hs $ \h -> do
found <- ncqLocate sto h <&> isJust
when found do
atomically $ modifyTVar' tfound succ
let dt = realToFrac (toNanoSecs (t1 - t0)) / 1e9 :: Fixed E3 t1 <- getTimeCoarse
atomically $ writeTQueue res dt
found <- readTVarIO tfound let dt = realToFrac (toNanoSecs (t1 - t0)) / 1e9 :: Fixed E3
atomically $ writeTQueue res dt
notice $ "scan all files" <+> pretty idx <+> pretty dt <+> pretty found found <- readTVarIO tfound
m <- atomically (STM.flushTQueue res) notice $ "scan all files" <+> pretty idx <+> pretty dt <+> pretty found
<&> List.sort
<&> \x -> atDef 0 x (List.length x `quot` 2)
notice $ "median" <+> pretty m m <- atomically (STM.flushTQueue res)
<&> List.sort
<&> \x -> atDef 0 x (List.length x `quot` 2)
notice $ "median" <+> pretty m