/* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.44 2000/01/14 13:39:59 simonmar Exp $
+ * $Id: Schedule.c,v 1.51 2000/03/13 10:53:56 simonmar Exp $
*
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
*
* Scheduler
*
#include "Sanity.h"
#include "Stats.h"
#include "Sparks.h"
+#include "Prelude.h"
#if defined(GRAN) || defined(PAR)
# include "GranSimRts.h"
# include "GranSim.h"
StgTSO *tso;
GlobalTaskId pe;
#endif
+ rtsBool was_interrupted = rtsFalse;
ACQUIRE_LOCK(&sched_mutex);
}
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
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:
m->stat = Success;
return;
} else {
- m->stat = Killed;
+ if (was_interrupted) {
+ m->stat = Interrupted;
+ } else {
+ m->stat = Killed;
+ }
return;
}
}
/* grab a thread from the run queue
*/
t = POP_RUN_QUEUE();
+ IF_DEBUG(sanity,checkTSO(t));
#endif
/* 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;
/* -----------------------------------------------------------------------------
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 *
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 */
/* 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;
IF_DEBUG(scheduler,printTSO(dest));
#endif
-#if 0
- /* This will no longer work: KH */
- if (tso == MainTSO) { /* hack */
- MainTSO = dest;
- }
-#endif
return dest;
}
}
#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)
{
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
projects / ghc-hetmet.git / blobdiff