[commit: ghc] ghc-lwc2: Edits to chameneos (d3819f7)

[Sivaramakrishnan Krishnamoorthy Chandrasekaran]

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

On branch  : ghc-lwc2

https://github.com/ghc/ghc/commit/d3819f770d4d60bdebabd04ddb726ee2920d2952

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

commit d3819f770d4d60bdebabd04ddb726ee2920d2952
Author: KC Sivaramakrishnan <chandras at cs.purdue.edu>
Date:   Fri Mar 8 20:05:37 2013 -0500

    Edits to chameneos

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

 rts/PrimOps.cmm                                        |  4 +++-
 tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs | 12 ++++++------
 2 files changed, 9 insertions(+), 7 deletions(-)

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index b14168e..072ceb8 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -739,6 +739,8 @@ again: MAYBE_GC(again);
 stg_setSContCapabilityzh ( gcptr scont , W_ target )
 {
 
+again: MAYBE_GC(again);
+
 #if defined (THREADED_RTS)
   ccall setOwningCapability (MyCapability() "ptr", scont, target);
 #endif
@@ -856,7 +858,7 @@ stg_newSContzh ( gcptr closure )
 
   // context switch soon, but not immediately: we don't want every
   // newSCont to force a context-switch.
-  Capability_context_switch(MyCapability()) = 1 :: CInt;
+  // Capability_context_switch(MyCapability()) = 1 :: CInt;
 
   return (threadid);
 }
diff --git a/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs b/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs
index 5dca5bb..70a511b 100644
--- a/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs
+++ b/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs
@@ -10,7 +10,7 @@
 
 import LwConc.Substrate
 import LwConc.ConcurrentList
-import LwConc.MVarList
+import LwConc.MVar
 import Control.Monad
 import Data.Char
 import Data.IORef
@@ -50,10 +50,10 @@ arrive !mpv !finish !ch = do
             case w of
                 Nobody 0
                   -> do
-                      atomically $ asyncPutMVar mpv w
-                      atomically $ asyncPutMVar finish (t, b)
+                      putMVar mpv w
+                      putMVar finish (t, b)
                 Nobody q -> do
-                    atomically $ asyncPutMVar mpv $ Somebody q ch waker
+                    putMVar mpv $ Somebody q ch waker
                     ch' <- takeMVarWithHole waker hole2
                     go (t+1) $ inc ch' b
                 Somebody q ch' waker' -> do
@@ -62,9 +62,9 @@ arrive !mpv !finish !ch = do
                     let !c'' = complement c c'
                     poke ch  c''
                     poke ch' c''
+                    putMVar waker' ch
                     let !q' = q-1
-                    atomically $ asyncPutMVar waker' ch
-                    atomically $ asyncPutMVar mpv $ Nobody q'
+                    putMVar mpv $ Nobody q'
                     go (t+1) $ inc ch' b
     go 0 0