From a97fea6d6a2c46830432712dd00beb1dac639d7b Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sat, 25 Jan 2020 19:09:48 -0500 Subject: Thread instrumentation: Fixed leak in contention-reduced design. --- lifted-concurrent/src/Control/Concurrent/Lifted/Instrument.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lifted-concurrent/src/Control/Concurrent/Lifted/Instrument.hs b/lifted-concurrent/src/Control/Concurrent/Lifted/Instrument.hs index d886f939..adce64ba 100644 --- a/lifted-concurrent/src/Control/Concurrent/Lifted/Instrument.hs +++ b/lifted-concurrent/src/Control/Concurrent/Lifted/Instrument.hs @@ -156,6 +156,7 @@ threadsInformation = do modifyThreads :: MonadBaseControl IO m => ThreadId -> (Map.Map ThreadId PerThread -> Map.Map ThreadId PerThread) -> m () modifyThreads tid f = do - let tidHash = hashThreadId tid - let mvar = globalMVarArray V.! tidHash - modifyMVarMasked_ mvar (return . f) + let mvar = globalMVarArray V.! hashThreadId tid + bracket (takeMVar mvar) + (\m -> putMVar mvar $! f m) + (\m -> return ()) -- cgit v1.2.3