[project @ 2000-03-16 17:27:12 by simonmar]

Raise an exception in any thread that is about to be garbage
collected.

	- threads blocked on MVars that are otherwise garbage
	  will receive a BlockedOnDeadMVar exception.

	- threads blocked on Black Holes must be in some kind
	  of deadlock, so we send them a NonTermination exception.

ghc/lib/std/PrelException.lhs

 % -----------------------------------------------------------------------------
-% $Id: PrelException.lhs,v 1.12 2000/03/13 10:54:49 simonmar Exp $
+% $Id: PrelException.lhs,v 1.13 2000/03/16 17:27:13 simonmar Exp $
 %
 % (c) The GRAP/AQUA Project, Glasgow University, 1998
 %
@@ -38,7 +38,8 @@ data Exception
   | AssertionFailed	String		-- Assertions
   | DynException	Dynamic		-- Dynamic exceptions
   | AsyncException	AsyncException	-- Externally generated errors
-  | PutFullMVar				-- Put on a full MVar
+  | PutFullMVar 			-- Put on a full MVar
+  | BlockedOnDeadMVar			-- Blocking on a dead MVar
   | NonTermination
 
 data ArithException
@@ -85,6 +86,7 @@ instance Show Exception where
   showsPrec _ (AsyncException e)	 = shows e
   showsPrec _ (DynException _err)        = showString "unknown exception"
   showsPrec _ (PutFullMVar)		 = showString "putMVar: full MVar"
+  showsPrec _ (BlockedOnDeadMVar)	 = showString "thread blocked indefinitely"
   showsPrec _ (NonTermination)           = showString "<<loop>>"
 
 -- Primitives:

ghc/rts/GC.c

 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.72 2000/01/22 18:00:03 simonmar Exp $
+ * $Id: GC.c,v 1.73 2000/03/16 17:27:12 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -42,6 +42,7 @@
 #include "SchedAPI.h"
 #include "Weak.h"
 #include "StablePriv.h"
+#include "Prelude.h"
 #if defined(GRAN) || defined(PAR)
 # include "GranSimRts.h"
 # include "ParallelRts.h"
@@ -108,11 +109,16 @@ static rtsBool major_gc;
  */
 static nat evac_gen;
 
-/* WEAK POINTERS
+/* Weak pointers
  */
 static StgWeak *old_weak_ptr_list; /* also pending finaliser list */
 static rtsBool weak_done;	/* all done for this pass */
 
+/* List of all threads during GC
+ */
+static StgTSO *old_all_threads;
+static StgTSO *resurrected_threads;
+
 /* Flag indicating failure to evacuate an object to the desired
  * generation.
  */
@@ -122,6 +128,7 @@ static rtsBool failed_to_evac;
  */
 bdescr *old_to_space;
 
+
 /* Data used for allocation area sizing.
  */
 lnat new_blocks;		/* blocks allocated during this GC */
@@ -386,6 +393,13 @@ void GarbageCollect(void (*get_roots)(void))
   weak_ptr_list = NULL;
   weak_done = rtsFalse;
 
+  /* The all_threads list is like the weak_ptr_list.  
+   * See traverse_weak_ptr_list() for the details.
+   */
+  old_all_threads = all_threads;
+  all_threads = END_TSO_QUEUE;
+  resurrected_threads = END_TSO_QUEUE;
+
   /* Mark the stable pointer table.
    */
   markStablePtrTable(major_gc);
@@ -718,6 +732,9 @@ void GarbageCollect(void (*get_roots)(void))
   /* start any pending finalizers */
   scheduleFinalizers(old_weak_ptr_list);
   
+  /* send exceptions to any threads which were about to die */
+  resurrectThreads(resurrected_threads);
+
   /* check sanity after GC */
   IF_DEBUG(sanity, checkSanity(N));
 
@@ -825,7 +842,45 @@ traverse_weak_ptr_list(void)
       continue;
     }
   }
-  
+
+  /* Now deal with the all_threads list, which behaves somewhat like
+   * the weak ptr list.  If we discover any threads that are about to
+   * become garbage, we wake them up and administer an exception.
+   */
+  {
+    StgTSO *t, *tmp, *next, **prev;
+
+    prev = &old_all_threads;
+    for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
+
+      /* Threads which have finished or died get dropped from
+       * the list.
+       */
+      switch (t->whatNext) {
+      case ThreadKilled:
+      case ThreadComplete:
+	next = t->global_link;
+	*prev = next;
+	continue;
+      default:
+      }
+
+      /* Threads which have already been determined to be alive are
+       * moved onto the all_threads list.
+       */
+      (StgClosure *)tmp = isAlive((StgClosure *)t);
+      if (tmp != NULL) {
+	next = tmp->global_link;
+	tmp->global_link = all_threads;
+	all_threads  = tmp;
+	*prev = next;
+      } else {
+	prev = &(t->global_link);
+	next = t->global_link;
+      }
+    }
+  }
+
   /* If we didn't make any changes, then we can go round and kill all
    * the dead weak pointers.  The old_weak_ptr list is used as a list
    * of pending finalizers later on.
@@ -835,6 +890,19 @@ traverse_weak_ptr_list(void)
     for (w = old_weak_ptr_list; w; w = w->link) {
       w->finalizer = evacuate(w->finalizer);
     }
+
+    /* And resurrect any threads which were about to become garbage.
+     */
+    {
+      StgTSO *t, *tmp, *next;
+      for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
+	next = t->global_link;
+	(StgClosure *)tmp = evacuate((StgClosure *)t);
+	tmp->global_link = resurrected_threads;
+	resurrected_threads = tmp;
+      }
+    }
+
     weak_done = rtsTrue;
   }
 
@@ -888,6 +956,7 @@ StgClosure *
 isAlive(StgClosure *p)
 {
   const StgInfoTable *info;
+  nat size;
 
   while (1) {
 
@@ -922,6 +991,33 @@ isAlive(StgClosure *p)
       /* alive! */
       return ((StgEvacuated *)p)->evacuee;
 
+    case BCO:
+      size = bco_sizeW((StgBCO*)p);
+      goto large;
+
+    case ARR_WORDS:
+      size = arr_words_sizeW((StgArrWords *)p);
+      goto large;
+
+    case MUT_ARR_PTRS:
+    case MUT_ARR_PTRS_FROZEN:
+      size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
+      goto large;
+
+    case TSO:
+      if (((StgTSO *)p)->whatNext == ThreadRelocated) {
+	p = (StgClosure *)((StgTSO *)p)->link;
+	continue;
+      }
+    
+      size = tso_sizeW((StgTSO *)p);
+    large:
+      if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)
+	  && Bdescr((P_)p)->evacuated)
+	return p;
+      else
+	return NULL;
+
     default:
       /* dead. */
       return NULL;
@@ -1339,15 +1435,15 @@ loop:
       case IND_PERM:
       case IND_OLDGEN:
       case IND_OLDGEN_PERM:
-	selectee = stgCast(StgInd *,selectee)->indirectee;
+	selectee = ((StgInd *)selectee)->indirectee;
 	goto selector_loop;
 
       case CAF_ENTERED:
-	selectee = stgCast(StgCAF *,selectee)->value;
+	selectee = ((StgCAF *)selectee)->value;
 	goto selector_loop;
 
       case EVACUATED:
-	selectee = stgCast(StgEvacuated*,selectee)->evacuee;
+	selectee = ((StgEvacuated *)selectee)->evacuee;
 	goto selector_loop;
 
       case THUNK:
@@ -1436,7 +1532,7 @@ loop:
   case PAP:
     /* these are special - the payload is a copy of a chunk of stack,
        tagging and all. */
-    return copy(q,pap_sizeW(stgCast(StgPAP*,q)),step);
+    return copy(q,pap_sizeW((StgPAP *)q),step);
 
   case EVACUATED:
     /* Already evacuated, just return the forwarding address.
@@ -1458,7 +1554,7 @@ loop:
 
   case ARR_WORDS:
     {
-      nat size = arr_words_sizeW(stgCast(StgArrWords*,q)); 
+      nat size = arr_words_sizeW((StgArrWords *)q); 
 
       if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
 	evacuate_large((P_)q, rtsFalse);
@@ -1472,7 +1568,7 @@ loop:
   case MUT_ARR_PTRS:
   case MUT_ARR_PTRS_FROZEN:
     {
-      nat size = mut_arr_ptrs_sizeW(stgCast(StgMutArrPtrs*,q)); 
+      nat size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)q); 
 
       if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
 	evacuate_large((P_)q, info->type == MUT_ARR_PTRS);
@@ -1639,7 +1735,7 @@ scavenge_srt(const StgInfoTable *info)
    * srt field in the info table.  That's ok, because we'll
    * never dereference it.
    */
-  srt = stgCast(StgClosure **,info->srt);
+  srt = (StgClosure **)(info->srt);
   srt_end = srt + info->srt_len;
   for (; srt < srt_end; srt++) {
     /* Special-case to handle references to closures hiding out in DLLs, since
@@ -1652,7 +1748,7 @@ scavenge_srt(const StgInfoTable *info)
        closure that's fixed at link-time, and no extra magic is required.
     */
 #ifdef ENABLE_WIN32_DLL_SUPPORT
-    if ( stgCast(unsigned long,*srt) & 0x1 ) {
+    if ( (unsigned long)(*srt) & 0x1 ) {
        evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)));
     } else {
        evacuate(*srt);
@@ -1740,7 +1836,7 @@ scavenge(step *step)
 
     case BCO:
       {
-	StgBCO* bco = stgCast(StgBCO*,p);
+	StgBCO* bco = (StgBCO *)p;
 	nat i;
 	for (i = 0; i < bco->n_ptrs; i++) {
 	  bcoConstCPtr(bco,i) = evacuate(bcoConstCPtr(bco,i));
@@ -1949,7 +2045,7 @@ scavenge(step *step)
        * evacuate the function pointer too...
        */
       { 
-	StgPAP* pap = stgCast(StgPAP*,p);
+	StgPAP* pap = (StgPAP *)p;
 
 	pap->fun = evacuate(pap->fun);
 	scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
@@ -1959,7 +2055,7 @@ scavenge(step *step)
       
     case ARR_WORDS:
       /* nothing to follow */
-      p += arr_words_sizeW(stgCast(StgArrWords*,p));
+      p += arr_words_sizeW((StgArrWords *)p);
       break;
 
     case MUT_ARR_PTRS:
@@ -2620,7 +2716,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
     if (! LOOKS_LIKE_GHC_INFO(q) ) {
 #ifdef DEBUG
       if ( 0 && LOOKS_LIKE_STATIC_CLOSURE(q) ) {  /* Is it a static closure? */
-	ASSERT(closure_STATIC(stgCast(StgClosure*,q)));
+	ASSERT(closure_STATIC((StgClosure *)q));
       }
       /* otherwise, must be a pointer into the allocation space. */
 #endif
@@ -2819,7 +2915,7 @@ scavenge_large(step *step)
     dbl_link_onto(bd, &step->scavenged_large_objects);
 
     p = bd->start;
-    info  = get_itbl(stgCast(StgClosure*,p));
+    info  = get_itbl((StgClosure *)p);
 
     switch (info->type) {
 
@@ -2860,7 +2956,7 @@ scavenge_large(step *step)
 
     case BCO:
       {
-	StgBCO* bco = stgCast(StgBCO*,p);
+	StgBCO* bco = (StgBCO *)p;
 	nat i;
 	evac_gen = saved_evac_gen;
 	for (i = 0; i < bco->n_ptrs; i++) {
@@ -2934,8 +3030,8 @@ void RevertCAFs(void)
     enteredCAFs = caf->link;
     ASSERT(get_itbl(caf)->type == CAF_ENTERED);
     SET_INFO(caf,&CAF_UNENTERED_info);
-    caf->value = stgCast(StgClosure*,0xdeadbeef);
-    caf->link  = stgCast(StgCAF*,0xdeadbeef);
+    caf->value = (StgClosure *)0xdeadbeef;
+    caf->link  = (StgCAF *)0xdeadbeef;
   }
   enteredCAFs = END_CAF_LIST;
 }
@@ -3044,7 +3140,7 @@ threadLazyBlackHole(StgTSO *tso)
     switch (get_itbl(update_frame)->type) {
 
     case CATCH_FRAME:
-      update_frame = stgCast(StgCatchFrame*,update_frame)->link;
+      update_frame = ((StgCatchFrame *)update_frame)->link;
       break;
 
     case UPDATE_FRAME:
@@ -3073,7 +3169,7 @@ threadLazyBlackHole(StgTSO *tso)
       break;
 
     case SEQ_FRAME:
-      update_frame = stgCast(StgSeqFrame*,update_frame)->link;
+      update_frame = ((StgSeqFrame *)update_frame)->link;
       break;
 
     case STOP_FRAME:

ghc/rts/Prelude.c

 
 /* -----------------------------------------------------------------------------
- * $Id: Prelude.c,v 1.2 2000/03/14 14:34:47 sewardj Exp $
+ * $Id: Prelude.c,v 1.3 2000/03/16 17:27:13 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -18,6 +18,7 @@ const StgClosure *ind_unpackCString_closure;
 const StgClosure *ind_stackOverflow_closure;
 const StgClosure *ind_heapOverflow_closure;
 const StgClosure *ind_PutFullMVar_static_closure;
+const StgClosure *ind_BlockedOnDeadMVar_static_closure;
 const StgClosure *ind_NonTermination_static_closure;
 const StgClosure *ind_mainIO_closure;
 
@@ -101,6 +102,7 @@ void fixupRTStoPreludeRefs ( void*(*ask_hugs_dynamic_linker)(char*) )
     ind_True_static_closure           = NULL; /* True_static_closure; */
     ind_False_static_closure          = NULL; /* False_static_closure; */
     ind_PutFullMVar_static_closure    = NULL; /* PutFullMVar_static_closure; */
+    ind_BlockedOnDeadMVar_static_closure = NULL; /* BlockedOnDeadMVar_static_closure; */
     ind_NonTermination_static_closure = NULL; /* NonTermination_static_closure; */
     ind_unpackCString_closure         = NULL; /* unpackCString_closure; */
 
@@ -135,6 +137,8 @@ void fixupRTStoPreludeRefs ( void*(*ask_hugs_dynamic_linker)(char*) )
        = ask("PrelBase_False_static_closure");
     ind_PutFullMVar_static_closure    
        = ask("PrelException_PutFullMVar_static_closure");
+    ind_BlockedOnDeadMVar_static_closure    
+       = ask("PrelException_BlockedOnDeadMVar_static_closure");
     ind_NonTermination_static_closure 
        = ask("PrelException_NonTermination_static_closure");
 

ghc/rts/Prelude.h

 /* -----------------------------------------------------------------------------
- * $Id: Prelude.h,v 1.4 2000/03/14 14:34:47 sewardj Exp $
+ * $Id: Prelude.h,v 1.5 2000/03/16 17:27:13 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -20,9 +20,11 @@ extern DLL_IMPORT const StgClosure PrelBase_False_static_closure;
 extern DLL_IMPORT const StgClosure PrelPack_unpackCString_closure;
 extern DLL_IMPORT const StgClosure PrelException_stackOverflow_closure;
 extern DLL_IMPORT const StgClosure PrelException_heapOverflow_closure;
+extern const StgClosure PrelMain_mainIO_closure;
+
 extern DLL_IMPORT const StgClosure PrelException_PutFullMVar_static_closure;
+extern DLL_IMPORT const StgClosure PrelException_BlockedOnDeadMVar_static_closure;
 extern DLL_IMPORT const StgClosure PrelException_NonTermination_static_closure;
-extern const StgClosure PrelMain_mainIO_closure;
 
 extern DLL_IMPORT const StgInfoTable PrelBase_Czh_static_info;
 extern DLL_IMPORT const StgInfoTable PrelBase_Izh_static_info;
@@ -46,6 +48,7 @@ extern DLL_IMPORT const StgInfoTable PrelStable_StablePtr_con_info;
 #define stackOverflow_closure  (&PrelException_stackOverflow_closure)
 #define heapOverflow_closure   (&PrelException_heapOverflow_closure)
 #define PutFullMVar_closure    (&PrelException_PutFullMVar_static_closure)
+#define BlockedOnDeadMVar_closure (&PrelException_BlockedOnDeadMVar_static_closure)
 #define NonTermination_closure (&PrelException_NonTermination_static_closure)
 #define Czh_static_info        (&PrelBase_Czh_static_info)
 #define Izh_static_info        (&PrelBase_Izh_static_info)
@@ -77,6 +80,7 @@ extern const StgClosure *ind_unpackCString_closure;
 extern const StgClosure *ind_stackOverflow_closure;
 extern const StgClosure *ind_heapOverflow_closure;
 extern const StgClosure *ind_PutFullMVar_static_closure;
+extern const StgClosure *ind_BlockedOnDeadMVar_static_closure;
 extern const StgClosure *ind_NonTermination_static_closure;
 
 extern const StgInfoTable *ind_Czh_static_info;
@@ -101,6 +105,7 @@ extern const StgInfoTable *ind_StablePtr_con_info;
 #define stackOverflow_closure  ind_stackOverflow_closure
 #define heapOverflow_closure   ind_heapOverflow_closure
 #define PutFullMVar_closure    ind_PutFullMVar_static_closure
+#define BlockedOnDeadMVar_closure ind_BlockedOnDeadMVar_static_closure
 #define NonTermination_closure ind_NonTermination_static_closure
 #define Czh_static_info        ind_Czh_static_info
 #define Izh_static_info        ind_Izh_static_info

ghc/rts/Schedule.c

 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.52 2000/03/14 09:55:05 simonmar Exp $
+ * $Id: Schedule.c,v 1.53 2000/03/16 17:27:13 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -121,7 +121,6 @@ static StgMainThread *main_threads;
 /* Thread queues.
  * Locks required: sched_mutex.
  */
-
 #if defined(GRAN)
 
 StgTSO* ActiveTSO = NULL; /* for assigning system costs; GranSim-Light only */
@@ -137,18 +136,19 @@ StgTSO* ActiveTSO = NULL; /* for assigning system costs; GranSim-Light only */
 StgTSO *run_queue_hds[MAX_PROC], *run_queue_tls[MAX_PROC];
 StgTSO *blocked_queue_hds[MAX_PROC], *blocked_queue_tls[MAX_PROC];
 StgTSO *ccalling_threadss[MAX_PROC];
+StgTSO *all_threadss[MAX_PROC];
 
 #else /* !GRAN */
 
-//@cindex run_queue_hd
-//@cindex run_queue_tl
-//@cindex blocked_queue_hd
-//@cindex blocked_queue_tl
 StgTSO *run_queue_hd, *run_queue_tl;
 StgTSO *blocked_queue_hd, *blocked_queue_tl;
 
+/* Linked list of all threads.
+ * Used for detecting garbage collected threads.
+ */
+StgTSO *all_threads;
+
 /* Threads suspended in _ccall_GC.
- * Locks required: sched_mutex.
  */
 static StgTSO *suspended_ccalling_threads;
 
@@ -312,6 +312,8 @@ schedule( void )
   while (1) {
 #endif
 
+    IF_DEBUG(scheduler, printAllThreads());
+
     /* If we're interrupted (the user pressed ^C, or some other
      * termination condition occurred), kill all the currently running
      * threads.
@@ -1022,12 +1024,11 @@ createThread_(nat size, rtsBool have_lock)
     size = MIN_STACK_WORDS + TSO_STRUCT_SIZEW;
   }
 
-  tso = (StgTSO *)allocate(size);
-  TICK_ALLOC_TSO(size-sizeofW(StgTSO),0);
-  
   stack_size = size - TSO_STRUCT_SIZEW;
 
-  // Hmm, this CCS_MAIN is not protected by a PROFILING cpp var;
+  tso = (StgTSO *)allocate(size);
+  TICK_ALLOC_TSO(size-TSO_STRUCT_SIZEW, 0);
+
   SET_HDR(tso, &TSO_info, CCS_MAIN);
 #if defined(GRAN)
   SET_GRAN_HDR(tso, ThisPE);
@@ -1035,10 +1036,9 @@ createThread_(nat size, rtsBool have_lock)
   tso->whatNext     = ThreadEnterGHC;
 
   /* tso->id needs to be unique.  For now we use a heavyweight mutex to
-  	 protect the increment operation on next_thread_id.
-  	 In future, we could use an atomic increment instead.
-  */
-  
+   * protect the increment operation on next_thread_id.
+   * In future, we could use an atomic increment instead.
+   */
   if (!have_lock) { ACQUIRE_LOCK(&sched_mutex); }
   tso->id = next_thread_id++; 
   if (!have_lock) { RELEASE_LOCK(&sched_mutex); }
@@ -1071,8 +1071,17 @@ createThread_(nat size, rtsBool have_lock)
   insertThread(tso, CurrentProc);
 #else
   /* In a non-GranSim setup the pushing of a TSO onto the runq is separated
-     from its creation
-  */
+   * from its creation
+   */
+#endif
+
+  /* Link the new thread on the global thread list.
+   */
+#if defined(GRAN)
+#error ToDo
+#else
+  tso->global_link = all_threads;
+  all_threads = tso;
 #endif
 
 #if defined(GRAN)
@@ -1215,6 +1224,7 @@ initScheduler(void)
   suspended_ccalling_threads  = END_TSO_QUEUE;
 
   main_threads = NULL;
+  all_threads  = END_TSO_QUEUE;
 
   context_switch = 0;
   interrupted    = 0;
@@ -2324,6 +2334,41 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
   barf("raiseAsync");
 }
 
+/* -----------------------------------------------------------------------------
+   resurrectThreads is called after garbage collection on the list of
+   threads found to be garbage.  Each of these threads will be woken
+   up and sent a signal: BlockedOnDeadMVar if the thread was blocked
+   on an MVar, or NonTermination if the thread was blocked on a Black
+   Hole.
+   -------------------------------------------------------------------------- */
+
+void
+resurrectThreads( StgTSO *threads )
+{
+  StgTSO *tso, *next;
+
+  for (tso = threads; tso != END_TSO_QUEUE; tso = next) {
+    next = tso->global_link;
+    tso->global_link = all_threads;
+    all_threads = tso;
+    IF_DEBUG(scheduler, sched_belch("resurrecting thread %d", tso->id));
+
+    switch (tso->why_blocked) {
+    case BlockedOnMVar:
+    case BlockedOnException:
+      raiseAsync(tso,(StgClosure *)BlockedOnDeadMVar_closure);
+      break;
+    case BlockedOnBlackHole:
+      raiseAsync(tso,(StgClosure *)NonTermination_closure);
+      break;
+    case NotBlocked:
+      barf("resurrectThreads: thread not blocked");
+    default:
+      barf("resurrectThreads: thread blocked in a strange way");
+    }
+  }
+}
+
 //@node Debugging Routines, Index, Exception Handling Routines, Main scheduling code
 //@subsection Debugging Routines
 
@@ -2333,7 +2378,8 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
 
 #ifdef DEBUG
 
-void printThreadBlockage(StgTSO *tso)
+void
+printThreadBlockage(StgTSO *tso)
 {
   switch (tso->why_blocked) {
   case BlockedOnRead:
@@ -2366,6 +2412,34 @@ void printThreadBlockage(StgTSO *tso)
   }
 }
 
+void
+printThreadStatus(StgTSO *tso)
+{
+  switch (tso->whatNext) {
+  case ThreadKilled:
+    fprintf(stderr,"has been killed");
+    break;
+  case ThreadComplete:
+    fprintf(stderr,"has completed");
+    break;
+  default:
+    printThreadBlockage(tso);
+  }
+}
+
+void
+printAllThreads(void)
+{
+  StgTSO *t;
+
+  sched_belch("all threads:");
+  for (t = all_threads; t != END_TSO_QUEUE; t = t->global_link) {
+    fprintf(stderr, "\tthread %d is ", t->id);
+    printThreadStatus(t);
+    fprintf(stderr,"\n");
+  }
+}
+    
 /* 
    Print a whole blocking queue attached to node (debugging only).
 */

ghc/rts/Schedule.h

 /* -----------------------------------------------------------------------------
- * $Id: Schedule.h,v 1.15 2000/01/14 14:06:48 hwloidl Exp $
+ * $Id: Schedule.h,v 1.16 2000/03/16 17:27:13 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -103,12 +103,6 @@ void    awaken_blocked_queue(StgTSO *q);
 void    initThread(StgTSO *tso, nat stack_size);
 #endif
 
-// debugging only
-#ifdef DEBUG
-extern void printThreadBlockage(StgTSO *tso);
-#endif
-void    print_bq (StgClosure *node);
-
 //@node Scheduler Vars and Data Types, Some convenient macros, Scheduler Functions
 //@subsection Scheduler Vars and Data Types
 
@@ -141,6 +135,7 @@ extern Capability MainRegTable;
  */
 extern  StgTSO *run_queue_hd, *run_queue_tl;
 extern  StgTSO *blocked_queue_hd, *blocked_queue_tl;
+extern  StgTSO *all_threads;
 
 #ifdef SMP
 //@cindex sched_mutex
@@ -178,9 +173,20 @@ void interruptStgRts ( void );
 void raiseAsync(StgTSO *tso, StgClosure *exception);
 nat  run_queue_len(void);
 
+void resurrectThreads( StgTSO * );
+
 //@node Some convenient macros, Index, Scheduler Vars and Data Types
 //@subsection Some convenient macros
 
+/* debugging only 
+ */
+#ifdef DEBUG
+void printThreadBlockage(StgTSO *tso);
+void printThreadStatus(StgTSO *tso);
+void printAllThreads(void);
+#endif
+void print_bq (StgClosure *node);
+
 /* -----------------------------------------------------------------------------
  * Some convenient macros...
  */