Parallel forkOS does not work on ubuntu

Hoang Truong hoangta at comp.nus.edu.sg
Tue Dec 9 20:27:32 EST 2008


Thanks Don. Your fib program works well. It uses all four cores of my
computer with +RTS -N4. But the Wombat.hs still does not work. It seems
tricky to me.

Hoang

On Wed, Dec 10, 2008 at 4:47 AM, Don Stewart <dons at galois.com> wrote:

> 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
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/glasgow-haskell-users/attachments/20081210/344326fb/attachment.htm


More information about the Glasgow-haskell-users mailing list