[commit: ghc] ghc-lwc2: Added -O2 flag for lwconc library. Using takeMVarWithHole for sieve-lwc -- reduces allocation overhead. (7711fe9)

Sivaramakrishnan Krishnamoorthy Chandrasekaran t-sichan at microsoft.com
Fri Mar 8 19:19:46 CET 2013


Repository : http://darcs.haskell.org/ghc.git/

On branch  : ghc-lwc2

http://hackage.haskell.org/trac/ghc/changeset/7711fe9e8096eb3c84b7d6d89403d5e0669d73f9

>---------------------------------------------------------------

commit 7711fe9e8096eb3c84b7d6d89403d5e0669d73f9
Author: KC Sivaramakrishnan <chandras at cs.purdue.edu>
Date:   Tue Mar 5 12:36:09 2013 -0500

    Added -O2 flag for lwconc library. Using takeMVarWithHole for sieve-lwc -- reduces allocation overhead.

>---------------------------------------------------------------

 libraries/lwconc/lwconc.cabal       |  2 +-
 rts/Schedule.h                      |  4 ++--
 tests/Benchmarks/Sieve/sieve-lwc.hs | 21 ++++++++++++---------
 3 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/libraries/lwconc/lwconc.cabal b/libraries/lwconc/lwconc.cabal
index b5cc580..0b3a78a 100644
--- a/libraries/lwconc/lwconc.cabal
+++ b/libraries/lwconc/lwconc.cabal
@@ -21,5 +21,5 @@ Library
     Build-Depends: base       >= 4.2   && < 5,
                    array,
                    containers >= 0.1 && < 0.6
-    ghc-options: -Wall
+    ghc-options: -Wall -O2
 
diff --git a/rts/Schedule.h b/rts/Schedule.h
index 72a3f3c..fe8b2b3 100644
--- a/rts/Schedule.h
+++ b/rts/Schedule.h
@@ -212,13 +212,13 @@ appendToBlockedQueue(StgTSO *tso)
 
 /* Check whether various thread queues are empty
  */
-  INLINE_HEADER rtsBool
+INLINE_HEADER rtsBool
 emptyQueue (StgTSO *q)
 {
   return (q == END_TSO_QUEUE);
 }
 
-  INLINE_HEADER rtsBool
+INLINE_HEADER rtsBool
 emptyRunQueue(Capability *cap)
 {
   return emptyQueue(cap->run_queue_hd);
diff --git a/tests/Benchmarks/Sieve/sieve-lwc.hs b/tests/Benchmarks/Sieve/sieve-lwc.hs
index 6c46282..5066ad8 100644
--- a/tests/Benchmarks/Sieve/sieve-lwc.hs
+++ b/tests/Benchmarks/Sieve/sieve-lwc.hs
@@ -20,8 +20,9 @@ generate mOut = mapM_ (putMVar mOut) [2..]
 -- Take a value from mIn, divide it by a prime, if the remainder is not 0, put the value in mOut.
 primeFilter :: MVar Int -> MVar Int -> Int -> IO ()
 primeFilter mIn mOut prime = do
+  hole <- newIORef 0
   forever $ do
-    i <- takeMVar mIn
+    i <- takeMVarWithHole mIn hole
     when (i `mod` prime /= 0) (putMVar mOut i)
 
 -- Take the first commandline argument and call it numArg.
@@ -29,19 +30,21 @@ primeFilter mIn mOut prime = do
 -- Read numArg as an integer value, and run newEmptyMVar that amount of times,
 -- calling the result out.
 -- Fold over the elements of out, with the function linkFilter, having mIn as the first value.
-main = do initSched
+main = do
+          initSched
           numArg:_ <- getArgs
           mIn <- newEmptyMVar
           forkIO $ generate mIn
           out <- replicateM (read numArg) newEmptyMVar
-          foldM_ linkFilter mIn out
+          hole <- newIORef 0
+          foldM_ (linkFilter hole) mIn out
 
 -- Take a value from mIn, and call it prime. Then show that prime. Make a new thread that
 -- runs primeFilter with mIn, mOut and the prime. When this function is used as a fold
 -- function, mOut becomes the mIn of the next iteration.
-linkFilter :: MVar Int -> MVar Int -> IO (MVar Int)
-linkFilter mIn mOut = do prime <- takeMVar mIn
-                         putStrLn $ show prime
-                         forkIO $ primeFilter mIn mOut prime
-                         return mOut
-
+linkFilter :: IORef Int -> MVar Int -> MVar Int -> IO (MVar Int)
+linkFilter hole mIn mOut = do
+  prime <- takeMVarWithHole mIn hole
+  putStrLn $ show prime
+  forkIO $ primeFilter mIn mOut prime
+  return mOut





More information about the ghc-commits mailing list