fraport/fradrive-old
Archived
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 | otherwise -> f Nothing <&> \case
Nothing -> oldARC Nothing -> oldARC
{ arcGhostRecent = OrdPSQ.insert k now () $ evictGhostToCount arcMaximumGhost arcGhostRecent { arcGhostRecent = OrdPSQ.insert k now () $ evictGhostToCount arcGhostRecent
} }
Just x@(_, w) Just x@(_, w)
-> let (arcRecent', arcRecentWeight', arcGhostRecent') = evictToSize (max arcTargetRecent (arcMaximumWeight |- arcFrequentWeight) |- w) arcRecent arcRecentWeight arcGhostRecent -> 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 :: w -> OrdPSQ k ARCTick (v, w) -> w -> OrdPSQ k ARCTick () -> (OrdPSQ k ARCTick (v, w), w, OrdPSQ k ARCTick ())
evictToSize tSize c cSize ghostC evictToSize tSize c cSize ghostC
| cSize <= 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') . evictGhostToCount $ OrdPSQ.insert k' p' () ghostC
| Just (k', p', (_, w'), c') <- OrdPSQ.minView c = evictToSize tSize c' (cSize - w') $ OrdPSQ.insert k' p' () ghostC
| otherwise = error "evictToSize: cannot reach required size through eviction" | otherwise = error "evictToSize: cannot reach required size through eviction"
evictGhostToCount :: Int -> OrdPSQ k ARCTick () -> OrdPSQ k ARCTick () evictGhostToCount :: OrdPSQ k ARCTick () -> OrdPSQ k ARCTick ()
evictGhostToCount tCount c evictGhostToCount c
| OrdPSQ.size c <= tCount = c | OrdPSQ.size c <= arcMaximumGhost = c
| Just (_, _, _, c') <- OrdPSQ.minView c = evictGhostToCount tCount c' | Just (_, _, _, c') <- OrdPSQ.minView c = evictGhostToCount c'
| otherwise = error "evictGhostToCount: cannot reach required count through eviction" | otherwise = error "evictGhostToCount: cannot reach required count through eviction"
lookupARC :: forall k w v. lookupARC :: forall k w v.
@ -217,7 +216,7 @@ insertARC :: forall k w v.
insertARC k newVal = (runIdentity .) . arcAlterF k (const $ pure newVal) 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) deriving (Eq, Typeable)
initARCHandle :: forall k w v m. initARCHandle :: forall k w v m.
@ -227,7 +226,7 @@ initARCHandle :: forall k w v m.
=> Int -- ^ @arcMaximumGhost@ => Int -- ^ @arcMaximumGhost@
-> w -- ^ @arcMaximumWeight@ -> w -- ^ @arcMaximumWeight@
-> m (ARCHandle k w v) -> 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. cachedARC' :: forall k w v m.
( MonadIO m ( MonadIO m
@ -240,9 +239,22 @@ cachedARC' :: forall k w v m.
-> (Maybe (v, w) -> m (Maybe (v, w))) -> (Maybe (v, w) -> m (Maybe (v, w)))
-> m (Maybe v) -> m (Maybe v)
cachedARC' (ARCHandle arcVar) k f = do cachedARC' (ARCHandle arcVar) k f = do
oldVal <- liftIO $ lookupARC k <$> readTVarIO arcVar oldVal <- lookupARC k <$> readIORef arcVar
newVal <- f oldVal 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 return $ view _1 <$> newVal
cachedARC :: forall k w v m. cachedARC :: forall k w v m.
@ -260,4 +272,4 @@ cachedARC h k f = fromMaybe (error "cachedARC: cachedARC' returned Nothing") <$>
readARCHandle :: MonadIO m readARCHandle :: MonadIO m
=> ARCHandle k w v => ARCHandle k w v
-> m (ARC k w v, ARCTick) -> m (ARC k w v, ARCTick)
readARCHandle (ARCHandle arcVar) = readTVarIO arcVar readARCHandle (ARCHandle arcVar) = readIORef arcVar