X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FCapability.c;h=4d5748cec27274ed9f003461e03be8d2157a7cf4;hb=66579ff945831c5fc9a17c58c722ff01f2268d76;hp=e384e1edddcb602a4a3c14b8fcb49cd36bf21dc2;hpb=88b35c172f9434fd98b700f706074d142914a8bb;p=ghc-hetmet.git diff --git a/rts/Capability.c b/rts/Capability.c index e384e1e..4d5748c 100644 --- a/rts/Capability.c +++ b/rts/Capability.c @@ -40,6 +40,9 @@ Capability *capabilities = NULL; // locking, so we don't do that. Capability *last_free_capability; +/* GC indicator, in scope for the scheduler, init'ed to false */ +volatile StgWord waiting_for_gc = 0; + #if defined(THREADED_RTS) STATIC_INLINE rtsBool globalWorkToDo (void) @@ -153,10 +156,12 @@ initCapability( Capability *cap, nat i ) cap->mut_lists[g] = NULL; } - cap->free_tvar_wait_queues = END_STM_WAIT_QUEUE; + cap->free_tvar_watch_queues = END_STM_WATCH_QUEUE; + cap->free_invariant_check_queues = END_INVARIANT_CHECK_QUEUE; cap->free_trec_chunks = END_STM_CHUNK_LIST; cap->free_trec_headers = NO_TREC; cap->transaction_tokens = 0; + cap->context_switch = 0; } /* --------------------------------------------------------------------------- @@ -214,6 +219,19 @@ initCapabilities( void ) } /* ---------------------------------------------------------------------------- + * setContextSwitches: cause all capabilities to context switch as + * soon as possible. + * ------------------------------------------------------------------------- */ + +void setContextSwitches(void) +{ + nat i; + for (i=0; i < n_capabilities; i++) { + capabilities[i].context_switch = 1; + } +} + +/* ---------------------------------------------------------------------------- * Give a Capability to a Task. The task must currently be sleeping * on its condition variable. * @@ -275,6 +293,21 @@ releaseCapability_ (Capability* cap) return; } + /* if waiting_for_gc was the reason to release the cap: thread + comes from yieldCap->releaseAndQueueWorker. Unconditionally set + cap. free and return (see default after the if-protected other + special cases). Thread will wait on cond.var and re-acquire the + same cap after GC (GC-triggering cap. calls releaseCap and + enters the spare_workers case) + */ + if (waiting_for_gc) { + last_free_capability = cap; // needed? + trace(TRACE_sched | DEBUG_sched, + "GC pending, set capability %d free", cap->no); + return; + } + + // If the next thread on the run queue is a bound thread, // give this Capability to the appropriate Task. if (!emptyRunQueue(cap) && cap->run_queue_hd->bound) { @@ -452,7 +485,14 @@ yieldCapability (Capability** pCap, Task *task) // The fast path has no locking, if we don't enter this while loop - while ( cap->returning_tasks_hd != NULL || !anyWorkForMe(cap,task) ) { + while ( waiting_for_gc + /* i.e. another capability triggered HeapOverflow, is busy + getting capabilities (stopping their owning tasks) */ + || cap->returning_tasks_hd != NULL + /* cap reserved for another task */ + || !anyWorkForMe(cap,task) + /* cap/task have no work */ + ) { debugTrace(DEBUG_sched, "giving up capability %d", cap->no); // We must now release the capability and wait to be woken up @@ -514,57 +554,41 @@ yieldCapability (Capability** pCap, Task *task) * ------------------------------------------------------------------------- */ void -wakeupThreadOnCapability (Capability *cap, StgTSO *tso) +wakeupThreadOnCapability (Capability *my_cap, + Capability *other_cap, + StgTSO *tso) { - ASSERT(tso->cap == cap); - ASSERT(tso->bound ? tso->bound->cap == cap : 1); - ASSERT_LOCK_HELD(&cap->lock); + ACQUIRE_LOCK(&other_cap->lock); - tso->cap = cap; + // ASSUMES: cap->lock is held (asserted in wakeupThreadOnCapability) + if (tso->bound) { + ASSERT(tso->bound->cap == tso->cap); + tso->bound->cap = other_cap; + } + tso->cap = other_cap; + + ASSERT(tso->bound ? tso->bound->cap == other_cap : 1); - if (cap->running_task == NULL) { + if (other_cap->running_task == NULL) { // nobody is running this Capability, we can add our thread // directly onto the run queue and start up a Task to run it. - appendToRunQueue(cap,tso); - // start it up - cap->running_task = myTask(); // precond for releaseCapability_() - trace(TRACE_sched, "resuming capability %d", cap->no); - releaseCapability_(cap); + other_cap->running_task = myTask(); + // precond for releaseCapability_() and appendToRunQueue() + + appendToRunQueue(other_cap,tso); + + trace(TRACE_sched, "resuming capability %d", other_cap->no); + releaseCapability_(other_cap); } else { - appendToWakeupQueue(cap,tso); + appendToWakeupQueue(my_cap,other_cap,tso); + other_cap->context_switch = 1; // someone is running on this Capability, so it cannot be // freed without first checking the wakeup queue (see // releaseCapability_). } -} -void -wakeupThreadOnCapability_lock (Capability *cap, StgTSO *tso) -{ - ACQUIRE_LOCK(&cap->lock); - migrateThreadToCapability (cap, tso); - RELEASE_LOCK(&cap->lock); -} - -void -migrateThreadToCapability (Capability *cap, StgTSO *tso) -{ - // ASSUMES: cap->lock is held (asserted in wakeupThreadOnCapability) - if (tso->bound) { - ASSERT(tso->bound->cap == tso->cap); - tso->bound->cap = cap; - } - tso->cap = cap; - wakeupThreadOnCapability(cap,tso); -} - -void -migrateThreadToCapability_lock (Capability *cap, StgTSO *tso) -{ - ACQUIRE_LOCK(&cap->lock); - migrateThreadToCapability (cap, tso); - RELEASE_LOCK(&cap->lock); + RELEASE_LOCK(&other_cap->lock); } /* ---------------------------------------------------------------------------- @@ -638,7 +662,7 @@ prodOneCapability (void) * ------------------------------------------------------------------------- */ void -shutdownCapability (Capability *cap, Task *task) +shutdownCapability (Capability *cap, Task *task, rtsBool safe) { nat i; @@ -646,7 +670,13 @@ shutdownCapability (Capability *cap, Task *task) task->cap = cap; - for (i = 0; i < 50; i++) { + // Loop indefinitely until all the workers have exited and there + // are no Haskell threads left. We used to bail out after 50 + // iterations of this loop, but that occasionally left a worker + // running which caused problems later (the closeMutex() below + // isn't safe, for one thing). + + for (i = 0; /* i < 50 */; i++) { debugTrace(DEBUG_sched, "shutting down capability %d, attempt %d", cap->no, i); ACQUIRE_LOCK(&cap->lock); @@ -657,6 +687,30 @@ shutdownCapability (Capability *cap, Task *task) continue; } cap->running_task = task; + + if (cap->spare_workers) { + // Look for workers that have died without removing + // themselves from the list; this could happen if the OS + // summarily killed the thread, for example. This + // actually happens on Windows when the system is + // terminating the program, and the RTS is running in a + // DLL. + Task *t, *prev; + prev = NULL; + for (t = cap->spare_workers; t != NULL; t = t->next) { + if (!osThreadIsAlive(t->id)) { + debugTrace(DEBUG_sched, + "worker thread %p has died unexpectedly", (void *)t->id); + if (!prev) { + cap->spare_workers = t->next; + } else { + prev->next = t->next; + } + prev = t; + } + } + } + if (!emptyRunQueue(cap) || cap->spare_workers) { debugTrace(DEBUG_sched, "runnable threads or workers still alive, yielding"); @@ -665,15 +719,34 @@ shutdownCapability (Capability *cap, Task *task) yieldThread(); continue; } + + // If "safe", then busy-wait for any threads currently doing + // foreign calls. If we're about to unload this DLL, for + // example, we need to be sure that there are no OS threads + // that will try to return to code that has been unloaded. + // We can be a bit more relaxed when this is a standalone + // program that is about to terminate, and let safe=false. + if (cap->suspended_ccalling_tasks && safe) { + debugTrace(DEBUG_sched, + "thread(s) are involved in foreign calls, yielding"); + cap->running_task = NULL; + RELEASE_LOCK(&cap->lock); + yieldThread(); + continue; + } + debugTrace(DEBUG_sched, "capability %d is stopped.", cap->no); + freeCapability(cap); RELEASE_LOCK(&cap->lock); break; } // we now have the Capability, its run queue and spare workers // list are both empty. - // We end up here only in THREADED_RTS - closeMutex(&cap->lock); + // ToDo: we can't drop this mutex, because there might still be + // threads performing foreign calls that will eventually try to + // return via resumeThread() and attempt to grab cap->lock. + // closeMutex(&cap->lock); } /* ---------------------------------------------------------------------------- @@ -701,4 +774,75 @@ tryGrabCapability (Capability *cap, Task *task) #endif /* THREADED_RTS */ +void +freeCapability (Capability *cap) { + stgFree(cap->mut_lists); +#if defined(THREADED_RTS) || defined(PARALLEL_HASKELL) + freeSparkPool(&cap->r.rSparks); +#endif +} + +/* --------------------------------------------------------------------------- + Mark everything directly reachable from the Capabilities. When + using multiple GC threads, each GC thread marks all Capabilities + for which (c `mod` n == 0), for Capability c and thread n. + ------------------------------------------------------------------------ */ + +void +markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta) +{ + nat i; + Capability *cap; + Task *task; + + // Each GC thread is responsible for following roots from the + // Capability of the same number. There will usually be the same + // or fewer Capabilities as GC threads, but just in case there + // are more, we mark every Capability whose number is the GC + // thread's index plus a multiple of the number of GC threads. + for (i = i0; i < n_capabilities; i += delta) { + cap = &capabilities[i]; + evac(user, (StgClosure **)(void *)&cap->run_queue_hd); + evac(user, (StgClosure **)(void *)&cap->run_queue_tl); +#if defined(THREADED_RTS) + evac(user, (StgClosure **)(void *)&cap->wakeup_queue_hd); + evac(user, (StgClosure **)(void *)&cap->wakeup_queue_tl); +#endif + for (task = cap->suspended_ccalling_tasks; task != NULL; + task=task->next) { + debugTrace(DEBUG_sched, + "evac'ing suspended TSO %lu", (unsigned long)task->suspended_tso->id); + evac(user, (StgClosure **)(void *)&task->suspended_tso); + } +#if defined(THREADED_RTS) + traverseSparkQueue (evac, user, cap); +#endif + } + +#if !defined(THREADED_RTS) + evac(user, (StgClosure **)(void *)&blocked_queue_hd); + evac(user, (StgClosure **)(void *)&blocked_queue_tl); + evac(user, (StgClosure **)(void *)&sleeping_queue); +#endif +} + +// This function is used by the compacting GC to thread all the +// pointers from spark queues. +void +traverseSparkQueues (evac_fn evac USED_IF_THREADS, void *user USED_IF_THREADS) +{ +#if defined(THREADED_RTS) + nat i; + for (i = 0; i < n_capabilities; i++) { + traverseSparkQueue (evac, user, &capabilities[i]); + } +#endif // THREADED_RTS + +} + +void +markCapabilities (evac_fn evac, void *user) +{ + markSomeCapabilities(evac, user, 0, 1); +}