[project @ 2002-07-23 10:08:58 by simonmar]
[ghc-hetmet.git] / ghc / rts / Schedule.c
index 530bdf9..da57bec 100644 (file)
@@ -1,5 +1,5 @@
 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.146 2002/06/26 08:18:42 stolz Exp $
+ * $Id: Schedule.c,v 1.150 2002/07/19 18:45:21 sof Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
 #include <unistd.h>
 #endif
 
+#include <string.h>
+#include <stdlib.h>
 #include <stdarg.h>
 
 //@node Variables and Data structures, Prototypes, Includes, Main scheduling code
@@ -452,7 +454,7 @@ schedule( void )
          m->stat = Success;
          broadcastCondition(&m->wakeup);
 #ifdef DEBUG
-         removeThreadLabel(m->tso);
+         removeThreadLabel((StgWord)m->tso);
 #endif
          break;
        case ThreadKilled:
@@ -465,7 +467,7 @@ schedule( void )
          }
          broadcastCondition(&m->wakeup);
 #ifdef DEBUG
-         removeThreadLabel(m->tso);
+         removeThreadLabel((StgWord)m->tso);
 #endif
          break;
        default:
@@ -1130,11 +1132,22 @@ schedule( void )
              }           
              cap->r.rCurrentNursery->u.back = bd;
 
-             // initialise it as a nursery block
-             bd->step = g0s0;
-             bd->gen_no = 0;
-             bd->flags = 0;
-             bd->free = bd->start;
+             // initialise it as a nursery block.  We initialise the
+             // step, gen_no, and flags field of *every* sub-block in
+             // this large block, because this is easier than making
+             // sure that we always find the block head of a large
+             // block whenever we call Bdescr() (eg. evacuate() and
+             // isAlive() in the GC would both have to do this, at
+             // least).
+             { 
+                 bdescr *x;
+                 for (x = bd; x < bd + blocks; x++) {
+                     x->step = g0s0;
+                     x->gen_no = 0;
+                     x->flags = 0;
+                     x->free = x->start;
+                 }
+             }
 
              // don't forget to update the block count in g0s0.
              g0s0->n_blocks += blocks;
@@ -1430,6 +1443,8 @@ StgInt forkProcess(StgTSO* tso) {
 #ifndef mingw32_TARGET_OS
   pid_t pid;
   StgTSO* t,*next;
+  StgMainThread *m;
+  rtsBool doKill;
 
   IF_DEBUG(scheduler,sched_belch("forking!"));
 
@@ -1440,16 +1455,45 @@ StgInt forkProcess(StgTSO* tso) {
     
   } else { /* child */
   /* wipe all other threads */
-  run_queue_hd = tso;
+  run_queue_hd = run_queue_tl = tso;
   tso->link = END_TSO_QUEUE;
 
+  /* When clearing out the threads, we need to ensure
+     that a 'main thread' is left behind; if there isn't,
+     the Scheduler will shutdown next time it is entered.
+     
+     ==> we don't kill a thread that's on the main_threads
+         list (nor the current thread.)
+    
+     [ Attempts at implementing the more ambitious scheme of
+       killing the main_threads also, and then adding the
+       current thread onto the main_threads list if it wasn't
+       there already, failed -- waitThread() (for one) wasn't
+       up to it. If it proves to be desirable to also kill
+       the main threads, then this scheme will have to be
+       revisited (and fully debugged!)
+       
+       -- sof 7/2002
+     ]
+  */
   /* DO NOT TOUCH THE QUEUES directly because most of the code around
-     us is picky about finding the threat still in its queue when
+     us is picky about finding the thread still in its queue when
      handling the deleteThread() */
 
   for (t = all_threads; t != END_TSO_QUEUE; t = next) {
     next = t->link;
-    if (t->id != tso->id) {
+    
+    /* Don't kill the current thread.. */
+    if (t->id == tso->id) continue;
+    doKill=rtsTrue;
+    /* ..or a main thread */
+    for (m = main_threads; m != NULL; m = m->link) {
+       if (m->tso->id == t->id) {
+         doKill=rtsFalse;
+         break;
+       }
+    }
+    if (doKill) {
       deleteThread(t);
     }
   }