[project @ 2002-12-02 14:33:10 by simonmar]

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

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 2e2bbec..17c7e74 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.151 2002/07/25 18:36:59 sof Exp $
+ * $Id: Schedule.c,v 1.157 2002/10/22 11:01:19 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -133,7 +133,7 @@
 /* Main thread queue.
  * Locks required: sched_mutex.
  */
-StgMainThread *main_threads;
+StgMainThread *main_threads = NULL;
 
 /* Thread queues.
  * Locks required: sched_mutex.
@@ -160,16 +160,18 @@ StgTSO *ccalling_threadss[MAX_PROC];
 
 #else /* !GRAN */
 
-StgTSO *run_queue_hd, *run_queue_tl;
-StgTSO *blocked_queue_hd, *blocked_queue_tl;
-StgTSO *sleeping_queue;                /* perhaps replace with a hash table? */
+StgTSO *run_queue_hd = NULL;
+StgTSO *run_queue_tl = NULL;
+StgTSO *blocked_queue_hd = NULL;
+StgTSO *blocked_queue_tl = NULL;
+StgTSO *sleeping_queue = NULL;    /* perhaps replace with a hash table? */
 
 #endif
 
 /* Linked list of all threads.
  * Used for detecting garbage collected threads.
  */
-StgTSO *all_threads;
+StgTSO *all_threads = NULL;
 
 /* When a thread performs a safe C call (_ccall_GC, using old
  * terminology), it gets put on the suspended_ccalling_threads
@@ -186,17 +188,17 @@ static StgTSO *threadStackOverflow(StgTSO *tso);
 
 /* flag set by signal handler to precipitate a context switch */
 //@cindex context_switch
-nat context_switch;
+nat context_switch = 0;
 
 /* if this flag is set as well, give up execution */
 //@cindex interrupted
-rtsBool interrupted;
+rtsBool interrupted = rtsFalse;
 
 /* Next thread ID to allocate.
  * Locks required: thread_id_mutex
  */
 //@cindex next_thread_id
-StgThreadID next_thread_id = 1;
+static StgThreadID next_thread_id = 1;
 
 /*
  * Pointers to the state of the current thread.
@@ -227,7 +229,7 @@ StgTSO *CurrentTSO;
  */
 StgTSO dummy_tso;
 
-rtsBool ready_to_gc;
+static rtsBool ready_to_gc;
 
 /*
  * Set to TRUE when entering a shutdown state (via shutdownHaskellAndExit()) --
@@ -275,21 +277,13 @@ rtsBool emitSchedule = rtsTrue;
 #endif
 
 #if DEBUG
-char *whatNext_strs[] = {
+static char *whatNext_strs[] = {
   "ThreadEnterGHC",
   "ThreadRunGHC",
   "ThreadEnterInterp",
   "ThreadKilled",
   "ThreadComplete"
 };
-
-char *threadReturnCode_strs[] = {
-  "HeapOverflow",                      /* might also be StackOverflow */
-  "StackOverflow",
-  "ThreadYielding",
-  "ThreadBlocked",
-  "ThreadFinished"
-};
 #endif
 
 #if defined(PAR)
@@ -1663,10 +1657,11 @@ static void unblockThread(StgTSO *tso);
  * instances of Eq/Ord for ThreadIds.
  * ------------------------------------------------------------------------ */
 
-int cmp_thread(const StgTSO *tso1, const StgTSO *tso2) 
+int
+cmp_thread(StgPtr tso1, StgPtr tso2) 
 { 
-  StgThreadID id1 = tso1->id; 
-  StgThreadID id2 = tso2->id;
+  StgThreadID id1 = ((StgTSO *)tso1)->id; 
+  StgThreadID id2 = ((StgTSO *)tso2)->id;
  
   if (id1 < id2) return (-1);
   if (id1 > id2) return 1;
@@ -1678,13 +1673,15 @@ int cmp_thread(const StgTSO *tso1, const StgTSO *tso2)
  *
  * This is used in the implementation of Show for ThreadIds.
  * ------------------------------------------------------------------------ */
-int rts_getThreadId(const StgTSO *tso) 
+int
+rts_getThreadId(StgPtr tso) 
 {
-  return tso->id;
+  return ((StgTSO *)tso)->id;
 }
 
 #ifdef DEBUG
-void labelThread(StgTSO *tso, char *label)
+void
+labelThread(StgPtr tso, char *label)
 {
   int len;
   void *buf;
@@ -2478,6 +2475,30 @@ GetRoots(evac_fn evac)
 #if defined(PAR) || defined(GRAN)
   markSparkQueue(evac);
 #endif
+
+#ifndef mingw32_TARGET_OS
+  // mark the signal handlers (signals should be already blocked)
+  markSignalHandlers(evac);
+#endif
+
+  // main threads which have completed need to be retained until they
+  // are dealt with in the main scheduler loop.  They won't be
+  // retained any other way: the GC will drop them from the
+  // all_threads list, so we have to be careful to treat them as roots
+  // here.
+  { 
+      StgMainThread *m;
+      for (m = main_threads; m != NULL; m = m->link) {
+         switch (m->tso->what_next) {
+         case ThreadComplete:
+         case ThreadKilled:
+             evac((StgClosure **)&m->tso);
+             break;
+         default:
+             break;
+         }
+      }
+  }
 }
 
 /* -----------------------------------------------------------------------------
@@ -2493,7 +2514,7 @@ GetRoots(evac_fn evac)
    This needs to be protected by the GC condition variable above.  KH.
    -------------------------------------------------------------------------- */
 
-void (*extra_roots)(evac_fn);
+static void (*extra_roots)(evac_fn);
 
 void
 performGC(void)
@@ -3264,7 +3285,6 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
   /* Remove it from any blocking queues */
   unblockThread(tso);
 
-  IF_DEBUG(scheduler, sched_belch("raising exception in thread %ld.", tso->id));
   /* The stack freezing code assumes there's a closure pointer on
    * the top of the stack.  This isn't always the case with compiled
    * code, so we have to push a dummy closure on the top which just
@@ -3279,6 +3299,8 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
     nat i;
     StgAP_UPD * ap;
 
+    ASSERT((P_)su > (P_)sp);
+    
     /* If we find a CATCH_FRAME, and we've got an exception to raise,
      * then build the THUNK raise(exception), and leave it on
      * top of the CATCH_FRAME ready to enter.
@@ -3326,8 +3348,6 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
      */
     ap = (StgAP_UPD *)allocate(AP_sizeW(words));
     
-    ASSERT(words >= 0);
-    
     ap->n_args = words;
     ap->fun    = (StgClosure *)sp[0];
     sp++;