[commit: ghc] ghc-lwc2: Disabled resuming scheduler blocked on foreign call (1e286ec)

[Sivaramakrishnan Krishnamoorthy Chandrasekaran]

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

On branch  : ghc-lwc2

https://github.com/ghc/ghc/commit/1e286ec0717e58705046475667585f1850dd89dd

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

commit 1e286ec0717e58705046475667585f1850dd89dd
Author: KC Sivaramakrishnan <chandras at cs.purdue.edu>
Date:   Sun Apr 28 20:14:06 2013 -0400

    Disabled resuming scheduler blocked on foreign call

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

 rts/Schedule.c                        | 27 +++++++++++----------------
 tests/Benchmarks/Sieve/sieve-TMVar.hs |  2 +-
 tests/Benchmarks/Sieve/sieve-lwc.hs   |  2 +-
 3 files changed, 13 insertions(+), 18 deletions(-)

diff --git a/rts/Schedule.c b/rts/Schedule.c
index 227984a..8be1390 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -956,8 +956,8 @@ scheduleResumeBlockedOnForeignCall(Capability *cap USED_IF_THREADS)
     //Safely work
     ACQUIRE_LOCK (&cap->lock);
     incall = cap->suspended_ccalls_hd;
-    if (incall && //incall is not NULL
-        !isBoundTask (incall->task) &&
+    if (rtsFalse && //XXX disable
+        incall && //incall is not NULL
         incall->uls_stat == UserLevelSchedulerBlocked) {
 
         debugTrace (DEBUG_sched, "resuming scheduler associated with task %p"
@@ -2384,12 +2384,6 @@ suspendThread (StgRegTable *reg, rtsBool interruptible)
     }
     else {
         task->incall->uls_stat = UserLevelSchedulerBlocked;
-        //XXX KC -- If the thread is running a user-level scheduler, but is
-        //bound, we add it to the tail of the queue. We also avoid resuming the
-        //scheduler of such threads since it seems to cause errors with the
-        //IOManager.
-        if (isBoundTask (task))
-          appendToHead = rtsFalse;
     }
 #else
     task->incall->uls_stat = NoUserLevelScheduler;
@@ -2459,32 +2453,33 @@ resumeThread (void *task_)
         }
     }
 
+    /* We might have GC'd, mark the TSO dirty again */
+    dirty_TSO(cap,tso);
+    dirty_STACK(cap,tso->stackobj);
+    IF_DEBUG(sanity, checkTSO(tso));
+    tso->saved_errno = errno;
+
 #if defined(THREADED_RTS)
     //Check whether a worker has resumed our scheduler
     if (incall->uls_stat == UserLevelSchedulerRunning) {
         //Evaluate the unblock action on the upcall thread
+        debugTrace (DEBUG_sched, "cap %d: resumeThread: ULS for thread %d already resumed. errno=%d.",
+                    (int)cap->no, tso->id, errno);
         pushUpcallReturning (cap, getResumeThreadUpcall (cap, tso));
         tso->why_blocked = Yielded;
         tso = prepareUpcallThread (cap, (StgTSO*)END_TSO_QUEUE);
     }
 #endif
 
-
     traceEventRunThread(cap, tso);
 
     cap->r.rCurrentTSO = tso;
     cap->in_haskell = rtsTrue;
-    errno = saved_errno;
+    errno = tso->saved_errno;
 #if mingw32_HOST_OS
     SetLastError(saved_winerror);
 #endif
 
-    /* We might have GC'd, mark the TSO dirty again */
-    dirty_TSO(cap,tso);
-    dirty_STACK(cap,tso->stackobj);
-
-    IF_DEBUG(sanity, checkTSO(tso));
-
     return &cap->r;
 }
 
diff --git a/tests/Benchmarks/Sieve/sieve-TMVar.hs b/tests/Benchmarks/Sieve/sieve-TMVar.hs
index 60ce242..dd000a0 100644
--- a/tests/Benchmarks/Sieve/sieve-TMVar.hs
+++ b/tests/Benchmarks/Sieve/sieve-TMVar.hs
@@ -43,7 +43,7 @@ main = do
 linkFilter :: TMVar Int -> TMVar Int -> IO (TMVar Int)
 linkFilter mIn mOut = do
   prime <- atomically $ takeTMVar mIn
-  putStrLn $ show prime
   traceIO $ show prime
+  putStrLn $ show prime
   forkIO $ primeFilter mIn mOut prime
   return mOut
diff --git a/tests/Benchmarks/Sieve/sieve-lwc.hs b/tests/Benchmarks/Sieve/sieve-lwc.hs
index bf8ccae..48e12d4 100644
--- a/tests/Benchmarks/Sieve/sieve-lwc.hs
+++ b/tests/Benchmarks/Sieve/sieve-lwc.hs
@@ -41,6 +41,6 @@ main = do
 linkFilter :: MVar Int -> MVar Int -> IO (MVar Int)
 linkFilter mIn mOut = do
   prime <- takeMVar mIn
-  putStrLn $ show prime
+  debugPrint $ show prime
   forkIO $ primeFilter mIn mOut prime
   return mOut