X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSchedule.c;h=441e97924ebaeaa4d8fe03072d87fbae852c6662;hb=41fea58220e763fcd55830a11a37ff44f21e4358;hp=6063fcdc41ebe119edfbf2b3bb7e91b4e9a75489;hpb=cbeb99efd4a117de5b028341dc41bc8f50717383;p=ghc-hetmet.git diff --git a/rts/Schedule.c b/rts/Schedule.c index 6063fcd..441e979 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -7,6 +7,7 @@ * --------------------------------------------------------------------------*/ #include "PosixSource.h" +#define KEEP_LOCKCLOSURE #include "Rts.h" #include "SchedAPI.h" #include "RtsUtils.h" @@ -1813,9 +1814,6 @@ 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_thread_finished_event(t); - #if defined(GRAN) endThread(t, CurrentProc); // clean-up the thread #elif defined(PARALLEL_HASKELL) @@ -2761,7 +2759,12 @@ threadStackOverflow(Capability *cap, StgTSO *tso) // while we are moving the TSO: lockClosure((StgClosure *)tso); - if (tso->stack_size >= tso->max_stack_size) { + if (tso->stack_size >= tso->max_stack_size && !(tso->flags & TSO_BLOCKEX)) { + // NB. never raise a StackOverflow exception if the thread is + // inside Control.Exceptino.block. It is impractical to protect + // against stack overflow exceptions, since virtually anything + // can raise one (even 'catch'), so this is the only sensible + // thing to do here. See bug #767. debugTrace(DEBUG_gc, "threadStackOverflow of TSO %ld (%p): stack too large (now %ld; max is %ld)",