X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FSchedule.c;h=036c5b0ebf09c7b78e5149f71d1bc3668ab69289;hb=8ffe6eb9e68b0e8508bd943d51f6575709865afd;hp=079238de7c07758378bb5f00f2d1e8d6d9cb3e0a;hpb=1996af4376c70c8fa33b1a4068fe613523517b90;p=ghc-hetmet.git diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c index 079238d..036c5b0 100644 --- a/ghc/rts/Schedule.c +++ b/ghc/rts/Schedule.c @@ -174,6 +174,9 @@ static StgTSO *suspended_ccalling_threads; /* flag set by signal handler to precipitate a context switch */ int context_switch = 0; +/* flag that tracks whether we have done any execution in this time slice. */ +nat recent_activity = ACTIVITY_YES; + /* if this flag is set as well, give up execution */ rtsBool interrupted = rtsFalse; @@ -473,6 +476,15 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS, // We now have a capability... #endif + +#if 0 /* extra sanity checking */ + { + StgMainThread *m; + for (m = main_threads; m != NULL; m = m->link) { + ASSERT(get_itbl(m->tso)->type == TSO); + } + } +#endif // Check whether we have re-entered the RTS from Haskell without // going via suspendThread()/resumeThread (i.e. a 'safe' foreign @@ -668,6 +680,8 @@ run_thread: errno = t->saved_errno; cap->r.rInHaskell = rtsTrue; + recent_activity = ACTIVITY_YES; + switch (prev_what_next) { case ThreadKilled: @@ -850,6 +864,12 @@ scheduleCheckBlackHoles( void ) static void scheduleDetectDeadlock(void) { + +#if defined(PARALLEL_HASKELL) + // ToDo: add deadlock detection in GUM (similar to SMP) -- HWL + return; +#endif + /* * Detect deadlock: when we have no threads to run, there are no * threads blocked, waiting for I/O, or sleeping, and all the @@ -858,7 +878,16 @@ scheduleDetectDeadlock(void) */ if ( EMPTY_THREAD_QUEUES() ) { -#if !defined(PARALLEL_HASKELL) && !defined(RTS_SUPPORTS_THREADS) +#if defined(RTS_SUPPORTS_THREADS) + /* + * In the threaded RTS, we only check for deadlock if there + * has been no activity in a complete timeslice. This means + * we won't eagerly start a full GC just because we don't have + * any threads to run currently. + */ + if (recent_activity != ACTIVITY_INACTIVE) return; +#endif + IF_DEBUG(scheduler, sched_belch("deadlocked, forcing major GC...")); // Garbage collection can release some new threads due to @@ -867,9 +896,10 @@ scheduleDetectDeadlock(void) // exception. Any threads thus released will be immediately // runnable. GarbageCollect(GetRoots,rtsTrue); + recent_activity = ACTIVITY_DONE_GC; if ( !EMPTY_RUN_QUEUE() ) return; -#if defined(RTS_USER_SIGNALS) +#if defined(RTS_USER_SIGNALS) && !defined(RTS_SUPPORTS_THREADS) /* If we have user-installed signal handlers, then wait * for signals to arrive rather then bombing out with a * deadlock. @@ -891,6 +921,7 @@ scheduleDetectDeadlock(void) } #endif +#if !defined(RTS_SUPPORTS_THREADS) /* 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 @@ -910,11 +941,6 @@ scheduleDetectDeadlock(void) barf("deadlock: main thread blocked in a strange way"); } } - -#elif defined(RTS_SUPPORTS_THREADS) - // ToDo: add deadlock detection in threaded RTS -#elif defined(PARALLEL_HASKELL) - // ToDo: add deadlock detection in GUM (similar to SMP) -- HWL #endif } } @@ -1802,6 +1828,7 @@ scheduleHandleThreadFinished( StgMainThread *mainThread removeThreadLabel((StgWord)mainThread->tso->id); #endif if (mainThread->prev == NULL) { + ASSERT(mainThread == main_threads); main_threads = mainThread->link; } else { mainThread->prev->link = mainThread->link; @@ -1958,7 +1985,7 @@ scheduleDoGC( Capability *cap STG_UNUSED ) StgBool rtsSupportsBoundThreads(void) { -#ifdef THREADED_RTS +#if defined(RTS_SUPPORTS_THREADS) return rtsTrue; #else return rtsFalse; @@ -1972,7 +1999,7 @@ rtsSupportsBoundThreads(void) StgBool isThreadBound(StgTSO* tso USED_IN_THREADED_RTS) { -#ifdef THREADED_RTS +#if defined(RTS_SUPPORTS_THREADS) return (tso->main != NULL); #endif return rtsFalse; @@ -3220,6 +3247,11 @@ interruptStgRts(void) { interrupted = 1; context_switch = 1; + threadRunnable(); + /* ToDo: if invoked from a signal handler, this threadRunnable + * only works if there's another thread (not this one) waiting to + * be woken up. + */ } /* ----------------------------------------------------------------------------- @@ -3343,6 +3375,12 @@ unblockThread(StgTSO *tso) blocked_queue_tl = (StgTSO *)prev; } } +#if defined(mingw32_HOST_OS) + /* (Cooperatively) signal that the worker thread should abort + * the request. + */ + abandonWorkRequest(tso->block_info.async_result->reqID); +#endif goto done; } } @@ -3477,6 +3515,12 @@ unblockThread(StgTSO *tso) blocked_queue_tl = prev; } } +#if defined(mingw32_HOST_OS) + /* (Cooperatively) signal that the worker thread should abort + * the request. + */ + abandonWorkRequest(tso->block_info.async_result->reqID); +#endif goto done; } } @@ -3739,12 +3783,12 @@ raiseAsync_(StgTSO *tso, StgClosure *exception, rtsBool stop_at_atomically) #ifdef PROFILING StgCatchFrame *cf = (StgCatchFrame *)frame; #endif - StgClosure *raise; + StgThunk *raise; // we've got an exception to raise, so let's pass it to the // handler in this frame. // - raise = (StgClosure *)allocate(sizeofW(StgClosure)+1); + raise = (StgThunk *)allocate(sizeofW(StgThunk)+1); TICK_ALLOC_SE_THK(1,0); SET_HDR(raise,&stg_raise_info,cf->header.prof.ccs); raise->payload[0] = exception; @@ -3782,7 +3826,7 @@ raiseAsync_(StgTSO *tso, StgClosure *exception, rtsBool stop_at_atomically) // fun field. // words = frame - sp - 1; - ap = (StgAP_STACK *)allocate(PAP_sizeW(words)); + ap = (StgAP_STACK *)allocate(AP_STACK_sizeW(words)); ap->size = words; ap->fun = (StgClosure *)sp[0]; @@ -3849,7 +3893,7 @@ raiseAsync_(StgTSO *tso, StgClosure *exception, rtsBool stop_at_atomically) StgWord raiseExceptionHelper (StgTSO *tso, StgClosure *exception) { - StgClosure *raise_closure = NULL; + StgThunk *raise_closure = NULL; StgPtr p, next; StgRetInfoTable *info; // @@ -3886,11 +3930,11 @@ raiseExceptionHelper (StgTSO *tso, StgClosure *exception) // Only create raise_closure if we need to. if (raise_closure == NULL) { raise_closure = - (StgClosure *)allocate(sizeofW(StgClosure)+MIN_UPD_SIZE); + (StgThunk *)allocate(sizeofW(StgThunk)+MIN_UPD_SIZE); SET_HDR(raise_closure, &stg_raise_info, CCCS); raise_closure->payload[0] = exception; } - UPD_IND(((StgUpdateFrame *)p)->updatee,raise_closure); + UPD_IND(((StgUpdateFrame *)p)->updatee,(StgClosure *)raise_closure); p = next; continue;