X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSchedule.c;h=8c254cc56a6d3011458d3502bee7ec0f530cf3e7;hb=66579ff945831c5fc9a17c58c722ff01f2268d76;hp=1b5afefc4f0e8f3a570dbf9df3062f110aabd5db;hpb=4753cf734c79ad196ef4411393a1516465302f71;p=ghc-hetmet.git diff --git a/rts/Schedule.c b/rts/Schedule.c index 1b5afef..8c254cc 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -89,11 +89,6 @@ StgTSO *blackhole_queue = NULL; */ rtsBool blackholes_need_checking = rtsFalse; -/* flag set by signal handler to precipitate a context switch - * LOCK: none (just an advisory flag) - */ -int context_switch = 0; - /* flag that tracks whether we have done any execution in this time slice. * LOCK: currently none, perhaps we should lock (but needs to be * updated in the fast path of the scheduler). @@ -504,7 +499,7 @@ schedule (Capability *initialCapability, Task *task) */ if (RtsFlags.ConcFlags.ctxtSwitchTicks == 0 && !emptyThreadQueues(cap)) { - context_switch = 1; + cap->context_switch = 1; } run_thread: @@ -969,10 +964,10 @@ scheduleDetectDeadlock (Capability *cap, Task *task) * Send pending messages (PARALLEL_HASKELL only) * ------------------------------------------------------------------------- */ +#if defined(PARALLEL_HASKELL) static StgTSO * scheduleSendPendingMessages(void) { -#if defined(PARALLEL_HASKELL) # if defined(PAR) // global Mem.Mgmt., omit for now if (PendingFetches != END_BF_QUEUE) { @@ -985,8 +980,8 @@ scheduleSendPendingMessages(void) // packets which have become too old... sendOldBuffers(); } -#endif } +#endif /* ---------------------------------------------------------------------------- * Activate spark threads (PARALLEL_HASKELL only) @@ -1179,12 +1174,12 @@ scheduleHandleHeapOverflow( Capability *cap, StgTSO *t ) "--<< thread %ld (%s) stopped: HeapOverflow", (long)t->id, whatNext_strs[t->what_next]); - if (context_switch) { + if (cap->context_switch) { // Sometimes we miss a context switch, e.g. when calling // primitives in a tight loop, MAYBE_GC() doesn't check the // context switch flag, and we end up waiting for a GC. // See #1984, and concurrent/should_run/1984 - context_switch = 0; + cap->context_switch = 0; addToRunQueue(cap,t); } else { pushOnRunQueue(cap,t); @@ -1234,7 +1229,7 @@ scheduleHandleYield( Capability *cap, StgTSO *t, nat prev_what_next ) // the CPU because the tick always arrives during GC). This way // penalises threads that do a lot of allocation, but that seems // better than the alternative. - context_switch = 0; + cap->context_switch = 0; /* put the thread back on the run queue. Then, if we're ready to * GC, check whether this is the last task to stop. If so, wake @@ -1402,7 +1397,6 @@ scheduleNeedHeapProfile( rtsBool ready_to_gc STG_UNUSED ) static Capability * scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major) { - StgTSO *t; rtsBool heap_census; #ifdef THREADED_RTS /* extern static volatile StgWord waiting_for_gc; @@ -1436,6 +1430,7 @@ scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major) return cap; // NOTE: task->cap might have changed here } + setContextSwitches(); for (i=0; i < n_capabilities; i++) { debugTrace(DEBUG_sched, "ready_to_gc, grabbing all the capabilies (%d/%d)", i, n_capabilities); if (cap != &capabilities[i]) { @@ -1446,7 +1441,6 @@ scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major) // all the Capabilities, but even so it's a slightly // unsavoury invariant. task->cap = pcap; - context_switch = 1; waitForReturnCapability(&pcap, task); if (pcap != &capabilities[i]) { barf("scheduleDoGC: got the wrong capability"); @@ -1871,7 +1865,7 @@ scheduleThreadOn(Capability *cap, StgWord cpu USED_IF_THREADS, StgTSO *tso) if (cpu == cap->no) { appendToRunQueue(cap,tso); } else { - migrateThreadToCapability_lock(&capabilities[cpu],tso); + wakeupThreadOnCapability(cap, &capabilities[cpu], tso); } #else appendToRunQueue(cap,tso); @@ -1913,7 +1907,7 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability *cap) * ------------------------------------------------------------------------- */ #if defined(THREADED_RTS) -void +void OSThreadProcAttr workerStart(Task *task) { Capability *cap; @@ -1955,7 +1949,6 @@ initScheduler(void) blackhole_queue = END_TSO_QUEUE; - context_switch = 0; sched_state = SCHED_RUNNING; recent_activity = ACTIVITY_YES; @@ -2193,7 +2186,7 @@ static StgTSO * threadStackUnderflow (Task *task STG_UNUSED, StgTSO *tso) { bdescr *bd, *new_bd; - lnat new_tso_size_w, tso_size_w; + lnat free_w, tso_size_w; StgTSO *new_tso; tso_size_w = tso_sizeW(tso); @@ -2208,19 +2201,19 @@ threadStackUnderflow (Task *task STG_UNUSED, StgTSO *tso) // while we are moving the TSO: lockClosure((StgClosure *)tso); - new_tso_size_w = round_to_mblocks(tso_size_w/2); - - debugTrace(DEBUG_sched, "thread %ld: reducing TSO size from %lu words to %lu", - tso->id, tso_size_w, new_tso_size_w); + // this is the number of words we'll free + free_w = round_to_mblocks(tso_size_w/2); bd = Bdescr((StgPtr)tso); - new_bd = splitLargeBlock(bd, new_tso_size_w / BLOCK_SIZE_W); - new_bd->free = bd->free; + new_bd = splitLargeBlock(bd, free_w / BLOCK_SIZE_W); bd->free = bd->start + TSO_STRUCT_SIZEW; new_tso = (StgTSO *)new_bd->start; memcpy(new_tso,tso,TSO_STRUCT_SIZE); - new_tso->stack_size = new_tso_size_w - TSO_STRUCT_SIZEW; + new_tso->stack_size = new_bd->free - new_tso->stack; + + debugTrace(DEBUG_sched, "thread %ld: reducing TSO size from %lu words to %lu", + (long)tso->id, tso_size_w, tso_sizeW(new_tso)); tso->what_next = ThreadRelocated; tso->_link = new_tso; // no write barrier reqd: same generation @@ -2248,7 +2241,7 @@ void interruptStgRts(void) { sched_state = SCHED_INTERRUPTING; - context_switch = 1; + setContextSwitches(); wakeUpRts(); } @@ -2312,8 +2305,6 @@ checkBlackHoles (Capability *cap) if (type != BLACKHOLE && type != CAF_BLACKHOLE) { IF_DEBUG(sanity,checkTSO(t)); t = unblockOne(cap, t); - // urk, the threads migrate to the current capability - // here, but we'd like to keep them on the original one. *prev = t; any_woke_up = rtsTrue; } else {