Я не могу писать параллельные программы на Haskell с GHC для многоядерных машин.В качестве первого шага я решил написать программу, которая читает и пишет одновременно в массив IOArray.У меня сложилось впечатление, что чтение и запись в IOArray не требуют синхронизации.Я делаю это, чтобы установить базовый уровень для сравнения с производительностью других структур данных, которые используют соответствующие механизмы синхронизации.Я столкнулся с некоторыми удивительными результатами, а именно: во многих случаях я вообще не набираю скорости.Это заставляет меня задаться вопросом, есть ли какая-то синхронизация низкого уровня, происходящая во время выполнения ghc, например, синхронизация и блокировка при оценке thunks (то есть, «черные дыры»).Вот подробности ...
Я пишу пару вариаций для одной программы.Основная идея заключается в том, что я написал структуру данных DirectAddressTable, которая представляет собой просто обертку вокруг IOArray, предоставляющую методы вставки и поиска:
-- file DirectAddressTable.hs
module DirectAddressTable
( DAT
, newDAT
, lookupDAT
, insertDAT
, getAssocsDAT
)
where
import Data.Array.IO
import Data.Array.MArray
newtype DAT = DAT (IOArray Int Char)
-- create a fixed size array; missing keys have value '-'.
newDAT :: Int -> IO DAT
newDAT n = do a <- newArray (0, n - 1) '-'
return (DAT a)
-- lookup an item.
lookupDAT :: DAT -> Int -> IO (Maybe Char)
lookupDAT (DAT a) i = do c <- readArray a i
return (if c=='-' then Nothing else Just c)
-- insert an item
insertDAT :: DAT -> Int -> Char -> IO ()
insertDAT (DAT a) i v = writeArray a i v
-- get all associations (exclude missing items, i.e. those whose value is '-').
getAssocsDAT :: DAT -> IO [(Int,Char)]
getAssocsDAT (DAT a) =
do assocs <- getAssocs a
return [ (k,c) | (k,c) <- assocs, c /= '-' ]
Затем у меня есть основная программа, которая инициализирует новую таблицу, разветвляет некоторые потокис каждым потоком, записывающим и читающим некоторое фиксированное количество значений в только что инициализированную таблицу.Общее количество элементов для записи является фиксированным.Количество потоков, которые нужно использовать, берется из аргумента командной строки, а элементы для обработки равномерно распределяются между потоками.
-- file DirectTableTest.hs
import DirectAddressTable
import Control.Concurrent
import Control.Parallel
import System.Environment
main =
do args <- getArgs
let numThreads = read (args !! 0)
vs <- sequence (replicate numThreads newEmptyMVar)
a <- newDAT arraySize
sequence_ [ forkIO (doLotsOfStuff numThreads i a >>= putMVar v)
| (i,v) <- zip [1..] vs]
sequence_ [ takeMVar v >>= \a -> getAssocsDAT a >>= \xs -> print (last xs)
| v <- vs]
doLotsOfStuff :: Int -> Int -> DAT -> IO DAT
doLotsOfStuff numThreads i a =
do let p j c = (c `seq` insertDAT a j c) >>
lookupDAT a j >>= \v ->
v `pseq` return ()
sequence_ [ p j c | (j,c) <- bunchOfKeys i ]
return a
where bunchOfKeys i = take numElems $ zip cyclicIndices $ drop i cyclicChars
numElems = numberOfElems `div` numThreads
cyclicIndices = cycle [0..highestIndex]
cyclicChars = cycle chars
chars = ['a'..'z']
-- Parameters
arraySize :: Int
arraySize = 100
highestIndex = arraySize - 1
numberOfElems = 10 * 1000 * 1000
Я скомпилировал это с помощью ghc 7.2.1 (аналогичные результаты с 7.0.3) с помощью ghc --make -rtsopts -rereaded -fforce-Recomp -O2 DirectTableTest.hs ".Запуск «time ./DirectTableTest 1 + RTS -N1» занимает около 1,4 секунды, а запуск «time ./DirectTableTest 2 + RTS -N2» занимает около 2,0 секунды!Использование большего количества ядер, чем рабочих потоков, немного лучше: «time ./DirectTableTest 1 + RTS -N1» занимает около 1,4 секунды, а «time ./DirectTableTest 1 + RTS -N2» и «time ./DirectTableTest 2 + RTS»-N3 "оба занимают около 1,4 секунды.Запуск с опцией "-N2 -s" показывает, что производительность составляет 95,4%, а GC - 4,3%.Глядя на прогон программы с ThreadScope, я не вижу ничего слишком тревожного.Каждый HEC дает один раз за мс, когда происходит GC.Работа с 4 ядрами дает время около 1,2 секунды, что, по крайней мере, немного лучше, чем 1 ядро.Больше ядер не улучшится по сравнению с этим.
Я обнаружил, что изменение типа массива, используемого в реализации DirectAddressTable с IOArray на IOUArray, решает эту проблему.С этим изменением время выполнения «time ./DirectTableTest 1 + RTS -N1» составляет около 1,4 секунды, тогда как время «time ./DirectTableTest 2 + RTS -N2» составляет около 1,0 секунды.Увеличение до 4 ядер дает время работы 0,55 секунды.Запуск с "-s" показывает время GC% 3,9 процента.Под ThreadScope я вижу, что оба потока выдают каждые 0,4 мс, чаще, чем в предыдущей программе.
Наконец, я попробовал еще один вариант.Вместо того, чтобы потоки работали с одним и тем же общим массивом, каждый поток работал со своим собственным массивом.Это хорошо масштабируется (как и следовало ожидать), более или менее как вторая программа, с IOArray или IOUArray, реализующим структуру данных DirectAddressTable.
Я понимаю, почему IOUArray может работать лучше, чем IOArray, но я незнаю, почему он лучше масштабируется на несколько потоков и ядер.Кто-нибудь знает, почему это может происходить или что я могу сделать, чтобы узнать, что происходит?Интересно, может ли эта проблема быть связана с блокировкой нескольких потоков при оценке одного и того же блока и связана ли она с этим: http://hackage.haskell.org/trac/ghc/ticket/3838.