[commit: ghc] ghc-lwc2: Added sieve test. Minor edits in RTS files. (2a554ca)
Sivaramakrishnan Krishnamoorthy Chandrasekaran
t-sichan at microsoft.com
Sat Mar 2 06:36:43 CET 2013
Repository : http://darcs.haskell.org/ghc.git/
On branch : ghc-lwc2
http://hackage.haskell.org/trac/ghc/changeset/2a554cab41fff86a61c947283b83a2caa93a4e6a
>---------------------------------------------------------------
commit 2a554cab41fff86a61c947283b83a2caa93a4e6a
Author: KC Sivaramakrishnan <chandras at cs.purdue.edu>
Date: Sat Mar 2 00:36:11 2013 -0500
Added sieve test. Minor edits in RTS files.
>---------------------------------------------------------------
rts/PrimOps.cmm | 2 ++
rts/Schedule.c | 39 +++++++++++++------------
rts/Threads.c | 4 ---
tests/Benchmarks/Sieve/Makefile | 8 ++++++
tests/Benchmarks/Sieve/sieve-lwc.hs | 50 +++++++++++++++++++++++++++++++++
tests/Benchmarks/Sieve/sieve-vanilla.hs | 38 +++++++++++++++++++++++++
6 files changed, 117 insertions(+), 24 deletions(-)
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index db9c3cb..d341c8e 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -726,6 +726,8 @@ again: MAYBE_GC(again);
// - tso might be bound, or current task might be bound in which case we
// need to pass capability to correct task
// - task might have returned from a safe foreign call
+ // - Pending upcalls
+ // - and more..
jump stg_switch_noregs [];
} else {
/* Transaction was not valid: try again */
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 84de8b8..b9b453e 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -455,29 +455,28 @@ run_thread:
dirty_TSO(cap,t);
dirty_STACK(cap,t->stackobj);
- switch (recent_activity)
- {
- case ACTIVITY_DONE_GC: {
- // ACTIVITY_DONE_GC means we turned off the timer signal to
- // conserve power (see #1623). Re-enable it here.
- nat prev;
- prev = xchg((P_)&recent_activity, ACTIVITY_YES);
- if (prev == ACTIVITY_DONE_GC) {
+ switch (recent_activity) {
+ case ACTIVITY_DONE_GC: {
+ // ACTIVITY_DONE_GC means we turned off the timer signal to
+ // conserve power (see #1623). Re-enable it here.
+ nat prev;
+ prev = xchg((P_)&recent_activity, ACTIVITY_YES);
+ if (prev == ACTIVITY_DONE_GC) {
#ifndef PROFILING
- startTimer();
+ startTimer();
#endif
+ }
+ break;
+ }
+ case ACTIVITY_INACTIVE:
+ // If we reached ACTIVITY_INACTIVE, then don't reset it until
+ // we've done the GC. The thread running here might just be
+ // the IO manager thread that handle_tick() woke up via
+ // wakeUpRts().
+ break;
+ default:
+ recent_activity = ACTIVITY_YES;
}
- break;
- }
- case ACTIVITY_INACTIVE:
- // If we reached ACTIVITY_INACTIVE, then don't reset it until
- // we've done the GC. The thread running here might just be
- // the IO manager thread that handle_tick() woke up via
- // wakeUpRts().
- break;
- default:
- recent_activity = ACTIVITY_YES;
- }
traceEventRunThread(cap, t);
diff --git a/rts/Threads.c b/rts/Threads.c
index 546b3be..25ebfc5 100644
--- a/rts/Threads.c
+++ b/rts/Threads.c
@@ -345,8 +345,6 @@ unblock1:
* But is this correct? */
goto unblock2;
}
- debugTrace (DEBUG_sched, "tryWakeupThread: unblocking thread %d through unblock1",
- (int)tso->id);
tso->why_blocked = Yielded;
pushUpcallReturning (cap, getResumeThreadUpcall (cap, tso));
return;
@@ -354,8 +352,6 @@ unblock1:
unblock2:
// just run the thread now, if the BH is not really available,
// we'll block again.
- debugTrace (DEBUG_sched, "tryWakeupThread: unblocking thread %d through unblock2",
- (int)tso->id);
tso->why_blocked = NotBlocked;
appendToRunQueue(cap,tso);
return;
diff --git a/tests/Benchmarks/Sieve/Makefile b/tests/Benchmarks/Sieve/Makefile
new file mode 100644
index 0000000..f32dfca
--- /dev/null
+++ b/tests/Benchmarks/Sieve/Makefile
@@ -0,0 +1,8 @@
+TARGET := sieve-vanilla.bin sieve-lwc.bin
+
+include ../../config.mk
+
+TOP := ../../../
+GHC_OPTS_EXTRA=-threaded -XBangPatterns -prof -auto-all
+
+all: $(TARGET)
diff --git a/tests/Benchmarks/Sieve/sieve-lwc.hs b/tests/Benchmarks/Sieve/sieve-lwc.hs
new file mode 100644
index 0000000..c837b6c
--- /dev/null
+++ b/tests/Benchmarks/Sieve/sieve-lwc.hs
@@ -0,0 +1,50 @@
+-- Compile with `ghc -threaded -with-rtsopts=-N concurrent_sieve.hs`
+
+import Control.Monad
+import LwConc.Concurrent
+import LwConc.Substrate
+import LwConc.MVar
+import System.Environment
+
+initSched = do
+ newSched
+ n <- getNumCapabilities
+ spawnScheds $ n-1
+ where
+ spawnScheds 0 = return ()
+ spawnScheds n = do
+ newCapability
+ spawnScheds (n-1)
+
+-- Map over [2..] (2 until infinity), putting the value in mOut. The putting operation will block until
+-- mOut is empty. mOut will become empty when some other thread executes takeMVar (getting its value).
+generate :: MVar Int -> IO ()
+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 = forever $ do
+ i <- takeMVar mIn
+ when (i `mod` prime /= 0) (putMVar mOut i)
+
+-- Take the first commandline argument and call it numArg.
+-- Create a new mVar and call it mIn and spawn a thread that runs generate on mIn.
+-- 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
+ numArg:_ <- getArgs
+ mIn <- newEmptyMVar
+ forkIO $ generate mIn
+ out <- replicateM (read numArg) newEmptyMVar
+ foldM_ linkFilter 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
+
diff --git a/tests/Benchmarks/Sieve/sieve-vanilla.hs b/tests/Benchmarks/Sieve/sieve-vanilla.hs
new file mode 100644
index 0000000..2aa410c
--- /dev/null
+++ b/tests/Benchmarks/Sieve/sieve-vanilla.hs
@@ -0,0 +1,38 @@
+-- Compile with `ghc -threaded -with-rtsopts=-N concurrent_sieve.hs`
+
+import Control.Concurrent
+import Control.Monad
+
+import System.Environment
+
+-- Map over [2..] (2 until infinity), putting the value in mOut. The putting operation will block until
+-- mOut is empty. mOut will become empty when some other thread executes takeMVar (getting its value).
+generate :: MVar Int -> IO ()
+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 = forever $ do
+ i <- takeMVar mIn
+ when (i `mod` prime /= 0) (putMVar mOut i)
+
+-- Take the first commandline argument and call it numArg.
+-- Create a new mVar and call it mIn and spawn a thread that runs generate on mIn.
+-- 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 numArg:_ <- getArgs
+ mIn <- newEmptyMVar
+ forkIO $ generate mIn
+ out <- replicateM (read numArg) newEmptyMVar
+ foldM_ linkFilter 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
+
More information about the ghc-commits
mailing list