X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FSchedule.c;h=5f186b232c7c9cd65067824129079361bd2a02ea;hb=de808d3b036673f29693f8380e1114c19d0d3493;hp=d3851eb8c5dd33b75088d9f9c897cca3c691ee08;hpb=9e780871543ab57a21de4a8ee588940d6479de11;p=ghc-hetmet.git

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index d3851eb..5f186b2 100644
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -2021,9 +2021,9 @@ forkProcess(HsStablePtr *entry
            )
 {
 #ifdef FORKPROCESS_PRIMOP_SUPPORTED
+    Task *task;
     pid_t pid;
     StgTSO* t,*next;
-    Task *task;
     Capability *cap;
     
     IF_DEBUG(scheduler,sched_belch("forking!"));
@@ -2052,12 +2052,16 @@ forkProcess(HsStablePtr *entry
 	    deleteThreadImmediately(cap,t);
 	}
 	
-	// wipe the main thread list
-	while ((task = all_tasks) != NULL) {
-	    all_tasks = task->all_link;
-	    discardTask(task);
+	// wipe the task list
+	ACQUIRE_LOCK(&sched_mutex);
+	for (task = all_tasks; task != NULL; task=task->all_link) {
+	    if (task != cap->running_task) discardTask(task);
 	}
-	
+	RELEASE_LOCK(&sched_mutex);
+
+	// wipe our spare workers list.
+	cap->spare_workers = NULL;
+
 	cap = rts_evalStableIO(cap, entry, NULL);  // run the action
 	rts_checkSchedStatus("forkProcess",cap);