/* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.89 2001/02/09 13:09:16 simonmar Exp $
+ * $Id: Schedule.c,v 1.93 2001/03/02 16:15:53 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
switch (cap->rCurrentTSO->what_next) {
case ThreadKilled:
case ThreadComplete:
- /* Thread already finished, return to scheduler. */
- ret = ThreadFinished;
- break;
+ /* Thread already finished, return to scheduler. */
+ ret = ThreadFinished;
+ break;
case ThreadEnterGHC:
- ret = StgRun((StgFunPtr) stg_enterStackTop, cap);
- break;
+ ret = StgRun((StgFunPtr) stg_enterStackTop, cap);
+ break;
case ThreadRunGHC:
- ret = StgRun((StgFunPtr) stg_returnToStackTop, cap);
- break;
+ ret = StgRun((StgFunPtr) stg_returnToStackTop, cap);
+ break;
case ThreadEnterInterp:
-#ifdef GHCI
- {
- IF_DEBUG(scheduler,sched_belch("entering interpreter"));
- ret = interpretBCO(cap);
- break;
- }
-#else
- barf("Panic: entered a BCO but no bytecode interpreter in this build");
-#endif
+ ret = interpretBCO(cap);
+ break;
default:
barf("schedule: invalid what_next field");
}
StgTSO *target = tso->block_info.tso;
ASSERT(get_itbl(target)->type == TSO);
+
+ if (target->what_next == ThreadRelocated) {
+ target = target->link;
+ ASSERT(get_itbl(target)->type == TSO);
+ }
+
ASSERT(target->blocked_exceptions != NULL);
last = (StgBlockingQueueElement **)&target->blocked_exceptions;
StgTSO *target = tso->block_info.tso;
ASSERT(get_itbl(target)->type == TSO);
+
+ while (target->what_next == ThreadRelocated) {
+ target = target->link;
+ ASSERT(get_itbl(target)->type == TSO);
+ }
+
ASSERT(target->blocked_exceptions != NULL);
last = &target->blocked_exceptions;
/* Replace the updatee with an indirection - happily
* this will also wake up any threads currently
* waiting on the result.
+ *
+ * Warning: if we're in a loop, more than one update frame on
+ * the stack may point to the same object. Be careful not to
+ * overwrite an IND_OLDGEN in this case, because we'll screw
+ * up the mutable lists. To be on the safe side, don't
+ * overwrite any kind of indirection at all. See also
+ * threadSqueezeStack in GC.c, where we have to make a similar
+ * check.
*/
- UPD_IND_NOLOCK(su->updatee,ap); /* revert the black hole */
+ if (!closure_IND(su->updatee)) {
+ UPD_IND_NOLOCK(su->updatee,ap); /* revert the black hole */
+ }
su = su->link;
sp += sizeofW(StgUpdateFrame) -1;
sp[0] = (W_)ap; /* push onto stack */
break;
}
-
+
case CATCH_FRAME:
{
StgCatchFrame *cf = (StgCatchFrame *)su;
for (t = all_threads; t != END_TSO_QUEUE; t = t->global_link) {
+ while (t->what_next == ThreadRelocated) {
+ t = t->link;
+ ASSERT(get_itbl(t)->type == TSO);
+ }
+
if (t->why_blocked != BlockedOnBlackHole) {
continue;
}