Bug in parallel GHC runtime?

23 May 2008

      Hello all,

  The attached file was compiled by the following command:

ghc -O2 --make -threaded ltest1pl.hs -o alall

When run in a sequential mode, I get this result:
./alall
Starting ...
Lst1: 41666666650000
Lst2: 41669166700000
T1: 0m 1.0e-6s
36
End!

On the other hand, when run in a threaded mode, I get the following error:
./alall +RTS -N2
Starting ...
Lst1: 41666666650000
Lst2: 41669166700000
T1: 0m 0.0s
Segmentation fault

Is it fault of the GHC runtime, or is it something on my side?

My machine: uname -a
Linux pc 2.6.24-ARCH #1 SMP PREEMPT Sun Mar 30 10:50:22 CEST 2008 x86_64 
Intel(R) Core(TM)2 CPU 6600 @ 2.40GHz GenuineIntel GNU/Linux

My ghc: ghc --version
The Glorious Glasgow Haskell Compilation System, version 6.8.2

Thanks and regards
  Dusan

--import Control.Concurrent
--import Control.Concurrent.MVar
import System.Time

import Control.Parallel.Strategies

--import Data.List (foldl')
import qualified Data.ByteString as B

sumAllSums [] = 0
sumAllSums l@(_:xs) = sumlist 0 l + sumAllSums xs
  where  sumlist res [] = res	
         sumlist sr  (v:vs) = sumlist (sr+v) vs

wlist2wbs [] = B.pack []
wlist2wbs l@(_:_) = B.pack $ encode l
  where
    encode :: Integral a => [Int] -> [a]
    encode [] = []
    encode (x:xs) = 
      if x==0 then 0:0:encode xs
      else fromIntegral (x `mod` 256) : fromIntegral (x `div` 256) : encode xs

main = do
  putStrLn $ "Starting ..."
  let lst1 = [0..49999]
  let lst2 = [0..50000]
  let bs1 = wlist2wbs lst1
  let bs2 = wlist2wbs lst2
  tm1 <- getClockTime
  let (v1:v2:_) = parMap rnf sumAllSums [lst1,lst2]
  tm1' <- getClockTime
  putStrLn ("Lst1: " ++ show v1)
  putStrLn ("Lst2: " ++ show v2)
  let tdiff1 = diffClockTimes tm1' tm1
  --let tdiff2 = diffClockTimes tm2' tm2
  putStrLn $ "T1: " ++ show (tdMin tdiff1) ++ "m " ++ show (fromIntegral(tdSec tdiff1) + fromIntegral(tdPicosec tdiff1)/1e12) ++ "s"
  --putStrLn $ "T2: " ++ show (tdMin tdiff2) ++ "m " ++ show (fromIntegral(tdSec tdiff2) + fromIntegral(tdPicosec tdiff2)/1e12) ++ "s"
  putStrLn $ show $ {-ibs1 +-} B.index bs1 99999 + B.index bs2 49999 {-((bs1 + fromIntegral (B.index bs2 99999)) :: Integer)-}
  putStrLn $ "End!"

{-
main = do
  tm1 <- getClockTime
  putStrLn $ "Starting ... "
  mv1 <- newEmptyMVar
  mv2 <- newEmptyMVar
  t1 <- forkIO (putMVar mv1 $! sumAllSums [0..49999])
  t2 <- forkIO (putMVar mv2 $!  sumAllSums [1..50000])
  v1 <- takeMVar mv1
  v2 <- takeMVar mv2
  killThread t1
  killThread t2
  putStrLn $ "Result: " ++ show (v1+v2)
  tm2 <- getClockTime
  let tdiff = diffClockTimes tm2 tm1
  putStrLn $ "End! " ++ show (tdMin tdiff) ++ "m " ++ show (fromIntegral(tdSec tdiff) + fromIntegral(tdPicosec tdiff)/1e12) ++ "s"
-}

Dusan Kolar

Don Stewart

Simon Marlow

tags

participants (3)