GHC 6.10.1 multi-threaded broken?

Hi, Since I upgraded from ghc 6.8.3 to 6.10.1, I noticed that my programs do not run multi-threaded anymore. I tried simplifying my code, till I just took one of the par/pseq demo's to verify if it wasn't my fault. When I compile this code on 6.8.3 (both ubuntu and OS X), top shows something like 180% CPU usage and the elapsed time is almost halved. When compiled with 6.10.1, top shows max 100% and no speedup is noticable at all. Sample run: $ ghc --make -threaded paralleltest $ time ./paralleltest +RTS -N1 -RTS 119201850 real 0m26.024s user 0m25.494s sys 0m0.220s $ time ./paralleltest +RTS -N2 -RTS 119201850 real 0m25.770s user 0m25.539s sys 0m0.167s I have the same on OS X and Ubuntu. I even compiled the Ubuntu ghc from source myself and verified that GMP was used. Any ideas? Thanks, Jeroen Here's the code: module Main where import Control.Parallel fib :: Int -> Int fib 0 = 0 fib 1 = 1 fib n = fib (n - 1) + fib (n - 2) mkList :: Int-> [Int] mkList n = [1..n-1] relprime :: Int -> Int -> Bool relprime x y = gcd x y == 1 euler :: Int -> Int euler n = length (filter (relprime n) (mkList n)) sumEuler :: Int -> Int sumEuler = sum . (map euler) . mkList parSumFibEuler :: Int -> Int -> Int parSumFibEuler a b = f `par` (e `pseq` (e + f)) where f = fib a e = sumEuler b main = do print $ parSumFibEuler 40 7450

yrn001:
Hi,
Since I upgraded from ghc 6.8.3 to 6.10.1, I noticed that my programs do not run multi-threaded anymore. I tried simplifying my code, till I just took one of the par/pseq demo's to verify if it wasn't my fault.
This sounds like the change to the scheduler where only 1 spark won't trigger the other core to wake up. See this mail from Simon Marlow, http://www.haskell.org/pipermail/haskell-cafe/2008-November/050974.html "I'll make sure it gets fixed for 6.10.2. If you have more sparks then you shouldn't see this problem. Also, GHC HEAD is quite a lot better with parallel programs than 6.10.1, I'll try to get around to posting some figures sometime."
participants (2)
-
Don Stewart
-
Jeroen Baekelandt