From: Simon Marlow Date: Wed, 16 Apr 2008 23:44:46 +0000 (+0000) Subject: Don't look at all the threads before each GC. X-Git-Tag: Before_cabalised-GHC~189 X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=e7987f16175f88daa11f06f25d10161a95f84bc4 Don't look at all the threads before each GC. We were looking at all the threads for 2 reasons: 1. to catch transactions that might be looping as a result of seeing an inconsistent view of memory. 2. to catch threads with blocked exceptions that are themselves blocked. For (1) we now check for this case whenever a thread yields, and for (2) we catch these threads in the GC itself and send the exceptions after GC (see performPendingThrowTos). --- diff --git a/rts/Schedule.c b/rts/Schedule.c index 915530f..c07b21a 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -200,7 +200,7 @@ static rtsBool scheduleGetRemoteWork(rtsBool *receivedFinish); #if defined(PAR) || defined(GRAN) static void scheduleGranParReport(void); #endif -static void schedulePostRunThread(void); +static void schedulePostRunThread(StgTSO *t); static rtsBool scheduleHandleHeapOverflow( Capability *cap, StgTSO *t ); static void scheduleHandleStackOverflow( Capability *cap, Task *task, StgTSO *t); @@ -676,7 +676,7 @@ run_thread: CCCS = CCS_SYSTEM; #endif - schedulePostRunThread(); + schedulePostRunThread(t); t = threadStackUnderflow(task,t); @@ -1450,8 +1450,36 @@ JB: TODO: investigate wether state change field could be nuked * ------------------------------------------------------------------------- */ static void -schedulePostRunThread(void) +schedulePostRunThread (StgTSO *t) { + // We have to be able to catch transactions that are in an + // infinite loop as a result of seeing an inconsistent view of + // memory, e.g. + // + // atomically $ do + // [a,b] <- mapM readTVar [ta,tb] + // when (a == b) loop + // + // and a is never equal to b given a consistent view of memory. + // + if (t -> trec != NO_TREC && t -> why_blocked == NotBlocked) { + if (!stmValidateNestOfTransactions (t -> trec)) { + debugTrace(DEBUG_sched | DEBUG_stm, + "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. + throwToSingleThreaded_(&capabilities[0], t, + NULL, rtsTrue, NULL); + +#ifdef REG_R1 + ASSERT(get_itbl((StgClosure *)t->sp)->type == ATOMICALLY_FRAME); +#endif + } + } + #if defined(PAR) /* HACK 675: if the last thread didn't yield, make sure to print a SCHEDULE event to the log file when StgRunning the next thread, even @@ -2004,54 +2032,6 @@ scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major) waiting_for_gc = rtsFalse; #endif - /* Kick any transactions which are invalid back to their - * atomically frames. When next scheduled they will try to - * commit, this commit will fail and they will retry. - */ - { - StgTSO *next; - nat s; - - for (s = 0; s < total_steps; s++) { - for (t = all_steps[s].threads; t != END_TSO_QUEUE; t = next) { - if (t->what_next == ThreadRelocated) { - next = t->_link; - } else { - next = t->global_link; - - // This is a good place to check for blocked - // exceptions. It might be the case that a thread is - // blocked on delivering an exception to a thread that - // is also blocked - we try to ensure that this - // doesn't happen in throwTo(), but it's too hard (or - // impossible) to close all the race holes, so we - // accept that some might get through and deal with - // them here. A GC will always happen at some point, - // even if the system is otherwise deadlocked. - maybePerformBlockedException (&capabilities[0], t); - - if (t -> trec != NO_TREC && t -> why_blocked == NotBlocked) { - if (!stmValidateNestOfTransactions (t -> trec)) { - debugTrace(DEBUG_sched | DEBUG_stm, - "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. - throwToSingleThreaded_(&capabilities[0], t, - NULL, rtsTrue, NULL); - -#ifdef REG_R1 - ASSERT(get_itbl((StgClosure *)t->sp)->type == ATOMICALLY_FRAME); -#endif - } - } - } - } - } - } - // so this happens periodically: if (cap) scheduleCheckBlackHoles(cap); @@ -3188,3 +3168,37 @@ resurrectThreads (StgTSO *threads) } } } + +/* ----------------------------------------------------------------------------- + performPendingThrowTos is called after garbage collection, and + passed a list of threads that were found to have pending throwTos + (tso->blocked_exceptions was not empty), and were blocked. + Normally this doesn't happen, because we would deliver the + exception directly if the target thread is blocked, but there are + small windows where it might occur on a multiprocessor (see + throwTo()). + + NB. we must be holding all the capabilities at this point, just + like resurrectThreads(). + -------------------------------------------------------------------------- */ + +void +performPendingThrowTos (StgTSO *threads) +{ + StgTSO *tso, *next; + Capability *cap; + step *step; + + for (tso = threads; tso != END_TSO_QUEUE; tso = next) { + next = tso->global_link; + + step = Bdescr((P_)tso)->step; + tso->global_link = step->threads; + step->threads = tso; + + debugTrace(DEBUG_sched, "performing blocked throwTo to thread %lu", (unsigned long)tso->id); + + cap = tso->cap; + maybePerformBlockedException(cap, tso); + } +} diff --git a/rts/Schedule.h b/rts/Schedule.h index 89ac112..59bdb9e 100644 --- a/rts/Schedule.h +++ b/rts/Schedule.h @@ -154,6 +154,7 @@ void interruptStgRts (void); nat run_queue_len (void); void resurrectThreads (StgTSO *); +void performPendingThrowTos (StgTSO *); void printAllThreads(void); diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 3cb71fa..1d64699 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -692,6 +692,7 @@ GarbageCollect ( rtsBool force_major_gc ) // send exceptions to any threads which were about to die RELEASE_SM_LOCK; resurrectThreads(resurrected_threads); + performPendingThrowTos(exception_threads); ACQUIRE_SM_LOCK; // Update the stable pointer hash table. diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c index 078919d..5f71a30 100644 --- a/rts/sm/MarkWeak.c +++ b/rts/sm/MarkWeak.c @@ -74,10 +74,12 @@ static WeakStage weak_stage; */ StgWeak *old_weak_ptr_list; // also pending finaliser list -/* List of all threads during GC - */ +// List of threads found to be unreachable StgTSO *resurrected_threads; +// List of blocked threads found to have pending throwTos +StgTSO *exception_threads; + void initWeakForGC(void) { @@ -85,6 +87,7 @@ initWeakForGC(void) weak_ptr_list = NULL; weak_stage = WeakPtrs; resurrected_threads = END_TSO_QUEUE; + exception_threads = END_TSO_QUEUE; } rtsBool @@ -225,14 +228,29 @@ traverseWeakPtrList(void) next = t->global_link; } else { - step *new_step; - // alive: move this thread onto the correct - // threads list. + // alive next = t->global_link; - new_step = Bdescr((P_)t)->step; - t->global_link = new_step->threads; - new_step->threads = t; *prev = next; + + // This is a good place to check for blocked + // exceptions. It might be the case that a thread is + // blocked on delivering an exception to a thread that + // is also blocked - we try to ensure that this + // doesn't happen in throwTo(), but it's too hard (or + // impossible) to close all the race holes, so we + // accept that some might get through and deal with + // them here. A GC will always happen at some point, + // even if the system is otherwise deadlocked. + if (t->blocked_exceptions != END_TSO_QUEUE) { + t->global_link = exception_threads; + exception_threads = t; + } else { + // move this thread onto the correct threads list. + step *new_step; + new_step = Bdescr((P_)t)->step; + t->global_link = new_step->threads; + new_step->threads = t; + } } } } diff --git a/rts/sm/MarkWeak.h b/rts/sm/MarkWeak.h index c586ba1..7b3a806 100644 --- a/rts/sm/MarkWeak.h +++ b/rts/sm/MarkWeak.h @@ -13,6 +13,7 @@ extern StgWeak *old_weak_ptr_list; extern StgTSO *resurrected_threads; +extern StgTSO *exception_threads; void initWeakForGC ( void ); rtsBool traverseWeakPtrList ( void ); diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index db0299c..702c246 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -846,11 +846,11 @@ void dirty_TSO (Capability *cap, StgTSO *tso) { bdescr *bd; - if ((tso->flags & TSO_DIRTY) == 0) { - tso->flags |= TSO_DIRTY; + if ((tso->flags & (TSO_DIRTY|TSO_LINK_DIRTY)) == 0) { bd = Bdescr((StgPtr)tso); if (bd->gen_no > 0) recordMutableCap((StgClosure*)tso,cap,bd->gen_no); } + tso->flags |= TSO_DIRTY; } /*