Commit a1750cd6 authored by simonmar's avatar simonmar

[project @ 2000-01-22 18:00:03 by simonmar]

Fix bug in async exception handling: the target TSO may have been
relocated as a result of a stack overflow.

Introduce a new StgTSOWhatNext value "ThreadRelocated", which
indicates that this TSO has moved, and the new location is in the link
field.  The garbage collector shorts these out just like indirections.

We have to check for relocated TSOs in killThread# (and any other
primops which take a ThreadId# as an argument - there aren't any at
present).
parent c9dd5934
/* -----------------------------------------------------------------------------
* $Id: TSO.h,v 1.10 2000/01/13 14:34:01 hwloidl Exp $
* $Id: TSO.h,v 1.11 2000/01/22 18:00:03 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -71,12 +71,16 @@ typedef enum {
tso_state_stopped
} StgTSOState;
/*
* The whatNext field of a TSO indicates how the thread is to be run.
*/
typedef enum {
ThreadEnterGHC,
ThreadRunGHC,
ThreadEnterHugs,
ThreadKilled,
ThreadComplete
ThreadEnterGHC, /* enter top thunk on stack */
ThreadRunGHC, /* return to address on top of stack */
ThreadEnterHugs, /* enter top thunk on stack (w/ interpreter) */
ThreadKilled, /* thread has died, don't run it */
ThreadRelocated, /* thread has moved, link points to new locn */
ThreadComplete /* thread has finished */
} StgTSOWhatNext;
/*
......
/* -----------------------------------------------------------------------------
* $Id: Exception.hc,v 1.4 2000/01/14 11:45:21 hwloidl Exp $
* $Id: Exception.hc,v 1.5 2000/01/22 18:00:03 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -51,8 +51,11 @@ FN_(blockAsyncExceptionszh_fast)
if (CurrentTSO->blocked_exceptions == NULL) {
CurrentTSO->blocked_exceptions = END_TSO_QUEUE;
Sp--;
Sp[0] = (W_)&unblockAsyncExceptionszh_ret_info;
/* avoid growing the stack unnecessarily */
if (Sp[0] != (W_)&blockAsyncExceptionszh_ret_info) {
Sp--;
Sp[0] = (W_)&blockAsyncExceptionszh_ret_info;
}
}
Sp--;
Sp[0] = ARG_TAG(0);
......@@ -101,8 +104,12 @@ FN_(unblockAsyncExceptionszh_fast)
awakenBlockedQueue(CurrentTSO->blocked_exceptions);
#endif
CurrentTSO->blocked_exceptions = NULL;
Sp--;
Sp[0] = (W_)&blockAsyncExceptionszh_ret_info;
/* avoid growing the stack unnecessarily */
if (Sp[0] != (W_)&blockAsyncExceptionszh_ret_info) {
Sp--;
Sp[0] = (W_)&blockAsyncExceptionszh_ret_info;
}
}
Sp--;
Sp[0] = ARG_TAG(0);
......@@ -127,6 +134,13 @@ FN_(killThreadzh_fast)
FB_
/* args: R1.p = TSO to kill, R2.p = Exception */
/* This thread may have been relocated.
* (see Schedule.c:threadStackOverflow)
*/
while (R1.t->whatNext == ThreadRelocated) {
R1.t = R1.t->link;
}
/* If the target thread is currently blocking async exceptions,
* we'll have to block until it's ready to accept them.
*/
......
/* -----------------------------------------------------------------------------
* $Id: GC.c,v 1.71 2000/01/14 14:55:03 simonmar Exp $
* $Id: GC.c,v 1.72 2000/01/22 18:00:03 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
......@@ -933,7 +933,6 @@ isAlive(StgClosure *p)
StgClosure *
MarkRoot(StgClosure *root)
{
//if (root != END_TSO_QUEUE)
return evacuate(root);
}
......@@ -1490,10 +1489,17 @@ loop:
case TSO:
{
StgTSO *tso = stgCast(StgTSO *,q);
StgTSO *tso = (StgTSO *)q;
nat size = tso_sizeW(tso);
int diff;
/* Deal with redirected TSOs (a TSO that's had its stack enlarged).
*/
if (tso->whatNext == ThreadRelocated) {
q = (StgClosure *)tso->link;
goto loop;
}
/* Large TSOs don't get moved, so no relocation is required.
*/
if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
......
/* ---------------------------------------------------------------------------
* $Id: Schedule.c,v 1.44 2000/01/14 13:39:59 simonmar Exp $
* $Id: Schedule.c,v 1.45 2000/01/22 18:00:03 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -697,13 +697,15 @@ 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;
}
}
ready_to_gc = rtsTrue;
context_switch = 1;
PUSH_ON_RUN_QUEUE(new_t);
}
break;
......@@ -1583,9 +1585,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 *
......@@ -1642,14 +1645,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 +1664,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;
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment