[project @ 2005-05-09 10:18:05 by simonmar]

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

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 036c5b0..7075b20 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -2093,8 +2093,12 @@ deleteAllThreads ( void )
   StgTSO* t, *next;
   IF_DEBUG(scheduler,sched_belch("deleting all threads"));
   for (t = all_threads; t != END_TSO_QUEUE; t = next) {
-      next = t->global_link;
-      deleteThread(t);
+      if (t->what_next == ThreadRelocated) {
+         next = t->link;
+      } else {
+         next = t->global_link;
+         deleteThread(t);
+      }
   }      
 
   // The run queue now contains a bunch of ThreadKilled threads.  We
@@ -4156,7 +4160,7 @@ printAllThreads(void)
   debugBelch("all threads:\n");
 # endif
 
-  for (t = all_threads; t != END_TSO_QUEUE; t = t->global_link) {
+  for (t = all_threads; t != END_TSO_QUEUE; ) {
     debugBelch("\tthread %d @ %p ", t->id, (void *)t);
 #if defined(DEBUG)
     {
@@ -4164,8 +4168,14 @@ printAllThreads(void)
       if (label) debugBelch("[\"%s\"] ",(char *)label);
     }
 #endif
-    printThreadStatus(t);
-    debugBelch("\n");
+    if (t->what_next == ThreadRelocated) {
+       debugBelch("has been relocated...\n");
+       t = t->link;
+    } else {
+       printThreadStatus(t);
+       debugBelch("\n");
+       t = t->global_link;
+    }
   }
 }