X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FSchedule.c;h=5ebb685a027d750690dacbabb435efb0cc3c5411;hp=3d87003756ff7f72fbb9f0ba696e627f2ab9bbd7;hb=45202530612593a0ba7a6c559a38dc1ff26670a4;hpb=85174045bbcc05adb28447d423794d1f087da59e diff --git a/rts/Schedule.c b/rts/Schedule.c index 3d87003..5ebb685 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -7,6 +7,7 @@ * --------------------------------------------------------------------------*/ #include "PosixSource.h" +#define KEEP_LOCKCLOSURE #include "Rts.h" #include "SchedAPI.h" #include "RtsUtils.h" @@ -28,10 +29,8 @@ #include "ThreadLabels.h" #include "LdvProfile.h" #include "Updates.h" -#ifdef PROFILING #include "Proftimer.h" #include "ProfHeap.h" -#endif #if defined(GRAN) || defined(PARALLEL_HASKELL) # include "GranSimRts.h" # include "GranSim.h" @@ -216,7 +215,7 @@ static rtsBool scheduleHandleYield( Capability *cap, StgTSO *t, static void scheduleHandleThreadBlocked( StgTSO *t ); static rtsBool scheduleHandleThreadFinished( Capability *cap, Task *task, StgTSO *t ); -static rtsBool scheduleDoHeapProfile(rtsBool ready_to_gc); +static rtsBool scheduleNeedHeapProfile(rtsBool ready_to_gc); static Capability *scheduleDoGC(Capability *cap, Task *task, rtsBool force_major); @@ -572,9 +571,7 @@ run_thread: debugTrace(DEBUG_sched, "-->> running thread %ld %s ...", (long)t->id, whatNext_strs[t->what_next]); -#if defined(PROFILING) startHeapProfTimer(); -#endif // Check for exceptions blocked on this thread maybePerformBlockedException (cap, t); @@ -596,7 +593,19 @@ run_thread: dirtyTSO(t); - recent_activity = ACTIVITY_YES; +#if defined(THREADED_RTS) + if (recent_activity == ACTIVITY_DONE_GC) { + // ACTIVITY_DONE_GC means we turned off the timer signal to + // conserve power (see #1623). Re-enable it here. + nat prev; + prev = xchg(&recent_activity, ACTIVITY_YES); + if (prev == ACTIVITY_DONE_GC) { + startTimer(); + } + } else { + recent_activity = ACTIVITY_YES; + } +#endif switch (prev_what_next) { @@ -667,8 +676,8 @@ run_thread: // ---------------------------------------------------------------------- // Costs for the scheduler are assigned to CCS_SYSTEM -#if defined(PROFILING) stopHeapProfTimer(); +#if defined(PROFILING) CCCS = CCS_SYSTEM; #endif @@ -705,8 +714,7 @@ run_thread: barf("schedule: invalid thread return code %d", (int)ret); } - if (scheduleDoHeapProfile(ready_to_gc)) { ready_to_gc = rtsFalse; } - if (ready_to_gc) { + if (ready_to_gc || scheduleNeedHeapProfile(ready_to_gc)) { cap = scheduleDoGC(cap,task,rtsFalse); } } /* end of while() */ @@ -978,6 +986,8 @@ scheduleDetectDeadlock (Capability *cap, Task *task) cap = scheduleDoGC (cap, task, rtsTrue/*force major GC*/); recent_activity = ACTIVITY_DONE_GC; + // disable timer signals (see #1623) + stopTimer(); if ( !emptyRunQueue(cap) ) return; @@ -1818,9 +1828,6 @@ scheduleHandleThreadFinished (Capability *cap STG_UNUSED, Task *task, StgTSO *t) debugTrace(DEBUG_sched, "--++ thread %lu (%s) finished", (unsigned long)t->id, whatNext_strs[t->what_next]); - /* Inform the Hpc that a thread has finished */ - hs_hpc_thread_finished_event(t); - #if defined(GRAN) endThread(t, CurrentProc); // clean-up the thread #elif defined(PARALLEL_HASKELL) @@ -1920,36 +1927,21 @@ scheduleHandleThreadFinished (Capability *cap STG_UNUSED, Task *task, StgTSO *t) } /* ----------------------------------------------------------------------------- - * Perform a heap census, if PROFILING + * Perform a heap census * -------------------------------------------------------------------------- */ static rtsBool -scheduleDoHeapProfile( rtsBool ready_to_gc STG_UNUSED ) +scheduleNeedHeapProfile( rtsBool ready_to_gc STG_UNUSED ) { -#if defined(PROFILING) // When we have +RTS -i0 and we're heap profiling, do a census at // every GC. This lets us get repeatable runs for debugging. if (performHeapProfile || (RtsFlags.ProfFlags.profileInterval==0 && RtsFlags.ProfFlags.doHeapProfile && ready_to_gc)) { - - // checking black holes is necessary before GC, otherwise - // there may be threads that are unreachable except by the - // blackhole queue, which the GC will consider to be - // deadlocked. - scheduleCheckBlackHoles(&MainCapability); - - debugTrace(DEBUG_sched, "garbage collecting before heap census"); - GarbageCollect(rtsTrue); - - debugTrace(DEBUG_sched, "performing heap census"); - heapCensus(); - - performHeapProfile = rtsFalse; - return rtsTrue; // true <=> we already GC'd + return rtsTrue; + } else { + return rtsFalse; } -#endif - return rtsFalse; } /* ----------------------------------------------------------------------------- @@ -1960,6 +1952,7 @@ static Capability * scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major) { StgTSO *t; + rtsBool heap_census; #ifdef THREADED_RTS static volatile StgWord waiting_for_gc; rtsBool was_waiting; @@ -2067,6 +2060,8 @@ scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major) deleteAllThreads(&capabilities[0]); sched_state = SCHED_SHUTTING_DOWN; } + + heap_census = scheduleNeedHeapProfile(rtsTrue); /* everybody back, start the GC. * Could do it in this thread, or signal a condition var @@ -2076,8 +2071,14 @@ scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major) #if defined(THREADED_RTS) debugTrace(DEBUG_sched, "doing GC"); #endif - GarbageCollect(force_major); + GarbageCollect(force_major || heap_census); + if (heap_census) { + debugTrace(DEBUG_sched, "performing heap census"); + heapCensus(); + performHeapProfile = rtsFalse; + } + #if defined(THREADED_RTS) // release our stash of capabilities. for (i = 0; i < n_capabilities; i++) { @@ -2198,6 +2199,7 @@ forkProcess(HsStablePtr *entry // On Unix, all timers are reset in the child, so we need to start // the timer again. + initTimer(); startTimer(); cap = rts_evalStableIO(cap, entry, NULL); // run the action @@ -2544,6 +2546,7 @@ initScheduler(void) context_switch = 0; sched_state = SCHED_RUNNING; + recent_activity = ACTIVITY_YES; #if defined(THREADED_RTS) /* Initialise the mutex and condition variables used by @@ -2590,7 +2593,13 @@ initScheduler(void) } void -exitScheduler( void ) +exitScheduler( + rtsBool wait_foreign +#if !defined(THREADED_RTS) + __attribute__((unused)) +#endif +) + /* see Capability.c, shutdownCapability() */ { Task *task = NULL; @@ -2612,7 +2621,7 @@ exitScheduler( void ) nat i; for (i = 0; i < n_capabilities; i++) { - shutdownCapability(&capabilities[i], task); + shutdownCapability(&capabilities[i], task, wait_foreign); } boundTaskExiting(task); stopTaskManager(); @@ -2772,7 +2781,12 @@ threadStackOverflow(Capability *cap, StgTSO *tso) // while we are moving the TSO: lockClosure((StgClosure *)tso); - if (tso->stack_size >= tso->max_stack_size) { + if (tso->stack_size >= tso->max_stack_size && !(tso->flags & TSO_BLOCKEX)) { + // NB. never raise a StackOverflow exception if the thread is + // inside Control.Exceptino.block. It is impractical to protect + // against stack overflow exceptions, since virtually anything + // can raise one (even 'catch'), so this is the only sensible + // thing to do here. See bug #767. debugTrace(DEBUG_gc, "threadStackOverflow of TSO %ld (%p): stack too large (now %ld; max is %ld)", @@ -3095,10 +3109,10 @@ findRetryFrameHelper (StgTSO *tso) return CATCH_RETRY_FRAME; case CATCH_STM_FRAME: { - debugTrace(DEBUG_stm, - "found CATCH_STM_FRAME at %p during retry", p); StgTRecHeader *trec = tso -> trec; StgTRecHeader *outer = stmGetEnclosingTRec(trec); + debugTrace(DEBUG_stm, + "found CATCH_STM_FRAME at %p during retry", p); debugTrace(DEBUG_stm, "trec=%p outer=%p", trec, outer); stmAbortTransaction(tso -> cap, trec); stmFreeAbortedTRec(tso -> cap, trec);