diff --git a/ghc/includes/TSO.h b/ghc/includes/TSO.h
index ce46e00c9a22f3e3d62d135e7a117b47afbbfd22..2b81f7613541ee772f067fdb2b771ca5dd9f1abd 100644
--- a/ghc/includes/TSO.h
+++ b/ghc/includes/TSO.h
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $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;
/*
diff --git a/ghc/rts/Exception.hc b/ghc/rts/Exception.hc
index d74ecec4160e9076e8fc005235b179a663289b8d..ce7ba7a3ef91440cd36fce3414884f4eae203b39 100644
--- a/ghc/rts/Exception.hc
+++ b/ghc/rts/Exception.hc
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $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.
*/
diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 02f76afacf82ae110c3a9346c127f8119f886287..acb122fad6d336e34a37be9808f77428816aab58 100644
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $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_)) {
diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 37eeda944af856173a1fb0bbd921adf982c76b58..88a66d833bf7573dd76c059f08bdfc2e10267cbf 100644
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
/* ---------------------------------------------------------------------------
- * $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;
}