[project @ 2005-07-26 10:11:37 by simonmar]

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

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 7f85690..d35bac5 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -463,7 +463,8 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS,
       // Yield the capability to higher-priority tasks if necessary.
       //
       if (cap != NULL) {
-         yieldCapability(&cap);
+         yieldCapability(&cap, 
+                         mainThread ? &mainThread->bound_thread_cond : NULL );
       }
 
       // If we do not currently hold a capability, we wait for one
@@ -475,7 +476,7 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS,
 
       // We now have a capability...
 #endif
-      
+
 #if 0 /* extra sanity checking */
       { 
          StgMainThread *m;
@@ -627,21 +628,19 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS,
            sched_belch("### thread %d bound to another OS thread", t->id));
          // no, bound to a different Haskell thread: pass to that thread
          PUSH_ON_RUN_QUEUE(t);
-         passCapability(&m->bound_thread_cond);
          continue;
        }
       }
       else
       {
        if(mainThread != NULL)
-        // The thread we want to run is bound.
+        // The thread we want to run is unbound.
        {
          IF_DEBUG(scheduler,
            sched_belch("### this OS thread cannot run thread %d", t->id));
          // no, the current native thread is bound to a different
          // Haskell thread, so pass it to any worker thread
          PUSH_ON_RUN_QUEUE(t);
-         passCapabilityToWorker();
          continue; 
        }
       }
@@ -841,8 +840,9 @@ scheduleCheckBlockedThreads(void)
 #if defined(RTS_SUPPORTS_THREADS)
        // We shouldn't be here...
        barf("schedule: awaitEvent() in threaded RTS");
-#endif
+#else
        awaitEvent( EMPTY_RUN_QUEUE() && !blackholes_need_checking );
+#endif
     }
 }
 
@@ -1906,6 +1906,11 @@ scheduleDoGC( rtsBool force_major )
     // actually did the GC.  But it's quite hard to arrange for all
     // the other tasks to sleep and stay asleep.
     //
+    // This does mean that there will be multiple entries in the 
+    // thread->capability hash table for the current thread, but
+    // they will be removed as normal when the capabilities are
+    // released again.
+    //
        
     // Someone else is already trying to GC
     if (waiting_for_gc) return;
@@ -1925,19 +1930,28 @@ scheduleDoGC( rtsBool force_major )
      * atomically frames.  When next scheduled they will try to
      * commit, this commit will fail and they will retry.
      */
-    for (t = all_threads; t != END_TSO_QUEUE; t = t -> link) {
-       if (t -> what_next != ThreadRelocated && t -> trec != NO_TREC && t -> why_blocked == NotBlocked) {
-           if (!stmValidateTransaction (t -> trec)) {
-               IF_DEBUG(stm, sched_belch("trec %p found wasting its time", t));
-               
-               // strip the stack back to the ATOMICALLY_FRAME, aborting
-               // the (nested) transaction, and saving the stack of any
-               // partially-evaluated thunks on the heap.
-               raiseAsync_(t, NULL, rtsTrue);
-               
+    { 
+       StgTSO *next;
+
+       for (t = all_threads; t != END_TSO_QUEUE; t = next) {
+           if (t->what_next == ThreadRelocated) {
+               next = t->link;
+           } else {
+               next = t->global_link;
+               if (t -> trec != NO_TREC && t -> why_blocked == NotBlocked) {
+                   if (!stmValidateNestOfTransactions (t -> trec)) {
+                       IF_DEBUG(stm, sched_belch("trec %p found wasting its time", t));
+                       
+                       // strip the stack back to the ATOMICALLY_FRAME, aborting
+                       // the (nested) transaction, and saving the stack of any
+                       // partially-evaluated thunks on the heap.
+                       raiseAsync_(t, NULL, rtsTrue);
+                       
 #ifdef REG_R1
-               ASSERT(get_itbl((StgClosure *)t->sp)->type == ATOMICALLY_FRAME);
+                       ASSERT(get_itbl((StgClosure *)t->sp)->type == ATOMICALLY_FRAME);
 #endif
+                   }
+               }
            }
        }
     }
@@ -3227,6 +3241,8 @@ awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node)
 void
 awakenBlockedQueueNoLock(StgTSO *tso)
 {
+  if (tso == NULL) return; // hack; see bug #1235728, and comments in
+                          // Exception.cmm
   while (tso != END_TSO_QUEUE) {
     tso = unblockOneLocked(tso);
   }
@@ -3235,6 +3251,8 @@ awakenBlockedQueueNoLock(StgTSO *tso)
 void
 awakenBlockedQueue(StgTSO *tso)
 {
+  if (tso == NULL) return; // hack; see bug #1235728, and comments in
+                          // Exception.cmm
   ACQUIRE_LOCK(&sched_mutex);
   while (tso != END_TSO_QUEUE) {
     tso = unblockOneLocked(tso);