[project @ 2005-11-07 10:20:43 by simonmar]

[ghc-hetmet.git] / ghc / rts / Schedule.c

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 6528fdd..93a64d8 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -192,7 +192,7 @@ rtsBool shutting_down_scheduler = rtsFalse;
  * the THREADED_RTS and (inc. SMP) runtime.
  */
 #if defined(THREADED_RTS)
-Mutex sched_mutex = INIT_MUTEX_VAR;
+Mutex sched_mutex;
 #endif
 
 #if defined(PARALLEL_HASKELL)
@@ -779,7 +779,8 @@ schedulePushWork(Capability *cap USED_WHEN_SMP,
        for (; t != END_TSO_QUEUE; t = next) {
            next = t->link;
            t->link = END_TSO_QUEUE;
-           if (t->what_next == ThreadRelocated) {
+           if (t->what_next == ThreadRelocated
+               || t->bound == task) { // don't move my bound thread
                prev->link = t;
                prev = t;
            } else if (i == n_free_caps) {
@@ -2020,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!"));
@@ -2051,12 +2052,18 @@ 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);
+
+#if defined(THREADED_RTS)
+       // wipe our spare workers list.
+       cap->spare_workers = NULL;
+#endif
+
        cap = rts_evalStableIO(cap, entry, NULL);  // run the action
        rts_checkSchedStatus("forkProcess",cap);