从多个 C/C++ 线程调用 Haskell

Question

我有一个用 Haskell 编写的小函数，类型如下：

foreign export ccall sget :: Ptr CInt -> CSize -> Ptr CSize -> IO (Ptr CInt)

我从同时运行的多个 C++ 线程调用它（通过 待定）。在执行程序的这一部分期间，我几乎无法获得 即使我在六核 CPU（12 逻辑核心）。因此，我怀疑要么调用 Haskell 通过单个线程汇集，或者有一些重要的 同步进行中。

我没有明确地做任何这样的事情，函数所做的只是操作 在传入数据上（在将其存储到 Data.Vector.Storable 之后），以及 将结果作为新分配的数组返回（来自 Data.Marshal.Array）。

我需要做些什么来完全启用这样的并发调用吗？

我在 Debian Linux (bullseye/testing) 上使用 GHC 8.6.5，并且正在使用 -threaded -O2 进行编译。

期待阅读一些建议，

塞巴斯蒂安

Answer 1

使用这个答案末尾的简单示例，如果我编译：

$ ghc -O2 Worker.hs
$ ghc -O2 -threaded Worker.o caller.c -lpthread -no-hs-main -o test

然后用./test 运行它只占用一个核心100%。我需要使用./test +RTS -N 运行它，然后在我的 4 核桌面上以 400% 的速度运行，平均负载约为 4.0。

因此，RTS -N 标志会影响可以同时运行导出的 Haskell 函数的并行线程的数量并且不需要特殊操作（除了使用 -threaded 编译和运行+RTS -n) 以充分利用所有可用内核。

因此，您的示例中一定有某些东西导致了问题。它可能是线程之间在某些共享数据结构上的争用。或者，并行垃圾收集可能会导致问题；我观察到并行 GC 在一个简单的测试用例中随着-N 的增加而导致性能下降（遗憾的是，细节忘记了），因此您可以尝试使用-qg 关闭并行GC 或限制-qn2 涉及的核心数量或某物。要启用这些选项，您需要调用 hs_init_with_rtsopts() 来代替通常的 hs_init()，如我的示例所示。

如果这不起作用，我认为您必须尝试缩小问题范围并发布一个说明性能问题的最小示例以获得更多帮助。

我的例子：

caller.c

#include "HsFFI.h"
#include "Rts.h"
#include "Worker_stub.h"
#include <pthread.h>

#define NUM_THREAD 4

void*
work(void* arg)
{
        for (;;) {
                fibIO(30);
        }
}

int
main(int argc, char **argv)
{
        hs_init_with_rtsopts(&argc, &argv);

        pthread_t threads[NUM_THREAD];
        for (int i = 0; i < NUM_THREAD; ++i) {
                int rc = pthread_create(&threads[i], NULL, work, NULL);
        }
        for (int i = 0; i < NUM_THREAD; ++i) {
                pthread_join(threads[i], NULL);
        }

        hs_exit();
        return 0;
}

Worker.hs

module Worker where

import Foreign

fibIO :: Int -> IO Int
fibIO = return . fib

fib :: Int -> Int
fib n | n > 1 = fib (n-1) + fib (n-2)
      | otherwise = 1

foreign export ccall fibIO :: Int -> IO Int