fix concurrency
Broken by recent commits, because before dupState is called, the Annex state needs to have concurrent output enabled, and the thread pool populated.
This commit is contained in:
parent
9671248fff
commit
a0d3a699e2
1 changed files with 11 additions and 9 deletions
|
@ -215,19 +215,20 @@ startConcurrency usedstages a = do
|
||||||
where
|
where
|
||||||
goconcurrent n = do
|
goconcurrent n = do
|
||||||
raisecapabilitiesto n
|
raisecapabilitiesto n
|
||||||
initworkerpool n
|
|
||||||
withMessageState $ \s -> case outputType s of
|
withMessageState $ \s -> case outputType s of
|
||||||
NormalOutput -> ifM (liftIO concurrentOutputSupported)
|
NormalOutput -> ifM (liftIO concurrentOutputSupported)
|
||||||
( Regions.displayConsoleRegions $
|
( Regions.displayConsoleRegions $
|
||||||
goconcurrent' True
|
goconcurrent' n True
|
||||||
, goconcurrent' False
|
, goconcurrent' n False
|
||||||
)
|
)
|
||||||
_ -> goconcurrent' False
|
_ -> goconcurrent' n False
|
||||||
goconcurrent' b = bracket_ (setup b) cleanup a
|
goconcurrent' n b = bracket_ (setup n b) cleanup a
|
||||||
|
|
||||||
goconcurrentpercpu = goconcurrent =<< liftIO getNumProcessors
|
goconcurrentpercpu = goconcurrent =<< liftIO getNumProcessors
|
||||||
|
|
||||||
setup = setconcurrentoutputenabled
|
setup n b = do
|
||||||
|
setconcurrentoutputenabled b
|
||||||
|
initworkerpool n
|
||||||
|
|
||||||
cleanup = do
|
cleanup = do
|
||||||
finishCommandActions
|
finishCommandActions
|
||||||
|
@ -247,10 +248,11 @@ startConcurrency usedstages a = do
|
||||||
-- could cause threads to contend over eg, calls to
|
-- could cause threads to contend over eg, calls to
|
||||||
-- setConfig.
|
-- setConfig.
|
||||||
_ <- remoteList
|
_ <- remoteList
|
||||||
st <- dupState
|
tv <- liftIO newEmptyTMVarIO
|
||||||
tv <- liftIO $ newTMVarIO $
|
|
||||||
allocateWorkerPool st (max n 1) usedstages
|
|
||||||
Annex.changeState $ \s -> s { Annex.workers = Just tv }
|
Annex.changeState $ \s -> s { Annex.workers = Just tv }
|
||||||
|
st <- dupState
|
||||||
|
liftIO $ atomically $ putTMVar tv $
|
||||||
|
allocateWorkerPool st (max n 1) usedstages
|
||||||
|
|
||||||
{- Ensures that only one thread processes a key at a time.
|
{- Ensures that only one thread processes a key at a time.
|
||||||
- Other threads will block until it's done.
|
- Other threads will block until it's done.
|
||||||
|
|
Loading…
Add table
Reference in a new issue