diff options
| author | Joe Crayne <joe@jerkface.net> | 2020-01-25 19:09:48 -0500 |
|---|---|---|
| committer | Joe Crayne <joe@jerkface.net> | 2020-01-25 19:10:31 -0500 |
| commit | a97fea6d6a2c46830432712dd00beb1dac639d7b (patch) | |
| tree | b6648289ee1674a5e0130f47e394a1c33467c8a6 | |
| parent | aebcf4e527063a10f4b22ed476766926a45d4f50 (diff) | |
Thread instrumentation: Fixed leak in contention-reduced design.
| -rw-r--r-- | lifted-concurrent/src/Control/Concurrent/Lifted/Instrument.hs | 7 |
1 files 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 | |||
| 156 | modifyThreads :: MonadBaseControl IO m => ThreadId -> | 156 | modifyThreads :: MonadBaseControl IO m => ThreadId -> |
| 157 | (Map.Map ThreadId PerThread -> Map.Map ThreadId PerThread) -> m () | 157 | (Map.Map ThreadId PerThread -> Map.Map ThreadId PerThread) -> m () |
| 158 | modifyThreads tid f = do | 158 | modifyThreads tid f = do |
| 159 | let tidHash = hashThreadId tid | 159 | let mvar = globalMVarArray V.! hashThreadId tid |
| 160 | let mvar = globalMVarArray V.! tidHash | 160 | bracket (takeMVar mvar) |
| 161 | modifyMVarMasked_ mvar (return . f) | 161 | (\m -> putMVar mvar $! f m) |
| 162 | (\m -> return ()) | ||