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. <br><br><div>Hoang</div><div><br><div class="gmail_quote">On Wed, Dec 10, 2008 at 4:47 AM, Don Stewart <span dir="ltr"><<a href="mailto:dons@galois.com">dons@galois.com</a>></span> wrote:<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex;">hoangta:<br>
<div><div></div><div class="Wj3C7c">> Hello everybody,<br>
> I am following "A Tutorial on Parallel and Concurrent Programming in<br>
> Haskell" and I have a problem with making Haskell to use my multi-cores<br>
> (Core 2 Quad CPU).<br>
> The Haskel version I used is GHC 6.10.1, for Haskell 98. I compile my<br>
> below program with command: ghc --make -threaded -debug thread0.hs, and<br>
> run with: thread0 +RTS -N4 while watching the cpu usage on another<br>
> terminal (by: mpstat -P ALL 1 100), but the program uses only one core of<br>
> my Ubuntu Linux.<br>
> Do any of you know why or has any suggestions? Below is my program:<br>
<br>
> import Control.Concurrent<br>
> import Control.Concurrent.MVar<br>
> fib :: Int -> Int<br>
> fib 0 = 0<br>
> fib 1 = 1<br>
> fib n = fib (n-1) + fib (n-2)<br>
> dowork =<br>
> putStrLn ("fib 35 = " ++ (show (fib 35)))<br>
> threadA :: MVar Int -> MVar Int -> MVar Int -> IO ()<br>
> threadA valueToSendMVar valueToReadMVar valueToQuit<br>
> = do<br>
> -- some work<br>
> dowork<br>
> -- perform rendezvous<br>
> putMVar valueToSendMVar 30 -- send value<br>
> v <- takeMVar valueToReadMVar<br>
> putStrLn ("result, fib 30 = " ++ (show v))<br>
> dowork<br>
> -- notify done<br>
> putMVar valueToQuit 0 -- send value<br>
> threadB :: MVar Int -> MVar Int -> MVar Int -> IO ()<br>
> threadB valueToReceiveMVar valueToSendMVar valueToQuit<br>
> = do<br>
> -- some work<br>
> dowork<br>
> -- perform rendezvous by waiting<br>
> z <- takeMVar valueToReceiveMVar<br>
> putMVar valueToSendMVar (fib z)<br>
> -- continue with other work<br>
> dowork<br>
> -- notify done<br>
> putMVar valueToQuit 0 -- send value<br>
> main :: IO ()<br>
> main<br>
> = do<br>
> aQuitA <- newEmptyMVar<br>
> aQuitB <- newEmptyMVar<br>
> aMVar <- newEmptyMVar<br>
> bMVar <- newEmptyMVar<br>
> forkOS (threadA aMVar bMVar aQuitA )<br>
> forkOS (threadB aMVar bMVar aQuitB )<br>
> -- wait for threadA and threadB<br>
> takeMVar aQuitA<br>
> takeMVar aQuitB<br>
> return ()<br>
<br>
<br>
<br>
</div></div>How about,<br>
<br>
import Control.Parallel<br>
import Control.Monad<br>
import Text.Printf<br>
<br>
cutoff = 35<br>
<br>
fib' :: Int -> Integer<br>
<div class="Ih2E3d"> fib' 0 = 0<br>
fib' 1 = 1<br>
fib' n = fib' (n-1) + fib' (n-2)<br>
<br>
</div> fib :: Int -> Integer<br>
fib n | n < cutoff = fib' n<br>
| otherwise = r `par` (l `pseq` l + r)<br>
where<br>
l = fib (n-1)<br>
r = fib (n-2)<br>
<br>
main = forM_ [0..45] $ \i -><br>
printf "n=%d => %d\n" i (fib i)<br>
<br>
Where:<br>
<br>
<br>
$ ghc -O2 -threaded fib.hs --make<br>
Linking fib ...<br>
<br>
$ time ./fib +RTS -N2<br>
n=0 => 0<br>
n=1 => 1<br>
n=2 => 1<br>
n=3 => 2<br>
n=4 => 3<br>
...<br>
n=43 => 433494437<br>
n=44 => 701408733<br>
n=45 => 1134903170<br>
./fib 30 +RTS -N2 107.56s user 0.54s system 184% cpu 58.703 tota<br>
</blockquote></div><br></div>