Edits to chameneos

ghc · Mar 9, 2013 · d3819f7 · d3819f7
1 parent 02235dd
commit d3819f7
Show file tree

Hide file tree

Showing 2 changed files with 9 additions and 7 deletions.
diff --git 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
@@ -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