Вызов Haskell из нескольких потоков C / C ++ - PullRequest
Новая
       6

Вызов Haskell из нескольких потоков C / C ++

6 голосов
/ 16 марта 2020

У меня есть небольшая письменная функция Haskell следующего типа: 

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

Я звоню из нескольких потоков C ++, работающих одновременно (через TBB). Во время этой части выполнения моей программы я едва могу получить среднюю загрузку выше 1,4, хотя я работаю на шестиядерном процессоре (12 логических ядер). Поэтому я подозреваю, что либо вызовы в Haskell все направляются через один поток, либо происходит какая-то существенная синхронизация.

Я не делаю ничего такого явно, все, что делает функция - это работает входящие данные (после сохранения их в Data.Vector.Storable) и возврата результата обратно в виде вновь выделенного массива (из Data.Marshal.Array).

Что мне нужно сделать, чтобы полностью разрешить одновременные вызовы, подобные этому?

Я использую GH C 8.6.5 в Debian Linux (яблочко / тестирование) и собираю с -threaded -O2.

Looking жду чтения некоторых советов,

Себастьян

1 Ответ

2 голосов
/ 17 марта 2020

Используя простой пример в конце этого ответа, если я скомпилирую с: 

$ 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) для полного использования всех доступных ядер.

Итак, в вашем примере должно быть что-то , вызывающее проблему. Это может быть конфликт между потоками по некоторой общей структуре данных. Или, возможно, параллельная сборка мусора вызывает проблемы; Я наблюдал параллельную G C, вызывающую худшую производительность с увеличением -N в простом тестовом примере (детали, к сожалению, забыты), поэтому вы можете попробовать отключить параллельную G C с помощью -qg или ограничить количество ядер связан с -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
...