X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FSchedule.c;h=e3100efde6d551a8e4e926e23585699ecc8ac858;hb=3ddfe34ba0b8b1c0721841c73d0c671e43a600ac;hp=37eeda944af856173a1fb0bbd921adf982c76b58;hpb=2942189980ad5c202c0d473bea80b387755497d1;p=ghc-hetmet.git diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c index 37eeda9..e3100ef 100644 --- a/ghc/rts/Schedule.c +++ b/ghc/rts/Schedule.c @@ -1,7 +1,7 @@ /* --------------------------------------------------------------------------- - * $Id: Schedule.c,v 1.44 2000/01/14 13:39:59 simonmar Exp $ + * $Id: Schedule.c,v 1.52 2000/03/14 09:55:05 simonmar Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2000 * * Scheduler * @@ -72,6 +72,7 @@ #include "Sanity.h" #include "Stats.h" #include "Sparks.h" +#include "Prelude.h" #if defined(GRAN) || defined(PAR) # include "GranSimRts.h" # include "GranSim.h" @@ -295,6 +296,7 @@ schedule( void ) StgTSO *tso; GlobalTaskId pe; #endif + rtsBool was_interrupted = rtsFalse; ACQUIRE_LOCK(&sched_mutex); @@ -324,6 +326,8 @@ schedule( void ) } run_queue_hd = run_queue_tl = END_TSO_QUEUE; blocked_queue_hd = blocked_queue_tl = END_TSO_QUEUE; + interrupted = rtsFalse; + was_interrupted = rtsTrue; } /* Go through the list of main threads and wake up any @@ -347,7 +351,11 @@ schedule( void ) break; case ThreadKilled: *prev = m->link; - m->stat = Killed; + if (was_interrupted) { + m->stat = Interrupted; + } else { + m->stat = Killed; + } pthread_cond_broadcast(&m->wakeup); break; default: @@ -369,7 +377,11 @@ schedule( void ) m->stat = Success; return; } else { - m->stat = Killed; + if (was_interrupted) { + m->stat = Interrupted; + } else { + m->stat = Killed; + } return; } } @@ -597,6 +609,7 @@ schedule( void ) /* grab a thread from the run queue */ t = POP_RUN_QUEUE(); + IF_DEBUG(sanity,checkTSO(t)); #endif @@ -697,13 +710,14 @@ schedule( void ) /* This TSO has moved, so update any pointers to it from the * main thread stack. It better not be on any other queues... - * (it shouldn't be) + * (it shouldn't be). */ for (m = main_threads; m != NULL; m = m->link) { if (m->tso == t) { m->tso = new_t; } } + threadPaused(new_t); PUSH_ON_RUN_QUEUE(new_t); } break; @@ -1583,9 +1597,10 @@ performGCWithRoots(void (*get_roots)(void)) /* ----------------------------------------------------------------------------- Stack overflow - If the thread has reached its maximum stack size, - then bomb out. Otherwise relocate the TSO into a larger chunk of - memory and adjust its stack size appropriately. + If the thread has reached its maximum stack size, then raise the + StackOverflow exception in the offending thread. Otherwise + relocate the TSO into a larger chunk of memory and adjust its stack + size appropriately. -------------------------------------------------------------------------- */ static StgTSO * @@ -1595,6 +1610,7 @@ threadStackOverflow(StgTSO *tso) StgPtr new_sp; StgTSO *dest; + IF_DEBUG(sanity,checkTSO(tso)); if (tso->stack_size >= tso->max_stack_size) { #if 0 /* If we're debugging, just print out the top of the stack */ @@ -1606,7 +1622,7 @@ threadStackOverflow(StgTSO *tso) exit(1); #else /* Send this thread the StackOverflow exception */ - raiseAsync(tso, (StgClosure *)&stackOverflow_closure); + raiseAsync(tso, (StgClosure *)stackOverflow_closure); #endif return tso; } @@ -1642,14 +1658,15 @@ threadStackOverflow(StgTSO *tso) /* and relocate the update frame list */ relocate_TSO(tso, dest); - /* Mark the old one as dead so we don't try to scavenge it during - * garbage collection (the TSO will likely be on a mutables list in - * some generation, but it'll get collected soon enough). It's - * important to set the sp and su values to just beyond the end of - * the stack, so we don't attempt to scavenge any part of the dead - * TSO's stack. + /* Mark the old TSO as relocated. We have to check for relocated + * TSOs in the garbage collector and any primops that deal with TSOs. + * + * It's important to set the sp and su values to just beyond the end + * of the stack, so we don't attempt to scavenge any part of the + * dead TSO's stack. */ - tso->whatNext = ThreadKilled; + tso->whatNext = ThreadRelocated; + tso->link = dest; tso->sp = (P_)&(tso->stack[tso->stack_size]); tso->su = (StgUpdateFrame *)tso->sp; tso->why_blocked = NotBlocked; @@ -1660,12 +1677,6 @@ threadStackOverflow(StgTSO *tso) IF_DEBUG(scheduler,printTSO(dest)); #endif -#if 0 - /* This will no longer work: KH */ - if (tso == MainTSO) { /* hack */ - MainTSO = dest; - } -#endif return dest; } @@ -1835,16 +1846,7 @@ unblockOneLocked(StgTSO *tso) } #endif -#if defined(GRAN) -inline StgTSO * -unblockOne(StgTSO *tso, StgClosure *node) -{ - ACQUIRE_LOCK(&sched_mutex); - tso = unblockOneLocked(tso, node); - RELEASE_LOCK(&sched_mutex); - return tso; -} -#elif defined(PAR) +#if defined(PAR) || defined(GRAN) inline StgTSO * unblockOne(StgTSO *tso, StgClosure *node) { @@ -2161,25 +2163,27 @@ raiseAsync(StgTSO *tso, StgClosure *exception) StgAP_UPD * ap; /* If we find a CATCH_FRAME, and we've got an exception to raise, - * then build PAP(handler,exception), and leave it on top of - * the stack ready to enter. + * then build PAP(handler,exception,realworld#), and leave it on + * top of the stack ready to enter. */ if (get_itbl(su)->type == CATCH_FRAME && exception != NULL) { StgCatchFrame *cf = (StgCatchFrame *)su; /* we've got an exception to raise, so let's pass it to the * handler in this frame. */ - ap = (StgAP_UPD *)allocate(sizeofW(StgPAP) + 1); - TICK_ALLOC_UPD_PAP(2,0); + ap = (StgAP_UPD *)allocate(sizeofW(StgPAP) + 2); + TICK_ALLOC_UPD_PAP(3,0); SET_HDR(ap,&PAP_info,cf->header.prof.ccs); - ap->n_args = 1; - ap->fun = cf->handler; + ap->n_args = 2; + ap->fun = cf->handler; /* :: Exception -> IO a */ ap->payload[0] = (P_)exception; + ap->payload[1] = ARG_TAG(0); /* realworld token */ - /* sp currently points to the word above the CATCH_FRAME on the stack. + /* throw away the stack from Sp up to and including the + * CATCH_FRAME. */ - sp += sizeofW(StgCatchFrame); + sp = (P_)su + sizeofW(StgCatchFrame) - 1; tso->su = cf->link; /* Restore the blocked/unblocked state for asynchronous exceptions