Allow users of the GHC library to specify which packages have already been loaded.

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

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 0ff9bbe..39aa5e2 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -2149,11 +2149,15 @@ forkProcess(HsStablePtr *entry
        // now gone.
 
        for (t = all_threads; t != END_TSO_QUEUE; t = next) {
-           next = t->global_link;
-           // don't allow threads to catch the ThreadKilled
-           // exception, but we do want to raiseAsync() because these
-           // threads may be evaluating thunks that we need later.
-           deleteThread_(cap,t);
+           if (t->what_next == ThreadRelocated) {
+               next = t->link;
+           } else {
+               next = t->global_link;
+               // don't allow threads to catch the ThreadKilled
+               // exception, but we do want to raiseAsync() because these
+               // threads may be evaluating thunks that we need later.
+               deleteThread_(cap,t);
+           }
        }
        
        // Empty the run queue.  It seems tempting to let all the
@@ -4498,7 +4502,7 @@ sched_belch(char *s, ...)
     va_list ap;
     va_start(ap,s);
 #ifdef THREADED_RTS
-    debugBelch("sched (task %p, pid %d): ", (void *)(unsigned long)(unsigned int)osThreadId(), getpid());
+    debugBelch("sched (task %p): ", (void *)(unsigned long)(unsigned int)osThreadId());
 #elif defined(PARALLEL_HASKELL)
     debugBelch("== ");
 #else