fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(arc): reduce lock contention

Browse Source
This commit is contained in:
Gregor Kleen 2021-02-11 15:10:36 +01:00
parent ef7a743c60
commit 1be391f5f5
1 changed files with 24 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
src/Utils/ARC.hs
View File

@ -169,7 +169,7 @@ arcAlterF k f oldARC@ARC{..} now
}
| otherwise -> f Nothing <&> \case
Nothing -> oldARC
{ arcGhostRecent = OrdPSQ.insert k now () $ evictGhostToCount arcMaximumGhost arcGhostRecent
{ arcGhostRecent = OrdPSQ.insert k now () $ evictGhostToCount arcGhostRecent
}
Just x@(_, w)
-> let (arcRecent', arcRecentWeight', arcGhostRecent') = evictToSize (max arcTargetRecent (arcMaximumWeight |- arcFrequentWeight) |- w) arcRecent arcRecentWeight arcGhostRecent
@ -187,14 +187,13 @@ arcAlterF k f oldARC@ARC{..} now
evictToSize :: w -> OrdPSQ k ARCTick (v, w) -> w -> OrdPSQ k ARCTick () -> (OrdPSQ k ARCTick (v, w), w, OrdPSQ k ARCTick ())
evictToSize tSize c cSize ghostC
| cSize <= tSize = (c, cSize, ghostC)
| OrdPSQ.size ghostC >= arcMaximumGhost = evictToSize tSize c cSize $ OrdPSQ.deleteMin ghostC
| Just (k', p', (_, w'), c') <- OrdPSQ.minView c = evictToSize tSize c' (cSize - w') $ OrdPSQ.insert k' p' () ghostC
| Just (k', p', (_, w'), c') <- OrdPSQ.minView c = evictToSize tSize c' (cSize - w') . evictGhostToCount $ OrdPSQ.insert k' p' () ghostC
| otherwise = error "evictToSize: cannot reach required size through eviction"
evictGhostToCount :: Int -> OrdPSQ k ARCTick () -> OrdPSQ k ARCTick ()
evictGhostToCount tCount c
| OrdPSQ.size c <= tCount = c
| Just (_, _, _, c') <- OrdPSQ.minView c = evictGhostToCount tCount c'
evictGhostToCount :: OrdPSQ k ARCTick () -> OrdPSQ k ARCTick ()
evictGhostToCount c
| OrdPSQ.size c <= arcMaximumGhost = c
| Just (_, _, _, c') <- OrdPSQ.minView c = evictGhostToCount c'
| otherwise = error "evictGhostToCount: cannot reach required count through eviction"
lookupARC :: forall k w v.
@ -217,7 +216,7 @@ insertARC :: forall k w v.
insertARC k newVal = (runIdentity .) . arcAlterF k (const $ pure newVal)
newtype ARCHandle k w v = ARCHandle { _getARCHandle :: TVar (ARC k w v, ARCTick) }
newtype ARCHandle k w v = ARCHandle { _getARCHandle :: IORef (ARC k w v, ARCTick) }
deriving (Eq, Typeable)
initARCHandle :: forall k w v m.
@ -227,7 +226,7 @@ initARCHandle :: forall k w v m.
=> Int -- ^ @arcMaximumGhost@
-> w -- ^ @arcMaximumWeight@
-> m (ARCHandle k w v)
initARCHandle maxGhost maxWeight = fmap ARCHandle . liftIO . newTVarIO $ initARC maxGhost maxWeight
initARCHandle maxGhost maxWeight = fmap ARCHandle . newIORef $ initARC maxGhost maxWeight
cachedARC' :: forall k w v m.
( MonadIO m
@ -240,9 +239,22 @@ cachedARC' :: forall k w v m.
-> (Maybe (v, w) -> m (Maybe (v, w)))
-> m (Maybe v)
cachedARC' (ARCHandle arcVar) k f = do
oldVal <- liftIO $ lookupARC k <$> readTVarIO arcVar
oldVal <- lookupARC k <$> readIORef arcVar
newVal <- f oldVal
atomically . modifyTVar' arcVar $ \(arc, tick) -> force $ insertARC k newVal arc tick
modifyIORef' arcVar $ force . uncurry (insertARC k newVal)
-- Using `modifyIORef'` instead of `atomicModifyIORef'` might very
-- well drop newer values computed during the update.
--
-- Currently we accept that to reduce lock contention.
--
-- Another alternative would be to use "optimistic locking",
-- i.e. read the current value of `arcVar`, compute an updated
-- version, and write it back atomically iff the `ARCTick` hasn't
-- changed.
--
-- This was not implemented to avoid the overhead and contention
-- likely associated with the atomic transaction required for the
-- "compare and swap"
return $ view _1 <$> newVal
cachedARC :: forall k w v m.
@ -260,4 +272,4 @@ cachedARC h k f = fromMaybe (error "cachedARC: cachedARC' returned Nothing") <$>
readARCHandle :: MonadIO m
=> ARCHandle k w v
-> m (ARC k w v, ARCTick)
readARCHandle (ARCHandle arcVar) = readTVarIO arcVar
readARCHandle (ARCHandle arcVar) = readIORef arcVar