X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSchedule.c;h=8db125da743d0f802f3ab2d3b1c6f3ef385c175e;hb=f9b4bc220a684a970a58dafa9e57d665d29b4121;hp=f7b26a4876f1cb0ec75bd6d1d84f1ffb377a7b87;hpb=f4692220c7cbdadaa633f50eb2b30b59edb30183;p=ghc-hetmet.git

diff --git a/rts/Schedule.c b/rts/Schedule.c
index f7b26a4..8db125d 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -1235,23 +1235,23 @@ scheduleHandleThreadFinished (Capability *cap STG_UNUSED, Task *task, StgTSO *t)
 	  ASSERT(task->incall->tso == t);
 
 	  if (t->what_next == ThreadComplete) {
-	      if (task->ret) {
+	      if (task->incall->ret) {
 		  // NOTE: return val is tso->sp[1] (see StgStartup.hc)
-		  *(task->ret) = (StgClosure *)task->incall->tso->sp[1]; 
+		  *(task->incall->ret) = (StgClosure *)task->incall->tso->sp[1]; 
 	      }
-	      task->stat = Success;
+	      task->incall->stat = Success;
 	  } else {
-	      if (task->ret) {
-		  *(task->ret) = NULL;
+	      if (task->incall->ret) {
+		  *(task->incall->ret) = NULL;
 	      }
 	      if (sched_state >= SCHED_INTERRUPTING) {
                   if (heap_overflow) {
-                      task->stat = HeapExhausted;
+                      task->incall->stat = HeapExhausted;
                   } else {
-                      task->stat = Interrupted;
+                      task->incall->stat = Interrupted;
                   }
 	      } else {
-		  task->stat = Killed;
+		  task->incall->stat = Killed;
 	      }
 	  }
 #ifdef DEBUG
@@ -1533,10 +1533,14 @@ forkProcess(HsStablePtr *entry
     ACQUIRE_LOCK(&cap->lock);
     ACQUIRE_LOCK(&cap->running_task->lock);
 
+    stopTimer(); // See #4074
+
     pid = fork();
     
     if (pid) { // parent
 	
+        startTimer(); // #4074
+
         RELEASE_LOCK(&sched_mutex);
         RELEASE_LOCK(&cap->lock);
         RELEASE_LOCK(&cap->running_task->lock);
@@ -1887,8 +1891,8 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability *cap)
     tso->cap = cap;
 
     task->incall->tso = tso;
-    task->ret = ret;
-    task->stat = NoStatus;
+    task->incall->ret = ret;
+    task->incall->stat = NoStatus;
 
     appendToRunQueue(cap,tso);
 
@@ -1897,7 +1901,7 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability *cap)
 
     cap = schedule(cap,task);
 
-    ASSERT(task->stat != NoStatus);
+    ASSERT(task->incall->stat != NoStatus);
     ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
 
     debugTrace(DEBUG_sched, "bound thread (%lu) finished", (unsigned long)id);
@@ -1997,12 +2001,7 @@ initScheduler(void)
 }
 
 void
-exitScheduler(
-    rtsBool wait_foreign
-#if !defined(THREADED_RTS)
-                         __attribute__((unused))
-#endif
-)
+exitScheduler (rtsBool wait_foreign USED_IF_THREADS)
                /* see Capability.c, shutdownCapability() */
 {
     Task *task = NULL;
@@ -2551,6 +2550,12 @@ resurrectThreads (StgTSO *threads)
 	     * can wake up threads, remember...).
 	     */
 	    continue;
+        case BlockedOnMsgThrowTo:
+            // This can happen if the target is masking, blocks on a
+            // black hole, and then is found to be unreachable.  In
+            // this case, we want to let the target wake up and carry
+            // on, and do nothing to this thread.
+            continue;
 	default:
 	    barf("resurrectThreads: thread blocked in a strange way: %d",
                  tso->why_blocked);