X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FSchedule.c;h=a11a15e94d9733a9a84c79adddaa61e60597dc66;hp=b9b4325c0f17e2d556ee31730fcf6b3ec53ca5a2;hb=ed12b7043fa98928f75c289a756fbcef546315f8;hpb=f9e1c2af8fdd112019a657e66b0cd685d8df66f6 diff --git a/rts/Schedule.c b/rts/Schedule.c index b9b4325..a11a15e 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -11,7 +11,6 @@ #include "SchedAPI.h" #include "RtsUtils.h" #include "RtsFlags.h" -#include "BlockAlloc.h" #include "OSThreads.h" #include "Storage.h" #include "StgRun.h" @@ -52,6 +51,7 @@ #include "Trace.h" #include "RaiseAsync.h" #include "Threads.h" +#include "ThrIOManager.h" #ifdef HAVE_SYS_TYPES_H #include @@ -218,11 +218,9 @@ static rtsBool scheduleHandleThreadFinished( Capability *cap, Task *task, StgTSO *t ); static rtsBool scheduleDoHeapProfile(rtsBool ready_to_gc); static Capability *scheduleDoGC(Capability *cap, Task *task, - rtsBool force_major, - void (*get_roots)(evac_fn)); + rtsBool force_major); static rtsBool checkBlackHoles(Capability *cap); -static void AllRoots(evac_fn evac); static StgTSO *threadStackOverflow(Capability *cap, StgTSO *tso); @@ -421,7 +419,7 @@ schedule (Capability *initialCapability, Task *task) discardSparksCap(cap); #endif /* scheduleDoGC() deletes all the threads */ - cap = scheduleDoGC(cap,task,rtsFalse,GetRoots); + cap = scheduleDoGC(cap,task,rtsFalse); break; case SCHED_SHUTTING_DOWN: debugTrace(DEBUG_sched, "SCHED_SHUTTING_DOWN"); @@ -701,7 +699,7 @@ run_thread: if (scheduleDoHeapProfile(ready_to_gc)) { ready_to_gc = rtsFalse; } if (ready_to_gc) { - cap = scheduleDoGC(cap,task,rtsFalse,GetRoots); + cap = scheduleDoGC(cap,task,rtsFalse); } } /* end of while() */ @@ -852,7 +850,7 @@ schedulePushWork(Capability *cap USED_IF_THREADS, * Start any pending signal handlers * ------------------------------------------------------------------------- */ -#if defined(RTS_USER_SIGNALS) && (!defined(THREADED_RTS) || defined(mingw32_HOST_OS)) +#if defined(RTS_USER_SIGNALS) && !defined(THREADED_RTS) static void scheduleStartSignalHandlers(Capability *cap) { @@ -968,13 +966,13 @@ scheduleDetectDeadlock (Capability *cap, Task *task) // they are unreachable and will therefore be sent an // exception. Any threads thus released will be immediately // runnable. - cap = scheduleDoGC (cap, task, rtsTrue/*force major GC*/, GetRoots); + cap = scheduleDoGC (cap, task, rtsTrue/*force major GC*/); recent_activity = ACTIVITY_DONE_GC; if ( !emptyRunQueue(cap) ) return; -#if defined(RTS_USER_SIGNALS) && (!defined(THREADED_RTS) || defined(mingw32_HOST_OS)) +#if defined(RTS_USER_SIGNALS) && !defined(THREADED_RTS) /* If we have user-installed signal handlers, then wait * for signals to arrive rather then bombing out with a * deadlock. @@ -1810,6 +1808,9 @@ 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_event("Thread Finished",t); + #if defined(GRAN) endThread(t, CurrentProc); // clean-up the thread #elif defined(PARALLEL_HASKELL) @@ -1929,7 +1930,7 @@ scheduleDoHeapProfile( rtsBool ready_to_gc STG_UNUSED ) scheduleCheckBlackHoles(&MainCapability); debugTrace(DEBUG_sched, "garbage collecting before heap census"); - GarbageCollect(GetRoots, rtsTrue); + GarbageCollect(rtsTrue); debugTrace(DEBUG_sched, "performing heap census"); heapCensus(); @@ -1946,8 +1947,7 @@ scheduleDoHeapProfile( rtsBool ready_to_gc STG_UNUSED ) * -------------------------------------------------------------------------- */ static Capability * -scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, - rtsBool force_major, void (*get_roots)(evac_fn)) +scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major) { StgTSO *t; #ifdef THREADED_RTS @@ -2066,7 +2066,7 @@ scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, #if defined(THREADED_RTS) debugTrace(DEBUG_sched, "doing GC"); #endif - GarbageCollect(get_roots, force_major); + GarbageCollect(force_major); #if defined(THREADED_RTS) // release our stash of capabilities. @@ -2509,9 +2509,6 @@ initScheduler(void) context_switch = 0; sched_state = SCHED_RUNNING; - RtsFlags.ConcFlags.ctxtSwitchTicks = - RtsFlags.ConcFlags.ctxtSwitchTime / TICK_MILLISECS; - #if defined(THREADED_RTS) /* Initialise the mutex and condition variables used by * the scheduler. */ @@ -2570,7 +2567,7 @@ exitScheduler( void ) // If we haven't killed all the threads yet, do it now. if (sched_state < SCHED_SHUTTING_DOWN) { sched_state = SCHED_INTERRUPTING; - scheduleDoGC(NULL,task,rtsFalse,GetRoots); + scheduleDoGC(NULL,task,rtsFalse); } sched_state = SCHED_SHUTTING_DOWN; @@ -2584,6 +2581,20 @@ exitScheduler( void ) boundTaskExiting(task); stopTaskManager(); } +#else + freeCapability(&MainCapability); +#endif +} + +void +freeScheduler( void ) +{ + freeTaskManager(); + if (n_capabilities != 1) { + stgFree(capabilities); + } +#if defined(THREADED_RTS) + closeMutex(&sched_mutex); #endif } @@ -2672,17 +2683,10 @@ GetRoots( evac_fn evac ) This is the interface to the garbage collector from Haskell land. We provide this so that external C code can allocate and garbage collect when called from Haskell via _ccall_GC. - - It might be useful to provide an interface whereby the programmer - can specify more roots (ToDo). - - This needs to be protected by the GC condition variable above. KH. -------------------------------------------------------------------------- */ -static void (*extra_roots)(evac_fn); - static void -performGC_(rtsBool force_major, void (*get_roots)(evac_fn)) +performGC_(rtsBool force_major) { Task *task; // We must grab a new Task here, because the existing Task may be @@ -2691,34 +2695,20 @@ performGC_(rtsBool force_major, void (*get_roots)(evac_fn)) ACQUIRE_LOCK(&sched_mutex); task = newBoundTask(); RELEASE_LOCK(&sched_mutex); - scheduleDoGC(NULL,task,force_major, get_roots); + scheduleDoGC(NULL,task,force_major); boundTaskExiting(task); } void performGC(void) { - performGC_(rtsFalse, GetRoots); + performGC_(rtsFalse); } void performMajorGC(void) { - performGC_(rtsTrue, GetRoots); -} - -static void -AllRoots(evac_fn evac) -{ - GetRoots(evac); // the scheduler's roots - extra_roots(evac); // the user's roots -} - -void -performGCWithRoots(void (*get_roots)(evac_fn)) -{ - extra_roots = get_roots; - performGC_(rtsFalse, AllRoots); + performGC_(rtsTrue); } /* ----------------------------------------------------------------------------- @@ -2847,17 +2837,10 @@ void wakeUpRts(void) { #if defined(THREADED_RTS) -#if !defined(mingw32_HOST_OS) // This forces the IO Manager thread to wakeup, which will // in turn ensure that some OS thread wakes up and runs the // scheduler loop, which will cause a GC and deadlock check. ioManagerWakeup(); -#else - // On Windows this might be safe enough, because we aren't - // in a signal handler. Later we should use the IO Manager, - // though. - prodOneCapability(); -#endif #endif } @@ -3041,8 +3024,9 @@ raiseExceptionHelper (StgRegTable *reg, StgTSO *tso, StgClosure *exception) This should either be a CATCH_RETRY_FRAME (if the retry# is within an orElse#) or should be a ATOMICALLY_FRAME (if the retry# reaches the top level). - We skip CATCH_STM_FRAMEs because retries are not considered to be exceptions, - despite the similar implementation. + We skip CATCH_STM_FRAMEs (aborting and rolling back the nested tx that they + create) because retries are not considered to be exceptions, despite the + similar implementation. We should not expect to see CATCH_FRAME or STOP_FRAME because those should not be created within memory transactions. @@ -3062,7 +3046,7 @@ findRetryFrameHelper (StgTSO *tso) case ATOMICALLY_FRAME: debugTrace(DEBUG_stm, - "found ATOMICALLY_FRAME at %p during retrry", p); + "found ATOMICALLY_FRAME at %p during retry", p); tso->sp = p; return ATOMICALLY_FRAME; @@ -3072,7 +3056,20 @@ findRetryFrameHelper (StgTSO *tso) tso->sp = p; return CATCH_RETRY_FRAME; - case CATCH_STM_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, "trec=%p outer=%p", trec, outer); + stmAbortTransaction(tso -> cap, trec); + stmFreeAbortedTRec(tso -> cap, trec); + tso -> trec = outer; + p = next; + continue; + } + + default: ASSERT(info->i.type != CATCH_FRAME); ASSERT(info->i.type != STOP_FRAME);