[project @ 2000-03-14 09:55:05 by simonmar]

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

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 88a66d8..e3100ef 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,7 +1,7 @@
 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.45 2000/01/22 18:00:03 simonmar Exp $
+ * $Id: Schedule.c,v 1.52 2000/03/14 09:55:05 simonmar Exp $
  *
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
  *
  * Scheduler
  *
@@ -72,6 +72,7 @@
 #include "Sanity.h"
 #include "Stats.h"
 #include "Sparks.h"
+#include "Prelude.h"
 #if defined(GRAN) || defined(PAR)
 # include "GranSimRts.h"
 # include "GranSim.h"
@@ -295,6 +296,7 @@ schedule( void )
   StgTSO *tso;
   GlobalTaskId pe;
 #endif
+  rtsBool was_interrupted = rtsFalse;
   
   ACQUIRE_LOCK(&sched_mutex);
 
@@ -324,6 +326,8 @@ schedule( void )
       }
       run_queue_hd = run_queue_tl = END_TSO_QUEUE;
       blocked_queue_hd = blocked_queue_tl = END_TSO_QUEUE;
+      interrupted = rtsFalse;
+      was_interrupted = rtsTrue;
     }
 
     /* Go through the list of main threads and wake up any
@@ -347,7 +351,11 @@ schedule( void )
          break;
        case ThreadKilled:
          *prev = m->link;
-         m->stat = Killed;
+         if (was_interrupted) {
+           m->stat = Interrupted;
+         } else {
+           m->stat = Killed;
+         }
          pthread_cond_broadcast(&m->wakeup);
          break;
        default:
@@ -369,7 +377,11 @@ schedule( void )
          m->stat = Success;
          return;
        } else {
-         m->stat = Killed;
+         if (was_interrupted) {
+           m->stat = Interrupted;
+         } else {
+           m->stat = Killed;
+         }
          return;
        }
       }
@@ -597,6 +609,7 @@ schedule( void )
     /* grab a thread from the run queue
      */
     t = POP_RUN_QUEUE();
+    IF_DEBUG(sanity,checkTSO(t));
 
 #endif
     
@@ -704,8 +717,7 @@ schedule( void )
            m->tso = new_t;
          }
        }
-       ready_to_gc = rtsTrue;
-       context_switch = 1;
+       threadPaused(new_t);
        PUSH_ON_RUN_QUEUE(new_t);
       }
       break;
@@ -1598,6 +1610,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 */
@@ -1609,7 +1622,7 @@ threadStackOverflow(StgTSO *tso)
     exit(1);
 #else
     /* Send this thread the StackOverflow exception */
-    raiseAsync(tso, (StgClosure *)&stackOverflow_closure);
+    raiseAsync(tso, (StgClosure *)stackOverflow_closure);
 #endif
     return tso;
   }
@@ -1833,16 +1846,7 @@ unblockOneLocked(StgTSO *tso)
 }
 #endif
 
-#if defined(GRAN)
-inline StgTSO *
-unblockOne(StgTSO *tso, StgClosure *node)
-{
-  ACQUIRE_LOCK(&sched_mutex);
-  tso = unblockOneLocked(tso, node);
-  RELEASE_LOCK(&sched_mutex);
-  return tso;
-}
-#elif defined(PAR)
+#if defined(PAR) || defined(GRAN)
 inline StgTSO *
 unblockOne(StgTSO *tso, StgClosure *node)
 {
@@ -2159,25 +2163,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