有什么方法可以增加时间间隔,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 决定抛出此异常的时间间隔可能会解决问题。