[project @ 2000-02-29 14:38:19 by simonmar]

[ghc-hetmet.git] / ghc / rts / Schedule.c

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 37eeda9..ef5b539 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.47 2000/02/29 14:38:19 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -347,7 +347,11 @@ schedule( void )
          break;
        case ThreadKilled:
          *prev = m->link;
-         m->stat = Killed;
+         if (interrupted) {
+           m->stat = Interrupted;
+         } else {
+           m->stat = Killed;
+         }
          pthread_cond_broadcast(&m->wakeup);
          break;
        default:
@@ -369,7 +373,11 @@ schedule( void )
          m->stat = Success;
          return;
        } else {
-         m->stat = Killed;
+         if (interrupted) {
+           m->stat = Interrupted;
+         } else {
+           m->stat = Killed;
+         }
          return;
        }
       }
@@ -597,6 +605,7 @@ schedule( void )
     /* grab a thread from the run queue
      */
     t = POP_RUN_QUEUE();
+    IF_DEBUG(sanity,checkTSO(t));
 
 #endif
     
@@ -697,13 +706,16 @@ 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;
          }
        }
+       threadPaused(new_t);
+       ready_to_gc = rtsTrue;
+       context_switch = 1;
        PUSH_ON_RUN_QUEUE(new_t);
       }
       break;
@@ -1583,9 +1595,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 *
@@ -1595,6 +1608,7 @@ threadStackOverflow(StgTSO *tso)
   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 */
@@ -1642,14 +1656,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 +1675,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;
 }
 
@@ -2161,25 +2170,27 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
     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