Haskell:线程在 STM 事务中无限期阻塞
有没有办法增加一个时间间隔,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决定抛出此异常的时间间隔可能会解决问题。
Is there any way to increase a time interval, on the basis of which the RTS decides that thread has blocked indefinitely in an STM transaction?
Here is my code:
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 makes sure that amount of simultaneously running managed threads does not exceed maxThreadsCount. It works fine until heavy load. Under heavy load RTS throws an exception. I think under heavy load, on hard concurrent competition for resources, some of threads just have no time to get access to the STM context. So I think, increasing time interval when RTS decides to throw this exception may solve the problem.
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(1)
丹尼尔·瓦格纳是对的。该决定不是在超时的情况下做出的。 rts中的相关代码位于
Schedule.c< /code>
请参阅
resurrectThreads
抛出异常的函数。注释中描述了这只会抛出到GC后发现是垃圾的线程。 ezyang 描述了 mvar 的工作原理: http://blog.ezyang.com/2011/07/ blockindefinitelyonmvar/[当我检查其源代码并意识到这只是一个简单的防护/重试而不是中描述的内容时,有关
check
的不良猜测被删除一篇较早的论文——哎呀!我现在怀疑丹尼尔·瓦格纳在这里也是正确的,问题是计数器没有增加。]Daniel Wagner is right. The decision is not made with timeouts. The relevant code in the rts is in
Schedule.c
See the
resurrectThreads
function for where the exception is thrown. The comment describes that this is only thrown to threads found to be garbage after GC. ezyang described how this worked for mvars: http://blog.ezyang.com/2011/07/blockedindefinitelyonmvar/[bad speculation concerning
check
removed when I checked its source and realized that it was just a simple guard/retry and not what was described in an earlier paper -- oops! I now suspect that Daniel Wagner is correct here as well, and the issue is somehow that the counter isn't being incremented.]