[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).

diff --git a/ghc/includes/TSO.h b/ghc/includes/TSO.h
index ce46e00..2b81f76 100644 (file)
--- 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 d74ecec..ce7ba7a 100644 (file)
--- 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 02f76af..acb122f 100644 (file)
--- 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 37eeda9..88a66d8 100644 (file)
--- 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;
 }