有没有办法增加时间间隔,在此基础上RTS决定该线程在STM事务中无限期地被阻塞? 这是我的代码:
import Control.Concurrent (ThreadId)
import Control.Concurrent.MVar (MVar,newMVar,withMVar)
import Control.Concurrent.STM
import qualified Control.Concurrent.ThreadManager as TM
data ThreadManager = ThreadManager { tmCounter::TVar Int, tmTM::MVar TM.ThreadManager }
data Settings = Settings {
maxThreadsCount::Int }
createThreadManager :: Settings -> IO ThreadManager
createThreadManager s = do
counter <- atomically $ newTVar (maxThreadsCount s)
tm <- TM.make >>= newMVar
return $ ThreadManager counter tm
forkManaged :: ThreadManager -> IO () -> IO ThreadId
forkManaged tm fn = do
atomically $ do
counter <- readTVar $ tmCounter tm
check $ counter > 0
writeTVar (tmCounter tm) (counter - 1)
withMVar (tmTM tm) $ \thrdmgr -> TM.fork thrdmgr $ do
fn
atomically $ do
counter <- readTVar $ tmCounter tm
writeTVar (tmCounter tm) (counter + 1)
forkManaged 可确保同时运行的托管线程数量不超过 maxThreadsCount 。它工作正常,直到重负荷。在重负载下,RTS抛出异常。我认为在负载很重的情况下,在资源的硬性并发竞争中,一些线程没有时间访问STM上下文。所以我认为,当RTS决定抛出此异常时,增加时间间隔可以解决问题。
答案 0 :(得分:7)
Schedule.c
请参阅resurrectThreads
函数以了解抛出异常的位置。该评论描述了这只被抛出到GC之后被发现是垃圾的线程。 ezyang描述了这对mvars有用:http://blog.ezyang.com/2011/07/blockedindefinitelyonmvar/
[关于check
的错误猜测在我检查其来源时被删除,并意识到它只是一个简单的警卫/重试,而不是早期文章中描述的 - 哎呀!我现在怀疑Daniel Wagner在这里也是正确的,而且问题是计数器没有增加。]