<div>Hi,</div><div><br></div><div>I am getting my feet writing concurrent programs in Haskell with GHC for multicore machines. As a first step I decided to write a program that reads and writes concurrently to an IOArray, with no synchronization whatsoever. I'm doing this to establish a baseline to compare with the performance of other data structures that do use appropriate synchronization mechanisms. I ran in to some surprising results, namely that in many cases, I am not getting any speed up at all. Here are the details...</div>
<div><br></div><div>I write a couple variations on a single program. The main idea is that I wrote a DirectAddressTable data structure, which is simply a wrapper around an IOArray providing insert and lookup methods: </div>
<div><br></div><div>-- file DirectAddressTable.hs</div><div><div>module DirectAddressTable </div><div> ( DAT</div><div> , newDAT</div><div> , lookupDAT</div><div> , insertDAT</div><div> , getAssocsDAT</div>
<div> )</div><div> where</div>
<div><br></div><div>import <a href="http://Data.Array.IO" target="_blank">Data.Array.IO</a></div><div>import Data.Array.MArray</div><div>import Data.Int (Int32)</div><div><br></div><div>data DAT = DAT (IOArray Int32 Char)</div>
<div><br></div>
<div><div>-- create a fixed size array; missing keys have value '-'.</div><div>newDAT :: Int32 -> IO (DAT)</div><div>newDAT n = do a <- newArray (0, n - 1) '-'</div><div> return (DAT a)</div>
<div> </div><div>-- lookup an item.</div><div>lookupDAT :: DAT -> Int32 -> IO (Maybe Char)</div><div>lookupDAT (DAT a) i = do c <- readArray a i </div><div> return (if c=='-' then Nothing else Just c)</div>
<div><br></div><div>-- insert an item</div><div>insertDAT :: DAT -> Int32 -> Char -> IO ()</div><div>insertDAT (DAT a) i v = writeArray a i v</div><div><br></div><div>-- get all associations (exclude missing items, i.e. those whose value is '-').</div>
<div>getAssocsDAT :: DAT -> IO [(Int32,Char)]</div><div>getAssocsDAT (DAT a) = </div><div> do assocs <- getAssocs a</div><div> return [ (k,c) | (k,c) <- assocs, c /= '-' ]</div></div></div><div><br>
</div>
<div>I then have a main program that initializes a new table, forks some threads, with each thread writing and reading some fixed number of values to the just initialized table. The overall number of elements to write is fixed. The number of threads to use is a taken from a command line argument, and the elements to process are evenly divided among the threads.</div>
<div><br></div><div>-- file DirectTableTest.hs</div><div>import DirectAddressTable</div><div>import Data.Int (Int32)</div><div>import Control.Concurrent</div><div>import Control.Parallel</div><div>import System.Environment</div>
<div>
<br></div><div>main = </div><div> do args <- getArgs</div><div> let numThreads = read (args !! 0)</div><div> vs <- sequence (replicate numThreads newEmptyMVar)</div><div> a <- newDAT arraySize </div>
<div> sequence_ [ forkIO (doLotsOfStuff numThreads i a >>= putMVar v) | (i,v) <- zip [1..] vs]</div><div> sequence_ [ takeMVar v >>= \a -> getAssocsDAT a >>= \xs -> print (last xs) | v <- vs] </div>
<div> </div><div>doLotsOfStuff :: Int -> Int -> DAT -> IO DAT</div>
<div>doLotsOfStuff numThreads i a = </div><div> do let p j c = insertDAT a j c >> lookupDAT a j >>= \v -> v `pseq` return () </div><div> sequence_ [ p j c | (j,c) <- bunchOfKeys j ]</div><div> return a</div>
<div> where bunchOfKeys i = take numElems $ zip cyclicIndices $ drop i cyclicChars</div><div> numElems = numberOfElems `div` numThreads</div><div><br></div><div>cyclicIndices = cycle [0..highestIndex]</div>
<div>cyclicChars = cycle chars</div><div>chars = ['a'..'z']</div><div><br></div><div>-- Parameters</div><div>arraySize :: Int32</div><div>arraySize = 100</div><div>highestIndex = arraySize - 1</div>
<div>numberOfElems = 10 * 1000 * 1000 </div><div><br></div><div><br></div><div>I compiled this with "ghc --make -rtsopts -threaded -fforce-recomp -O2 DirectTableTest.hs". </div><div>Running "time ./DirectTableTest 1 +RTS -N1" takes about 1.4 seconds and running "time ./DirectTableTest 2 +RTS -N2" take about 2.0 seconds! Using one more core than worker threads is a little better, with "time ./DirectTableTest 1 +RTS -N1" takes about 1.4 seconds and running "time ./DirectTableTest 1 +RTS -N2" and "time ./DirectTableTest 2 +RTS -N3" both taking about 1.4 seconds.</div>
<div>Running with the "-N2 -s" option shows that productivity is 95.4% and GC is 4.3%. Looking at a run of the program with ThreadScope I don't see anything too alarming. Each HEC yields once per ms when a GC occurs. Running with 4 cores gives a time of about 1.2 seconds, which is at least a little better than 1 core. More cores doesn't improve over this.</div>
<div><br></div><div>I found that changing the array type used in the implementation of DirectAddressTable from IOArray to IOUArray fixes this problem. With this change, the running time of "time ./DirectTableTest 1 +RTS -N1" is takes about 1.4 seconds whereas the running "time ./DirectTableTest 2 +RTS -N2" is about 1.0 seconds. Increasing to 4 cores gives a run time of 0.55 seconds. Running with "-s" shows a GC time of %3.9 percent. Under ThreadScope I can see that both threads yield every 0.4 ms, more frequently than in the previous program. </div>
<div><br></div><div>Finally, I tried one more variation. Instead of having the threads work on the same shared array, I had each thread work on its own array. This scales nicely (as you would expect), more or less like the second program, with either IOArray or IOUArray implementing the DirectAddressTable data structure.</div>
<div><br></div><div>I understand why IOUArray might perform better than IOArray, but I don't know why it scales better to multiple threads and cores. Does anyone know why this might be happening or what I can do to find out what is going on? </div>
<div><br></div><div>Regards, </div><div>Andreas</div>