Parallel forkOS does not work on ubuntu

[Don Stewart]

hoangta:
>    Hello everybody,
>    I am following "A Tutorial on Parallel and Concurrent Programming in
>    Haskell" and I have a problem with making Haskell to use my multi-cores
>    (Core 2 Quad  CPU).
>    The Haskel version I used is GHC 6.10.1, for Haskell 98. I compile my
>    below program with command: ghc --make -threaded -debug thread0.hs, and
>    run with: thread0 +RTS -N4 while watching the cpu usage on another
>    terminal (by: mpstat -P ALL 1 100), but the program uses only one core of
>    my Ubuntu Linux.
>    Do any of you know why or has any suggestions? Below is my program:

>    import Control.Concurrent
>    import Control.Concurrent.MVar
>    fib :: Int -> Int
>    fib 0 = 0
>    fib 1 = 1
>    fib n = fib (n-1) + fib (n-2)
>    dowork =
>    putStrLn ("fib 35 = " ++ (show (fib 35)))
>    threadA :: MVar Int -> MVar Int -> MVar Int -> IO ()
>    threadA valueToSendMVar valueToReadMVar valueToQuit
>    = do
>    -- some work
>    dowork
>    -- perform rendezvous
>    putMVar valueToSendMVar 30 -- send value
>    v <- takeMVar valueToReadMVar
>    putStrLn ("result, fib 30 = " ++ (show v))
>    dowork
>    -- notify done
>    putMVar valueToQuit 0 -- send value
>    threadB :: MVar Int -> MVar Int -> MVar Int -> IO ()
>    threadB valueToReceiveMVar valueToSendMVar valueToQuit
>    = do
>    -- some work
>    dowork
>    -- perform rendezvous by waiting
>    z <- takeMVar valueToReceiveMVar
>    putMVar valueToSendMVar (fib z)
>    -- continue with other work
>    dowork
>    -- notify done
>    putMVar valueToQuit 0 -- send value
>    main :: IO ()
>    main
>    = do
>    aQuitA <- newEmptyMVar
>    aQuitB <- newEmptyMVar
>    aMVar <- newEmptyMVar
>    bMVar <- newEmptyMVar
>    forkOS (threadA aMVar bMVar aQuitA )
>    forkOS (threadB aMVar bMVar aQuitB )
>    -- wait for threadA and threadB
>    takeMVar aQuitA
>    takeMVar aQuitB
>    return ()



How about,

    import Control.Parallel
    import Control.Monad
    import Text.Printf

    cutoff = 35

    fib' :: Int -> Integer
    fib' 0 = 0
    fib' 1 = 1
    fib' n = fib' (n-1) + fib' (n-2)

    fib :: Int -> Integer
    fib n | n < cutoff = fib' n
          | otherwise  = r `par` (l `pseq` l + r)
     where
        l = fib (n-1)
        r = fib (n-2)

    main = forM_ [0..45] $ \i ->
                    printf "n=%d => %d\n" i (fib i) 

Where:


    $ ghc -O2 -threaded fib.hs  --make
    Linking fib ...

    $ time ./fib +RTS -N2
    n=0 => 0
    n=1 => 1
    n=2 => 1
    n=3 => 2
    n=4 => 3
    ...
    n=43 => 433494437
    n=44 => 701408733
    n=45 => 1134903170
    ./fib 30 +RTS -N2  107.56s user 0.54s system 184% cpu 58.703 tota