[project @ 2001-03-14 15:01:04 by sewardj]

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

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 380228f..14be29b 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.81 2000/11/13 14:40:37 simonmar Exp $
+ * $Id: Schedule.c,v 1.93 2001/03/02 16:15:53 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -62,7 +62,7 @@
 #include "Schedule.h"
 #include "StgMiscClosures.h"
 #include "Storage.h"
-#include "Evaluator.h"
+#include "Interpreter.h"
 #include "Exception.h"
 #include "Printer.h"
 #include "Main.h"
@@ -267,7 +267,7 @@ rtsTime TimeOfLastYield;
 char *whatNext_strs[] = {
   "ThreadEnterGHC",
   "ThreadRunGHC",
-  "ThreadEnterHugs",
+  "ThreadEnterInterp",
   "ThreadKilled",
   "ThreadComplete"
 };
@@ -877,28 +877,18 @@ schedule( void )
     switch (cap->rCurrentTSO->what_next) {
     case ThreadKilled:
     case ThreadComplete:
-      /* Thread already finished, return to scheduler. */
-      ret = ThreadFinished;
-      break;
+       /* Thread already finished, return to scheduler. */
+       ret = ThreadFinished;
+       break;
     case ThreadEnterGHC:
-      ret = StgRun((StgFunPtr) stg_enterStackTop, cap);
-      break;
+       ret = StgRun((StgFunPtr) stg_enterStackTop, cap);
+       break;
     case ThreadRunGHC:
-      ret = StgRun((StgFunPtr) stg_returnToStackTop, cap);
-      break;
-    case ThreadEnterHugs:
-#ifdef INTERPRETER
-      {
-         StgClosure* c;
-        IF_DEBUG(scheduler,sched_belch("entering Hugs"));
-        c = (StgClosure *)(cap->rCurrentTSO->sp[0]);
-        cap->rCurrentTSO->sp += 1;
-        ret = enter(cap,c);
-         break;
-      }
-#else
-      barf("Panic: entered a BCO but no bytecode interpreter in this build");
-#endif
+       ret = StgRun((StgFunPtr) stg_returnToStackTop, cap);
+       break;
+    case ThreadEnterInterp:
+       ret = interpretBCO(cap);
+       break;
     default:
       barf("schedule: invalid what_next field");
     }
@@ -986,7 +976,7 @@ schedule( void )
        * GC is finished.
        */
       IF_DEBUG(scheduler,
-               if (t->what_next == ThreadEnterHugs) {
+               if (t->what_next == ThreadEnterInterp) {
                   /* ToDo: or maybe a timer expired when we were in Hugs?
                    * or maybe someone hit ctrl-C
                     */
@@ -1247,6 +1237,7 @@ resumeThread( StgInt tok )
   if (tso == END_TSO_QUEUE) {
     barf("resumeThread: thread not found");
   }
+  tso->link = END_TSO_QUEUE;
 
 #ifdef SMP
   while (free_capabilities == NULL) {
@@ -1616,11 +1607,6 @@ initScheduler(void)
   RtsFlags.ConcFlags.ctxtSwitchTicks =
       RtsFlags.ConcFlags.ctxtSwitchTime / TICK_MILLISECS;
 
-#ifdef INTERPRETER
-  ecafList = END_ECAF_LIST;
-  clearECafTable();
-#endif
-
   /* Install the SIGHUP handler */
 #ifdef SMP
   {
@@ -2078,13 +2064,8 @@ threadStackOverflow(StgTSO *tso)
             printStackChunk(tso->sp, stg_min(tso->stack+tso->stack_size, 
                                              tso->sp+64)));
 
-#ifdef INTERPRETER
-    fprintf(stderr, "fatal: stack overflow in Hugs; aborting\n" );
-    exit(1);
-#else
     /* Send this thread the StackOverflow exception */
     raiseAsync(tso, (StgClosure *)stackOverflow_closure);
-#endif
     return tso;
   }
 
@@ -2509,6 +2490,12 @@ unblockThread(StgTSO *tso)
       StgTSO *target  = tso->block_info.tso;
 
       ASSERT(get_itbl(target)->type == TSO);
+
+      if (target->what_next == ThreadRelocated) {
+         target = target->link;
+         ASSERT(get_itbl(target)->type == TSO);
+      }
+
       ASSERT(target->blocked_exceptions != NULL);
 
       last = (StgBlockingQueueElement **)&target->blocked_exceptions;
@@ -2629,6 +2616,12 @@ unblockThread(StgTSO *tso)
       StgTSO *target  = tso->block_info.tso;
 
       ASSERT(get_itbl(target)->type == TSO);
+
+      while (target->what_next == ThreadRelocated) {
+         target = target->link;
+         ASSERT(get_itbl(target)->type == TSO);
+      }
+      
       ASSERT(target->blocked_exceptions != NULL);
 
       last = &target->blocked_exceptions;
@@ -2848,14 +2841,24 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
        /* Replace the updatee with an indirection - happily
         * this will also wake up any threads currently
         * waiting on the result.
+        *
+        * Warning: if we're in a loop, more than one update frame on
+        * the stack may point to the same object.  Be careful not to
+        * overwrite an IND_OLDGEN in this case, because we'll screw
+        * up the mutable lists.  To be on the safe side, don't
+        * overwrite any kind of indirection at all.  See also
+        * threadSqueezeStack in GC.c, where we have to make a similar
+        * check.
         */
-       UPD_IND_NOLOCK(su->updatee,ap);  /* revert the black hole */
+       if (!closure_IND(su->updatee)) {
+           UPD_IND_NOLOCK(su->updatee,ap);  /* revert the black hole */
+       }
        su = su->link;
        sp += sizeofW(StgUpdateFrame) -1;
        sp[0] = (W_)ap; /* push onto stack */
        break;
       }
-      
+
     case CATCH_FRAME:
       {
        StgCatchFrame *cf = (StgCatchFrame *)su;
@@ -2985,6 +2988,11 @@ detectBlackHoles( void )
 
     for (t = all_threads; t != END_TSO_QUEUE; t = t->global_link) {
 
+       while (t->what_next == ThreadRelocated) {
+           t = t->link;
+           ASSERT(get_itbl(t)->type == TSO);
+       }
+      
        if (t->why_blocked != BlockedOnBlackHole) {
            continue;
        }
@@ -3018,7 +3026,7 @@ detectBlackHoles( void )
            break;
        }
 
-    done:
+    done: ;
     }   
 }