Haskell 计算密集型线程阻塞所有其他线程

Question

我想编写一个程序，它的主线程派生一个新线程进行计算并等待它完成一段时间。如果子线程没有在给定时间内完成，它就会超时并被杀死。我有以下代码。

import Control.Concurrent

fibs :: Int -> Int 
fibs 0 = 0
fibs 1 = 1
fibs n = fibs (n-1) + fibs (n-2)

main = do 
    mvar  <- newEmptyMVar 
    tid   <- forkIO $ do
        threadDelay (1 * 1000 * 1000)
        putMVar mvar Nothing 
    tid'  <- forkIO $ do
        if fibs 1234 == 100
            then putStrLn "Incorrect answer" >> putMVar mvar (Just False)
            else putStrLn "Maybe correct answer" >> putMVar mvar (Just True)
    putStrLn "Waiting for result or timeout"
    result <- takeMVar mvar
    killThread tid
    killThread tid' 

我用ghc -O2 Test.hs和编译了上面的程序ghc -O2 -threaded Test.hs并运行它，但在这两种情况下，程序只是挂起而不打印任何内容或退出。如果我threadDelay (2 * 1000 * 1000)在if块之前将 a 添加到计算线程，则程序按预期工作并在一秒钟后完成，因为计时器线程能够填充mvar.

为什么线程不能像我预期的那样工作？

Answer 1

GHC 在其并发实现中使用了一种混合的协作和抢占式多任务处理。

在 Haskell 级别，它似乎是抢占式的，因为线程不需要显式地让出，并且似乎可以随时被运行时中断。但是在运行时级别，线程在分配内存时“屈服”。由于几乎所有 Haskell 线程都在不断分配，因此这通常效果很好。

但是，如果可以将特定计算优化为非分配代码，则它可能在运行时级别变得不合作，因此在 Haskell 级别上不可抢占。正如@Carl 指出的那样，它实际上是-fomit-yields标志，它暗示-O2允许这种情况发生：

-fomit-yields

告诉 GHC 在没有执行分配时省略堆检查。虽然这将二进制大小提高了约 5%，但这也意味着在紧密的非分配循环中运行的线程不会被及时抢占。如果始终能够中断此类线程很重要，则应关闭此优化。如果您需要保证可中断性，还可以考虑在关闭此优化的情况下重新编译所有库。

显然，在单线程运行时（无-threaded标志），这意味着一个线程可以完全耗尽所有其他线程。不太明显的是，即使您-threaded使用+RTS -N选项进行编译，也会发生同样的事情。问题是不合作的线程可能会使运行时调度程序本身挨饿。如果在某个时刻，不合作线程是当前调度运行的唯一线程，它将变得不可中断，并且调度程序将永远不会重新运行以考虑调度其他线程，即使它们可以在其他 O/S 线程上运行。

如果您只是想测试一些东西，请将签名更改fib为fib :: Integer -> Integer。由于Integer导致分配，一切都会重新开始工作（有或没有-threaded）。

如果您在实际代码中遇到此问题，到目前为止，最简单的解决方案是@Carl 建议的解决方案：如果您需要保证线程的可中断性，则应使用 来编译代码-fno-omit-yields，从而使调度程序调用保持在非分配代码中. 根据文档，这会增加二进制大小；我认为它也会带来小的性能损失。

或者，如果计算已经在 中IO，那么yield在优化循环中显式ing 可能是一个好方法。对于纯计算，您可以将其转换为 IO 和yield，但通常您可以找到一种简单的方法来再次引入分配。在大多数现实情况下，将有一种方法只引入“少数”yield或分配——足以使线程再次响应但不足以严重影响性能。（例如，如果您有一些嵌套的递归循环，yield或者在最外层循环中强制分配。）