summaryrefslogtreecommitdiff
path: root/Types/WorkerPool.hs
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2019-06-05 19:43:32 -0400
committerJoey Hess <joeyh@joeyh.name>2019-06-05 20:07:35 -0400
commit4932972487ec89b2b257336d943b569cb9767942 (patch)
treeb56f80f0417a120e065bab7ff69b19e909dd9793 /Types/WorkerPool.hs
parent3eac4e01a4db5a6da63b5ee61944c20c5e855010 (diff)
fix STM deadlock
659640e22493cc39a2351a4d0d7ac575b0ff3b7a was buggy, it had a STM deadlock because two actions both wanted to takeTMVar the WorkerPool and so blocked one-another. Fixed by completely reworking how the pool is maintained. Maintenace threads now wait for the Async actions and update the WorkerPool. This means twice as many threads as before, but green threads so will only use a few extra bytes ram per thread.
Diffstat (limited to 'Types/WorkerPool.hs')
-rw-r--r--Types/WorkerPool.hs11
1 files changed, 11 insertions, 0 deletions
diff --git a/Types/WorkerPool.hs b/Types/WorkerPool.hs
index 03a95b47ba..a2b7131bf4 100644
--- a/Types/WorkerPool.hs
+++ b/Types/WorkerPool.hs
@@ -67,3 +67,14 @@ removeThreadIdWorkerPool tid (WorkerPool l) = go [] l
go c (ActiveWorker a stage : rest)
| asyncThreadId a == tid = Just ((a, stage), WorkerPool (c++rest))
go c (v : rest) = go (v:c) rest
+
+deactivateWorker :: WorkerPool t -> Async t -> t -> WorkerPool t
+deactivateWorker UnallocatedWorkerPool _ _ = UnallocatedWorkerPool
+deactivateWorker (WorkerPool l) aid t = WorkerPool $ go l
+ where
+ go [] = []
+ go (w@(IdleWorker _ _) : rest) = w : go rest
+ go (w@(ActiveWorker a st) : rest)
+ | a == aid = IdleWorker t st : rest
+ | otherwise = w : go rest
+