[project @ 2005-08-24 09:43:55 by tharris]

Hold sched_mutex when working on blackhole_queue

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index d35bac5..2f94cf0 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -707,12 +707,6 @@ run_thread:
     cap = myCapability();
 #endif
 
-    // We have run some Haskell code: there might be blackhole-blocked
-    // threads to wake up now.
-    if ( blackhole_queue != END_TSO_QUEUE ) {
-       blackholes_need_checking = rtsTrue;
-    }
-
     cap->r.rInHaskell = rtsFalse;
 
     // The TSO might have moved, eg. if it re-entered the RTS and a GC
@@ -731,6 +725,12 @@ run_thread:
 #endif
     
     ACQUIRE_LOCK(&sched_mutex);
+
+    // We have run some Haskell code: there might be blackhole-blocked
+    // threads to wake up now.
+    if ( blackhole_queue != END_TSO_QUEUE ) {
+       blackholes_need_checking = rtsTrue;
+    }
     
 #if defined(RTS_SUPPORTS_THREADS)
     IF_DEBUG(scheduler,debugBelch("sched (task %p): ", osThreadId()););
@@ -2315,6 +2315,8 @@ createThread(nat size)
     StgTSO *tso;
     nat stack_size;
 
+    ACQUIRE_LOCK(&sched_mutex);
+
     /* First check whether we should create a thread at all */
 #if defined(PARALLEL_HASKELL)
   /* check that no more than RtsFlags.ParFlags.maxThreads threads are created */
@@ -2322,6 +2324,7 @@ createThread(nat size)
     threadsIgnored++;
     debugBelch("{createThread}Daq ghuH: refusing to create another thread; no more than %d threads allowed (currently %d)\n",
          RtsFlags.ParFlags.maxThreads, advisory_thread_count);
+    RELEASE_LOCK(&sched_mutex);
     return END_TSO_QUEUE;
   }
   threadsCreated++;
@@ -2472,6 +2475,7 @@ createThread(nat size)
   IF_DEBUG(scheduler,sched_belch("created thread %ld, stack size = %lx words", 
                                 (long)tso->id, (long)tso->stack_size));
 #endif    
+  RELEASE_LOCK(&sched_mutex);
   return tso;
 }
 

diff --git a/ghc/rts/StgMiscClosures.cmm b/ghc/rts/StgMiscClosures.cmm
index ed7b199..30088e0 100644 (file)
--- a/ghc/rts/StgMiscClosures.cmm
+++ b/ghc/rts/StgMiscClosures.cmm
@@ -341,6 +341,10 @@ INFO_TABLE(stg_BLACKHOLE,0,1,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
     /* Actually this is not necessary because R1 is about to be destroyed. */
     LDV_ENTER(R1);
 
+#if defined(SMP)
+    foreign "C" ACQUIRE_LOCK(sched_mutex "ptr");
+#endif
+
     /* Put ourselves on the blackhole queue */
     StgTSO_link(CurrentTSO) = W_[blackhole_queue];
     W_[blackhole_queue] = CurrentTSO;
@@ -349,6 +353,10 @@ INFO_TABLE(stg_BLACKHOLE,0,1,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
     StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
     StgTSO_block_info(CurrentTSO) = R1;
 
+#if defined(SMP)
+    foreign "C" RELEASE_LOCK(sched_mutex "ptr");
+#endif
+
     /* stg_gen_block is too heavyweight, use a specialised one */
     jump stg_block_1;
 }
@@ -398,6 +406,10 @@ INFO_TABLE(stg_CAF_BLACKHOLE,0,1,CAF_BLACKHOLE,"CAF_BLACKHOLE","CAF_BLACKHOLE")
     TICK_ENT_BH();
     LDV_ENTER(R1);
 
+#if defined(SMP)
+    foreign "C" ACQUIRE_LOCK(sched_mutex "ptr");
+#endif
+
     /* Put ourselves on the blackhole queue */
     StgTSO_link(CurrentTSO) = W_[blackhole_queue];
     W_[blackhole_queue] = CurrentTSO;
@@ -406,6 +418,10 @@ INFO_TABLE(stg_CAF_BLACKHOLE,0,1,CAF_BLACKHOLE,"CAF_BLACKHOLE","CAF_BLACKHOLE")
     StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
     StgTSO_block_info(CurrentTSO) = R1;
 
+#if defined(SMP)
+    foreign "C" RELEASE_LOCK(sched_mutex "ptr");
+#endif
+
     /* stg_gen_block is too heavyweight, use a specialised one */
     jump stg_block_1;
 }