diff options
| -rw-r--r-- | ghc/rts/Schedule.c | 16 | ||||
| -rw-r--r-- | ghc/rts/StgMiscClosures.cmm | 16 |
2 files changed, 26 insertions, 6 deletions
diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c index d35bac5407..2f94cf0beb 100644 --- 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 ed7b199aa5..30088e0b23 100644 --- 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; } |