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 编译了上面的程序并运行了它，但是在这两种情况下程序只是挂起，没有打印任何东西或退出。如果我在if 块之前将threadDelay (2 * 1000 * 1000) 添加到计算线程，那么程序将按预期工作并在一秒钟后完成，因为计时器线程能够填充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 中，那么在优化循环中显式地yielding 可能是一个好方法。对于纯计算，您可以将其转换为 IO 和yield，尽管通常您可以找到一种简单的方法来再次引入分配。在大多数实际情况下，将有一种方法只引入“少数”yields 或分配——足以使线程再次响应但不足以严重影响性能。 （例如，如果您有一些嵌套的递归循环，yield 或在最外层循环中强制分配。）