X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FSchedule.c;h=f40e4573e74ba6eaa0e9000b9c92e6280d0d3839;hb=d182db3a49ecb720293666fb278c1acd54c5b31d;hp=b3d34463d39746b91d28eb5ae25787d3e68b4a8d;hpb=b77098031265b55b28ddf6f3fe89c429c66cceb7;p=ghc-hetmet.git diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c index b3d3446..f40e457 100644 --- a/ghc/rts/Schedule.c +++ b/ghc/rts/Schedule.c @@ -1,5 +1,5 @@ /* --------------------------------------------------------------------------- - * $Id: Schedule.c,v 1.128 2002/02/15 20:58:14 sof Exp $ + * $Id: Schedule.c,v 1.134 2002/03/12 13:57:11 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -119,35 +119,10 @@ //@node Variables and Data structures, Prototypes, Includes, Main scheduling code //@subsection Variables and Data structures -/* Main threads: - * - * These are the threads which clients have requested that we run. - * - * In a 'threaded' build, we might have several concurrent clients all - * waiting for results, and each one will wait on a condition variable - * until the result is available. - * - * In non-SMP, clients are strictly nested: the first client calls - * into the RTS, which might call out again to C with a _ccall_GC, and - * eventually re-enter the RTS. - * - * Main threads information is kept in a linked list: - */ -//@cindex StgMainThread -typedef struct StgMainThread_ { - StgTSO * tso; - SchedulerStatus stat; - StgClosure ** ret; -#if defined(RTS_SUPPORTS_THREADS) - Condition wakeup; -#endif - struct StgMainThread_ *link; -} StgMainThread; - /* Main thread queue. * Locks required: sched_mutex. */ -static StgMainThread *main_threads; +StgMainThread *main_threads; /* Thread queues. * Locks required: sched_mutex. @@ -579,9 +554,7 @@ schedule( void ) * inform all the main threads. */ #ifndef PAR - if ( EMPTY_RUN_QUEUE() - && EMPTY_QUEUE(blocked_queue_hd) - && EMPTY_QUEUE(sleeping_queue) + if ( EMPTY_THREAD_QUEUES() #if defined(RTS_SUPPORTS_THREADS) && EMPTY_QUEUE(suspended_ccalling_threads) #endif @@ -595,39 +568,51 @@ schedule( void ) /* and SMP mode ..? */ releaseCapability(cap); #endif - RELEASE_LOCK(&sched_mutex); + // Garbage collection can release some new threads due to + // either (a) finalizers or (b) threads resurrected because + // they are about to be send BlockedOnDeadMVar. Any threads + // thus released will be immediately runnable. GarbageCollect(GetRoots,rtsTrue); - ACQUIRE_LOCK(&sched_mutex); - if ( EMPTY_QUEUE(blocked_queue_hd) - && EMPTY_RUN_QUEUE() - && EMPTY_QUEUE(sleeping_queue) ) { - - IF_DEBUG(scheduler, sched_belch("still deadlocked, checking for black holes...")); - detectBlackHoles(); - - /* No black holes, so probably a real deadlock. Send the - * current main thread the Deadlock exception (or in the SMP - * build, send *all* main threads the deadlock exception, - * since none of them can make progress). - */ - if ( EMPTY_RUN_QUEUE() ) { - StgMainThread *m; + + if ( !EMPTY_RUN_QUEUE() ) { goto not_deadlocked; } + + IF_DEBUG(scheduler, + sched_belch("still deadlocked, checking for black holes...")); + detectBlackHoles(); + + if ( !EMPTY_RUN_QUEUE() ) { goto not_deadlocked; } + +#ifndef mingw32_TARGET_OS + /* If we have user-installed signal handlers, then wait + * for signals to arrive rather then bombing out with a + * deadlock. + */ + if ( anyUserHandlers() ) { + IF_DEBUG(scheduler, + sched_belch("still deadlocked, waiting for signals...")); + + awaitUserSignals(); + + // we might be interrupted... + if (interrupted) { continue; } + + if (signals_pending()) { + startSignalHandlers(); + } + ASSERT(!EMPTY_RUN_QUEUE()); + goto not_deadlocked; + } +#endif + + /* Probably a real deadlock. Send the current main thread the + * Deadlock exception (or in the SMP build, send *all* main + * threads the deadlock exception, since none of them can make + * progress). + */ + { + StgMainThread *m; #if defined(RTS_SUPPORTS_THREADS) - for (m = main_threads; m != NULL; m = m->link) { - switch (m->tso->why_blocked) { - case BlockedOnBlackHole: - raiseAsync(m->tso, (StgClosure *)NonTermination_closure); - break; - case BlockedOnException: - case BlockedOnMVar: - raiseAsync(m->tso, (StgClosure *)Deadlock_closure); - break; - default: - barf("deadlock: main thread blocked in a strange way"); - } - } -#else - m = main_threads; + for (m = main_threads; m != NULL; m = m->link) { switch (m->tso->why_blocked) { case BlockedOnBlackHole: raiseAsync(m->tso, (StgClosure *)NonTermination_closure); @@ -639,19 +624,32 @@ schedule( void ) default: barf("deadlock: main thread blocked in a strange way"); } -#endif } -#if defined(RTS_SUPPORTS_THREADS) - /* ToDo: revisit conditions (and mechanism) for shutting - down a multi-threaded world */ - if ( EMPTY_RUN_QUEUE() ) { - IF_DEBUG(scheduler, sched_belch("all done, i think...shutting down.")); - shutdownHaskellAndExit(0); +#else + m = main_threads; + switch (m->tso->why_blocked) { + case BlockedOnBlackHole: + raiseAsync(m->tso, (StgClosure *)NonTermination_closure); + break; + case BlockedOnException: + case BlockedOnMVar: + raiseAsync(m->tso, (StgClosure *)Deadlock_closure); + break; + default: + barf("deadlock: main thread blocked in a strange way"); } #endif - ASSERT( !EMPTY_RUN_QUEUE() ); } + +#if defined(RTS_SUPPORTS_THREADS) + /* ToDo: revisit conditions (and mechanism) for shutting + down a multi-threaded world */ + IF_DEBUG(scheduler, sched_belch("all done, i think...shutting down.")); + shutdownHaskellAndExit(0); +#endif } + not_deadlocked: + #elif defined(PAR) /* ToDo: add deadlock detection in GUM (similar to SMP) -- HWL */ #endif @@ -1389,18 +1387,10 @@ void deleteAllThreads ( void ) { StgTSO* t, *next; IF_DEBUG(scheduler,sched_belch("deleting all threads")); - for (t = run_queue_hd; t != END_TSO_QUEUE; t = next) { - next = t->link; - deleteThread(t); - } - for (t = blocked_queue_hd; t != END_TSO_QUEUE; t = next) { - next = t->link; + for (t = all_threads; t != END_TSO_QUEUE; t = next) { + next = t->global_link; deleteThread(t); - } - for (t = sleeping_queue; t != END_TSO_QUEUE; t = next) { - next = t->link; - deleteThread(t); - } + } run_queue_hd = run_queue_tl = END_TSO_QUEUE; blocked_queue_hd = blocked_queue_tl = END_TSO_QUEUE; sleeping_queue = END_TSO_QUEUE; @@ -1428,7 +1418,12 @@ void deleteAllThreads ( void ) * ------------------------------------------------------------------------- */ StgInt -suspendThread( StgRegTable *reg ) +suspendThread( StgRegTable *reg, + rtsBool concCall +#if !defined(RTS_SUPPORTS_THREADS) + STG_UNUSED +#endif + ) { nat tok; Capability *cap; @@ -1457,7 +1452,7 @@ suspendThread( StgRegTable *reg ) /* Hand back capability */ releaseCapability(cap); -#if defined(RTS_SUPPORTS_THREADS) && !defined(SMP) +#if defined(RTS_SUPPORTS_THREADS) /* Preparing to leave the RTS, so ensure there's a native thread/task waiting to take over. @@ -1466,7 +1461,9 @@ suspendThread( StgRegTable *reg ) there's no need to create a new task). */ IF_DEBUG(scheduler, sched_belch("worker thread (%d): leaving RTS", tok)); - startTask(taskStart); + if (concCall) { + startTask(taskStart); + } #endif /* Other threads _might_ be available for execution; signal this */ @@ -1476,14 +1473,23 @@ suspendThread( StgRegTable *reg ) } StgRegTable * -resumeThread( StgInt tok ) +resumeThread( StgInt tok, + rtsBool concCall +#if !defined(RTS_SUPPORTS_THREADS) + STG_UNUSED +#endif + ) { StgTSO *tso, **prev; Capability *cap; #if defined(RTS_SUPPORTS_THREADS) /* Wait for permission to re-enter the RTS with the result. */ - grabReturnCapability(&sched_mutex, &cap); + if ( concCall ) { + grabReturnCapability(&sched_mutex, &cap); + } else { + grabCapability(&cap); + } #else grabCapability(&cap); #endif @@ -2282,9 +2288,6 @@ GetRoots(evac_fn evac) } #endif - for (m = main_threads; m != NULL; m = m->link) { - evac((StgClosure **)&m->tso); - } if (suspended_ccalling_threads != END_TSO_QUEUE) { evac((StgClosure **)&suspended_ccalling_threads); } @@ -2312,13 +2315,18 @@ void (*extra_roots)(evac_fn); void performGC(void) { + /* Obligated to hold this lock upon entry */ + ACQUIRE_LOCK(&sched_mutex); GarbageCollect(GetRoots,rtsFalse); + RELEASE_LOCK(&sched_mutex); } void performMajorGC(void) { + ACQUIRE_LOCK(&sched_mutex); GarbageCollect(GetRoots,rtsTrue); + RELEASE_LOCK(&sched_mutex); } static void @@ -2331,8 +2339,10 @@ AllRoots(evac_fn evac) void performGCWithRoots(void (*get_roots)(evac_fn)) { + ACQUIRE_LOCK(&sched_mutex); extra_roots = get_roots; GarbageCollect(AllRoots,rtsFalse); + RELEASE_LOCK(&sched_mutex); } /* -----------------------------------------------------------------------------