[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 88a66d8..ef5b539 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.45 2000/01/22 18:00:03 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
     
@@ -704,6 +713,7 @@ schedule( void )
            m->tso = new_t;
          }
        }
+       threadPaused(new_t);
        ready_to_gc = rtsTrue;
        context_switch = 1;
        PUSH_ON_RUN_QUEUE(new_t);
@@ -1598,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 */
@@ -2159,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