From: simonmar <unknown>
Date: Fri, 4 Nov 2005 15:33:36 +0000 (+0000)
Subject: [project @ 2005-11-04 15:33:36 by simonmar]
X-Git-Tag: Initial_conversion_from_CVS_complete~68
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=de808d3b036673f29693f8380e1114c19d0d3493;p=ghc-hetmet.git

[project @ 2005-11-04 15:33:36 by simonmar]
patch up forkProcess(): don't discard our own Task, and set
cap->spare_workers to be empty in the child process.
---

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);