From: simonmar <unknown>
Date: Tue, 9 Nov 1999 15:47:09 +0000 (+0000)
Subject: [project @ 1999-11-09 15:46:49 by simonmar]
X-Git-Tag: Approximately_9120_patches~5584
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=30681e796f707fa109aaf756d4586049f595195d;p=ghc-hetmet.git

[project @ 1999-11-09 15:46:49 by simonmar]
A slew of SMP-related changes.

 - New locking scheme for thunks: we now check whether the thunk
   being entered is in our private allocation area, and if so
   we don't lock it.  Well, that's the upshot.  In practice it's
   a lot more fiddly than that.

 - I/O blocking is handled a bit more sanely now (but still not
   properly, methinks)

 - deadlock detection is back

 - remove old pre-SMP scheduler code

 - revamp the timing code.  We actually get reasonable-looking
   timing info for SMP programs now.

 - fix a bug in the garbage collector to do with IND_OLDGENs appearing
   on the mutable list of the old generation.

 - move BDescr() function from rts/BlockAlloc.h to includes/Block.h.

 - move struct generation and struct step into includes/StgStorage.h (sigh)

 - add UPD_IND_NOLOCK for updating with an indirection where locking
   the black hole is not required.
---

diff --git a/ghc/includes/Block.h b/ghc/includes/Block.h
index c665583..f6a695c 100644
--- a/ghc/includes/Block.h
+++ b/ghc/includes/Block.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Block.h,v 1.5 1999/03/02 19:44:07 sof Exp $
+ * $Id: Block.h,v 1.6 1999/11/09 15:47:07 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -66,6 +66,16 @@ typedef struct _bdescr {
 #define BDESCR_SHIFT 5
 #endif
 
+/* Finding the block descriptor for a given block -------------------------- */
+
+static inline bdescr *Bdescr(StgPtr p)
+{
+  return (bdescr *)
+    ((((W_)p &  MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT)) 
+     | ((W_)p & ~MBLOCK_MASK)
+     );
+}
+
 /* Useful Macros ------------------------------------------------------------ */
 
 /* Offset of first real data block in a megablock */
diff --git a/ghc/includes/Regs.h b/ghc/includes/Regs.h
index e7a9213..0cb2eb2 100644
--- a/ghc/includes/Regs.h
+++ b/ghc/includes/Regs.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Regs.h,v 1.5 1999/11/02 15:05:51 simonmar Exp $
+ * $Id: Regs.h,v 1.6 1999/11/09 15:47:08 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -49,8 +49,8 @@ typedef struct StgRegTable_ {
   StgPtr 	  rHp;
   StgPtr 	  rHpLim;
   StgTSO         *rCurrentTSO;
-  bdescr         *rNursery;
-  bdescr         *rCurrentNursery;
+  struct _bdescr *rNursery;
+  struct _bdescr *rCurrentNursery;
 #ifdef SMP
   struct StgRegTable_ *link;
 #endif
diff --git a/ghc/includes/Rts.h b/ghc/includes/Rts.h
index dd23388..4d68169 100644
--- a/ghc/includes/Rts.h
+++ b/ghc/includes/Rts.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Rts.h,v 1.8 1999/11/02 15:05:52 simonmar Exp $
+ * $Id: Rts.h,v 1.9 1999/11/09 15:47:08 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -11,7 +11,7 @@
 #define RTS_H
 
 #ifndef IN_STG_CODE
-#define NOT_IN_STG_CODE
+#define IN_STG_CODE 0
 #endif
 #include "Stg.h"
 
diff --git a/ghc/includes/Stg.h b/ghc/includes/Stg.h
index 19c3711..f860a6e 100644
--- a/ghc/includes/Stg.h
+++ b/ghc/includes/Stg.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Stg.h,v 1.19 1999/11/05 12:28:05 simonmar Exp $
+ * $Id: Stg.h,v 1.20 1999/11/09 15:47:08 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -21,12 +21,12 @@
  * with that.  If "Stg.h" is included via "Rts.h", we're assumed to
  * be in vanilla C.
  */
-#ifdef NOT_IN_STG_CODE
+#if ! IN_STG_CODE
 # ifndef NO_REGS
 #  define NO_REGS			/* don't define fixed registers */
 # endif
 #else
-# define IN_STG_CODE
+# define IN_STG_CODE 1
 #endif
 
 /* Configuration */
@@ -113,13 +113,13 @@ void _stgAssert (char *, unsigned int);
 #include "ClosureTypes.h"
 #include "InfoTables.h"
 #include "TSO.h"
-#include "Block.h"
 
 /* STG/Optimised-C related stuff */
 #include "SMP.h"
 #include "MachRegs.h"
 #include "Regs.h"
 #include "TailCalls.h"
+#include "Block.h"
 
 /* RTS public interface */
 #include "RtsAPI.h"
diff --git a/ghc/includes/StgMacros.h b/ghc/includes/StgMacros.h
index 8ca1f91..aa3dbf0 100644
--- a/ghc/includes/StgMacros.h
+++ b/ghc/includes/StgMacros.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMacros.h,v 1.16 1999/11/05 12:28:05 simonmar Exp $
+ * $Id: StgMacros.h,v 1.17 1999/11/09 15:47:09 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -418,13 +418,33 @@ EDI_(stg_gen_chk_info);
 
 #ifdef EAGER_BLACKHOLING
 #  ifdef SMP
-#    define UPD_BH_UPDATABLE(info)		\
-        TICK_UPD_BH_UPDATABLE();		\
-        LOCK_THUNK(info);			\
+#    define UPD_BH_UPDATABLE(info)				\
+        TICK_UPD_BH_UPDATABLE();				\
+        { 							\
+	  bdescr *bd = Bdescr(R1.p);				\
+          if (bd->back != (bdescr *)BaseReg) {			\
+             if (bd->gen->no >= 1 || bd->step->no >= 1) {	\
+        	 LOCK_THUNK(info);				\
+             } else {						\
+	         EXTFUN_RTS(stg_gc_enter_1_hponly);		\
+        	 JMP_(stg_gc_enter_1_hponly);			\
+             }							\
+          }							\
+	}							\
         SET_INFO(R1.cl,&BLACKHOLE_info)
-#    define UPD_BH_SINGLE_ENTRY(info)		\
-        TICK_UPD_BH_SINGLE_ENTRY();		\
-        LOCK_THUNK(info);			\
+#    define UPD_BH_SINGLE_ENTRY(info)				\
+        TICK_UPD_BH_SINGLE_ENTRY();				\
+        {							\
+	  bdescr *bd = Bdescr(R1.p);				\
+          if (bd->back != (bdescr *)BaseReg) {			\
+             if (bd->gen->no >= 1 || bd->step->no >= 1) {	\
+        	 LOCK_THUNK(info);				\
+             } else {						\
+	         EXTFUN_RTS(stg_gc_enter_1_hponly);		\
+        	 JMP_(stg_gc_enter_1_hponly);			\
+             }							\
+          }							\
+	}							\
         SET_INFO(R1.cl,&BLACKHOLE_info)
 #  else
 #    define UPD_BH_UPDATABLE(info)		\
diff --git a/ghc/includes/StgStorage.h b/ghc/includes/StgStorage.h
index 6c9b0d3..86dd60b 100644
--- a/ghc/includes/StgStorage.h
+++ b/ghc/includes/StgStorage.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgStorage.h,v 1.5 1999/11/02 15:05:53 simonmar Exp $
+ * $Id: StgStorage.h,v 1.6 1999/11/09 15:47:09 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -10,6 +10,79 @@
 #ifndef STGSTORAGE_H
 #define STGSTORAGE_H
 
+/* GENERATION GC NOTES
+ *
+ * We support an arbitrary number of generations, with an arbitrary number
+ * of steps per generation.  Notes (in no particular order):
+ *
+ *       - all generations except the oldest should have two steps.  This gives
+ *         objects a decent chance to age before being promoted, and in
+ *         particular will ensure that we don't end up with too many
+ *         thunks being updated in older generations.
+ *
+ *       - the oldest generation has one step.  There's no point in aging
+ *         objects in the oldest generation.
+ *
+ *       - generation 0, step 0 (G0S0) is the allocation area.  It is given
+ *         a fixed set of blocks during initialisation, and these blocks
+ *         are never freed.
+ *
+ *       - during garbage collection, each step which is an evacuation
+ *         destination (i.e. all steps except G0S0) is allocated a to-space.
+ *         evacuated objects are allocated into the step's to-space until
+ *         GC is finished, when the original step's contents may be freed
+ *         and replaced by the to-space.
+ *
+ *       - the mutable-list is per-generation (not per-step).  G0 doesn't 
+ *         have one (since every garbage collection collects at least G0).
+ * 
+ *       - block descriptors contain pointers to both the step and the
+ *         generation that the block belongs to, for convenience.
+ *
+ *       - static objects are stored in per-generation lists.  See GC.c for
+ *         details of how we collect CAFs in the generational scheme.
+ *
+ *       - large objects are per-step, and are promoted in the same way
+ *         as small objects, except that we may allocate large objects into
+ *         generation 1 initially.
+ */
+
+typedef struct _step {
+  unsigned int no;		/* step number */
+  bdescr *blocks;		/* blocks in this step */
+  unsigned int n_blocks;	/* number of blocks */
+  struct _step *to;		/* where collected objects from this step go */
+  struct _generation *gen;	/* generation this step belongs to */
+  bdescr *large_objects;	/* large objects (doubly linked) */
+
+  /* temporary use during GC: */
+  StgPtr  hp;			/* next free locn in to-space */
+  StgPtr  hpLim;		/* end of current to-space block */
+  bdescr *hp_bd;		/* bdescr of current to-space block */
+  bdescr *to_space;		/* bdescr of first to-space block */
+  unsigned int to_blocks;		/* number of blocks in to-space */
+  bdescr *scan_bd;		/* block currently being scanned */
+  StgPtr  scan;			/* scan pointer in current block */
+  bdescr *new_large_objects;    /* large objects collected so far */
+  bdescr *scavenged_large_objects; /* live large objects after GC (dbl link) */
+} step;
+
+typedef struct _generation {
+  unsigned int no;		/* generation number */
+  step *steps;			/* steps */
+  unsigned int n_steps;		/* number of steps */
+  unsigned int max_blocks;	/* max blocks in step 0 */
+  StgMutClosure *mut_list;      /* mutable objects in this generation (not G0)*/
+  StgMutClosure *mut_once_list; /* objects that point to younger generations */
+
+  /* temporary use during GC: */
+  StgMutClosure *saved_mut_list;
+
+  /* stats information */
+  unsigned int collections;
+  unsigned int failed_promotions;
+} generation;
+
 /* -----------------------------------------------------------------------------
    Allocation area for compiled code
 
diff --git a/ghc/includes/Updates.h b/ghc/includes/Updates.h
index cf8eabc..d814c10 100644
--- a/ghc/includes/Updates.h
+++ b/ghc/includes/Updates.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Updates.h,v 1.14 1999/11/02 15:05:53 simonmar Exp $
+ * $Id: Updates.h,v 1.15 1999/11/09 15:47:09 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -36,30 +36,55 @@
    if you *really* need an IND use UPD_REAL_IND
  */
 #ifdef SMP
+#define UPD_REAL_IND(updclosure, heapptr)				\
+   {									\
+	const StgInfoTable *info;					\
+	if (Bdescr((P_)updclosure)->back != (bdescr *)BaseReg) {	\
+		info = LOCK_CLOSURE(updclosure);			\
+	} else {							\
+		info = updclosure->header.info;				\
+	}								\
+        AWAKEN_BQ(info,updclosure);					\
+	updateWithIndirection(info,					\
+			      (StgClosure *)updclosure,			\
+			      (StgClosure *)heapptr);			\
+   }
+#else
 #define UPD_REAL_IND(updclosure, heapptr)		\
    {							\
 	const StgInfoTable *info;			\
-	info = LOCK_CLOSURE(updclosure);		\
-							\
-     	if (info == &BLACKHOLE_BQ_info) {				\
-	   STGCALL1(awakenBlockedQueue, 				\
-		    ((StgBlockingQueue *)updclosure)->blocking_queue); 	\
-	}						\
-	updateWithIndirection((StgClosure *)updclosure,         \
-			      (StgClosure *)heapptr);		\
+	info = ((StgClosure *)updclosure)->header.info;	\
+        AWAKEN_BQ(info,updclosure);			\
+	updateWithIndirection(info,			\
+			      (StgClosure *)updclosure,	\
+			      (StgClosure *)heapptr);	\
    }
-#else
-#define UPD_REAL_IND(updclosure, heapptr)		\
-        AWAKEN_BQ(updclosure);				\
-	updateWithIndirection((StgClosure *)updclosure,	\
-			      (StgClosure *)heapptr);
 #endif
 
 #if defined(PROFILING) || defined(TICKY_TICKY)
-#define UPD_PERM_IND(updclosure, heapptr)                       \
-        AWAKEN_BQ(updclosure);                                  \
-	updateWithPermIndirection((StgClosure *)updclosure,     \
-			          (StgClosure *)heapptr);
+#define UPD_PERM_IND(updclosure, heapptr)			\
+   {								\
+	const StgInfoTable *info;				\
+	info = ((StgClosure *)updclosure)->header.info;		\
+        AWAKEN_BQ(info,updclosure);				\
+	updateWithPermIndirection(info,				\
+				  (StgClosure *)updclosure,	\
+				  (StgClosure *)heapptr);	\
+   }
+#endif
+
+#ifdef SMP
+#define UPD_IND_NOLOCK(updclosure, heapptr)				\
+   {									\
+	const StgInfoTable *info;					\
+	info = updclosure->header.info;					\
+        AWAKEN_BQ(info,updclosure);					\
+	updateWithIndirection(info,					\
+			      (StgClosure *)updclosure,			\
+			      (StgClosure *)heapptr);			\
+   }
+#else
+#define UPD_IND_NOLOCK(updclosure,heapptr) UPD_IND(updclosure,heapptr)
 #endif
 
 /* -----------------------------------------------------------------------------
@@ -68,10 +93,10 @@
 
 extern void awakenBlockedQueue(StgTSO *q);
 
-#define AWAKEN_BQ(closure)						 \
-     	if (closure->header.info == &BLACKHOLE_BQ_info) {		 \
-		STGCALL1(awakenBlockedQueue, 				 \
-			 ((StgBlockingQueue *)closure)->blocking_queue); \
+#define AWAKEN_BQ(info,closure)						\
+     	if (info == &BLACKHOLE_BQ_info) {				\
+	     STGCALL1(awakenBlockedQueue,				\
+		      ((StgBlockingQueue *)closure)->blocking_queue);	\
 	}
 
 
diff --git a/ghc/rts/BlockAlloc.h b/ghc/rts/BlockAlloc.h
index 833beee..bb6e63f 100644
--- a/ghc/rts/BlockAlloc.h
+++ b/ghc/rts/BlockAlloc.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: BlockAlloc.h,v 1.7 1999/11/02 17:08:28 simonmar Exp $
+ * $Id: BlockAlloc.h,v 1.8 1999/11/09 15:46:49 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -24,16 +24,6 @@ extern bdescr *allocBlock(void);
 extern void freeGroup(bdescr *p);
 extern void freeChain(bdescr *p);
 
-/* Finding the block descriptor for a given block -------------------------- */
-
-static inline bdescr *Bdescr(StgPtr p)
-{
-  return (bdescr *)
-    ((((W_)p &  MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT)) 
-     | ((W_)p & ~MBLOCK_MASK)
-     );
-}
-
 /* Round a value to megablocks --------------------------------------------- */
 
 #define WORDS_PER_MBLOCK  (BLOCKS_PER_MBLOCK * BLOCK_SIZE_W)
diff --git a/ghc/rts/ClosureFlags.c b/ghc/rts/ClosureFlags.c
index 439e1b7..17b6892 100644
--- a/ghc/rts/ClosureFlags.c
+++ b/ghc/rts/ClosureFlags.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: ClosureFlags.c,v 1.3 1999/11/02 15:05:56 simonmar Exp $
+ * $Id: ClosureFlags.c,v 1.4 1999/11/09 15:46:49 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -54,7 +54,7 @@ StgWord16 closure_flags[] = {
 /* IND_STATIC	   	*/ (              _STA                   ),
 /* CAF_UNENTERED        */ ( 0                                   ),
 /* CAF_ENTERED          */ ( 0                                   ),
-/* BLACKHOLE_BQ	   	*/ ( 	 _BTM|_NS|         _MUT|_UPT     ),
+/* CAF_BLACKHOLE   	*/ ( 	 _BTM|_NS|         _MUT|_UPT     ),
 /* RET_BCO		*/ (     _BTM                            ),
 /* RET_SMALL		*/ (     _BTM|                       _SRT),
 /* RET_VEC_SMALL	*/ (     _BTM|                       _SRT),
@@ -65,7 +65,7 @@ StgWord16 closure_flags[] = {
 /* CATCH_FRAME	   	*/ (     _BTM                            ),
 /* STOP_FRAME	   	*/ (     _BTM                            ),
 /* SEQ_FRAME 	   	*/ (     _BTM                            ),
-/* BLACKHOLE		*/ ( 	      _NS|              _UPT     ),
+/* BLACKHOLE		*/ ( 	      _NS|         _MUT|_UPT     ),
 /* BLACKHOLE_BQ	   	*/ ( 	      _NS|         _MUT|_UPT     ),
 /* SE_BLACKHOLE		*/ ( 	      _NS|              _UPT     ),
 /* SE_CAF_BLACKHOLE	*/ ( 	      _NS|              _UPT     ),
diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 02daeec..a5dc85d 100644
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.65 1999/11/02 15:05:56 simonmar Exp $
+ * $Id: GC.c,v 1.66 1999/11/09 15:46:49 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -2204,9 +2204,30 @@ scavenge_mutable_list(generation *gen)
 	continue;
       }
 
+      /* Happens if a BLACKHOLE_BQ in the old generation is updated: 
+       */
+    case IND_OLDGEN:
+    case IND_OLDGEN_PERM:
+      /* Try to pull the indirectee into this generation, so we can
+       * remove the indirection from the mutable list.  
+       */
+      evac_gen = gen->no;
+      ((StgIndOldGen *)p)->indirectee = 
+        evacuate(((StgIndOldGen *)p)->indirectee);
+      evac_gen = 0;
+
+      if (failed_to_evac) {
+	failed_to_evac = rtsFalse;
+	p->mut_link = gen->mut_once_list;
+	gen->mut_once_list = p;
+      } else {
+	p->mut_link = NULL;
+      }
+      continue;
+
     default:
       /* shouldn't have anything else on the mutables list */
-      barf("scavenge_mut_list: strange object? %d", (int)(info->type));
+      barf("scavenge_mutable_list: strange object? %d", (int)(info->type));
     }
   }
 }
@@ -2894,7 +2915,7 @@ threadSqueezeStack(StgTSO *tso)
        * sorted out?  oh yes: we aren't counting each enter properly
        * in this case.  See the log somewhere.  KSW 1999-04-21
        */
-      UPD_IND(updatee_bypass, updatee_keep); /* this wakes the threads up */
+      UPD_IND_NOLOCK(updatee_bypass, updatee_keep); /* this wakes the threads up */
       
       sp = (P_)frame - 1;	/* sp = stuff to slide */
       displacement += sizeofW(StgUpdateFrame);
diff --git a/ghc/rts/HeapStackCheck.hc b/ghc/rts/HeapStackCheck.hc
index 8f66e92..fc29ba7 100644
--- a/ghc/rts/HeapStackCheck.hc
+++ b/ghc/rts/HeapStackCheck.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: HeapStackCheck.hc,v 1.9 1999/08/25 16:11:48 simonmar Exp $
+ * $Id: HeapStackCheck.hc,v 1.10 1999/11/09 15:46:51 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -159,6 +159,18 @@ EXTFUN(stg_gc_enter_1)
   FE_
 }
 
+EXTFUN(stg_gc_enter_1_hponly)
+{
+  FB_
+  Sp -= 1;
+  Sp[0] = R1.w;
+  R1.i = HeapOverflow;
+  SaveThreadState();
+  CurrentTSO->whatNext = ThreadEnterGHC;
+  JMP_(StgReturn);
+  FE_
+}
+
 /*- 2 Regs--------------------------------------------------------------------*/
 
 EXTFUN(stg_gc_enter_2)
diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index 72a9584..39b4a74 100644
--- a/ghc/rts/PrimOps.hc
+++ b/ghc/rts/PrimOps.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.33 1999/11/02 15:05:58 simonmar Exp $
+ * $Id: PrimOps.hc,v 1.34 1999/11/09 15:46:53 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -1028,13 +1028,15 @@ FN_(delayzh_fast)
     ASSERT(CurrentTSO->why_blocked == NotBlocked);
     CurrentTSO->why_blocked = BlockedOnDelay;
 
+    ACQUIRE_LOCK(&sched_mutex);
+
     /* Add on ticks_since_select, since these will be subtracted at
      * the next awaitEvent call.
      */
     CurrentTSO->block_info.delay = R1.i + ticks_since_select;
 
-    ACQUIRE_LOCK(&sched_mutex);
     APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
+
     RELEASE_LOCK(&sched_mutex);
     JMP_(stg_block_noregs);
   FE_
diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index e614ae7..1c55585 100644
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.30 1999/11/08 15:30:39 sewardj Exp $
+ * $Id: Schedule.c,v 1.31 1999/11/09 15:46:54 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -87,10 +87,6 @@ StgTSO *blocked_queue_hd, *blocked_queue_tl;
  */
 static StgTSO *suspended_ccalling_threads;
 
-#ifndef SMP
-static rtsBool in_ccall_gc;
-#endif
-
 static void GetRoots(void);
 static StgTSO *threadStackOverflow(StgTSO *tso);
 
@@ -192,12 +188,19 @@ schedule( void )
 
   while (1) {
 
-    /* Check whether any waiting threads need to be woken up.
-     * If the run queue is empty, we can wait indefinitely for
-     * something to happen.
+    /* Check whether any waiting threads need to be woken up.  If the
+     * run queue is empty, and there are no other tasks running, we
+     * can wait indefinitely for something to happen.
+     * ToDo: what if another client comes along & requests another
+     * main thread?
      */
     if (blocked_queue_hd != END_TSO_QUEUE) {
-      awaitEvent(run_queue_hd == END_TSO_QUEUE);
+      awaitEvent(
+	   (run_queue_hd == END_TSO_QUEUE)
+#ifdef SMP
+	&& (n_free_capabilities == RtsFlags.ConcFlags.nNodes)
+#endif
+	);
     }
     
     /* check for signals each time around the scheduler */
@@ -207,6 +210,35 @@ schedule( void )
     }
 #endif
 
+    /* Detect deadlock: when we have no threads to run, there are
+     * no threads waiting on I/O or sleeping, and all the other
+     * tasks are waiting for work, we must have a deadlock.  Inform
+     * all the main threads.
+     */
+#ifdef SMP
+    if (blocked_queue_hd == END_TSO_QUEUE
+	&& run_queue_hd == END_TSO_QUEUE
+	&& (n_free_capabilities == RtsFlags.ConcFlags.nNodes)
+	) {
+      StgMainThread *m;
+      for (m = main_threads; m != NULL; m = m->link) {
+	  m->ret = NULL;
+	  m->stat = Deadlock;
+	  pthread_cond_broadcast(&m->wakeup);
+      }
+      main_threads = NULL;
+    }
+#else /* ! SMP */
+    if (blocked_queue_hd == END_TSO_QUEUE
+	&& run_queue_hd == END_TSO_QUEUE) {
+      StgMainThread *m = main_threads;
+      m->ret = NULL;
+      m->stat = Deadlock;
+      main_threads = m->link;
+      return;
+    }
+#endif
+
 #ifdef SMP
     /* If there's a GC pending, don't do anything until it has
      * completed.
@@ -249,11 +281,11 @@ schedule( void )
     
     /* set the context_switch flag
      */
-    if (run_queue_hd == END_TSO_QUEUE) 
+    if (run_queue_hd == END_TSO_QUEUE)
       context_switch = 0;
     else
       context_switch = 1;
-    
+
     RELEASE_LOCK(&sched_mutex);
     
 #ifdef SMP
@@ -711,17 +743,7 @@ taskStart( void *arg STG_UNUSED )
 static void
 term_handler(int sig STG_UNUSED)
 {
-  nat i;
-  pthread_t me = pthread_self();
-
-  for (i = 0; i < RtsFlags.ConcFlags.nNodes; i++) {
-    if (task_ids[i].id == me) {
-      task_ids[i].mut_time = usertime() - task_ids[i].gc_time;
-      if (task_ids[i].mut_time < 0.0) {
-	task_ids[i].mut_time = 0.0;
-      }
-    }
-  }
+  stat_workerStop();
   ACQUIRE_LOCK(&term_mutex);
   await_death--;
   RELEASE_LOCK(&term_mutex);
@@ -798,6 +820,11 @@ startTasks( void )
       barf("startTasks: Can't create new Posix thread");
     }
     task_ids[i].id = tid;
+    task_ids[i].mut_time = 0.0;
+    task_ids[i].mut_etime = 0.0;
+    task_ids[i].gc_time = 0.0;
+    task_ids[i].gc_etime = 0.0;
+    task_ids[i].elapsedtimestart = elapsedtime();
     IF_DEBUG(scheduler,fprintf(stderr,"schedule: Started task: %ld\n",tid););
   }
 }
@@ -884,14 +911,19 @@ waitThread(StgTSO *tso, /*out*/StgClosure **ret)
   m->link = main_threads;
   main_threads = m;
 
+  IF_DEBUG(scheduler, fprintf(stderr, "schedule: new main thread (%d)\n", 
+			      m->tso->id));
+
 #ifdef SMP
-  pthread_cond_wait(&m->wakeup, &sched_mutex);
+  do {
+    pthread_cond_wait(&m->wakeup, &sched_mutex);
+  } while (m->stat == NoStatus);
 #else
   schedule();
+  ASSERT(m->stat != NoStatus);
 #endif
 
   stat = m->stat;
-  ASSERT(stat != NoStatus);
 
 #ifdef SMP
   pthread_cond_destroy(&m->wakeup);
@@ -902,253 +934,6 @@ waitThread(StgTSO *tso, /*out*/StgClosure **ret)
   return stat;
 }
   
-
-#if 0
-SchedulerStatus schedule(StgTSO *main, StgClosure **ret_val)
-{
-  StgTSO *t;
-  StgThreadReturnCode ret;
-  StgTSO **MainTSO;
-  rtsBool in_ccall_gc;
-
-  /* Return value is NULL by default, it is only filled in if the
-   * main thread completes successfully.
-   */
-  if (ret_val) { *ret_val = NULL; }
-
-  /* Save away a pointer to the main thread so that we can keep track
-   * of it should a garbage collection happen.  We keep a stack of
-   * main threads in order to support scheduler re-entry.  We can't
-   * use the normal TSO linkage for this stack, because the main TSO
-   * may need to be linked onto other queues.
-   */
-  main_threads[next_main_thread] = main;
-  MainTSO = &main_threads[next_main_thread];
-  next_main_thread++;
-  IF_DEBUG(scheduler,
-	   fprintf(stderr, "Scheduler entered: nesting = %d\n", 
-		   next_main_thread););
-
-  /* Are we being re-entered? 
-   */
-  if (CurrentTSO != NULL) {
-    /* This happens when a _ccall_gc from Haskell ends up re-entering
-     * the scheduler.
-     *
-     * Block the current thread (put it on the ccalling_queue) and
-     * continue executing.  The calling thread better have stashed
-     * away its state properly and left its stack with a proper stack
-     * frame on the top.
-     */
-    threadPaused(CurrentTSO);
-    CurrentTSO->link = ccalling_threads;
-    ccalling_threads = CurrentTSO;
-    in_ccall_gc = rtsTrue;
-    IF_DEBUG(scheduler,
-	     fprintf(stderr, "Re-entry, thread %d did a _ccall_gc\n", 
-		     CurrentTSO->id););
-  } else {
-    in_ccall_gc = rtsFalse;
-  }
-
-  /* Take a thread from the run queue.
-   */
-  t = POP_RUN_QUEUE();
-
-  while (t != END_TSO_QUEUE) {
-    CurrentTSO = t;
-
-    /* If we have more threads on the run queue, set up a context
-     * switch at some point in the future.
-     */
-    if (run_queue_hd != END_TSO_QUEUE || blocked_queue_hd != END_TSO_QUEUE) {
-      context_switch = 1;
-    } else {
-      context_switch = 0;
-    }
-    IF_DEBUG(scheduler, belch("Running thread %ld...\n", t->id));
-
-    /* Be friendly to the storage manager: we're about to *run* this
-     * thread, so we better make sure the TSO is mutable.
-     */
-    if (t->mut_link == NULL) {
-      recordMutable((StgMutClosure *)t);
-    }
-
-    /* Run the current thread */
-    switch (t->whatNext) {
-    case ThreadKilled:
-    case ThreadComplete:
-      /* thread already killed.  Drop it and carry on. */
-      goto next_thread;
-    case ThreadEnterGHC:
-      ret = StgRun((StgFunPtr) stg_enterStackTop);
-      break;
-    case ThreadRunGHC:
-      ret = StgRun((StgFunPtr) stg_returnToStackTop);
-      break;
-    case ThreadEnterHugs:
-#ifdef INTERPRETER
-      {  
-	  IF_DEBUG(scheduler,belch("entering Hugs"));	  
-	  LoadThreadState();
-	  /* CHECK_SENSIBLE_REGS(); */
-	  {
-	      StgClosure* c = (StgClosure *)Sp[0];
-	      Sp += 1;
-	      ret = enter(c);
-	  }	
-	  SaveThreadState();
-	  break;
-      }
-#else
-      barf("Panic: entered a BCO but no bytecode interpreter in this build");
-#endif
-    default:
-      barf("schedule: invalid whatNext field");
-    }
-
-    /* We may have garbage collected while running the thread
-     * (eg. something nefarious like _ccall_GC_ performGC), and hence
-     * CurrentTSO may have moved.  Update t to reflect this.
-     */
-    t = CurrentTSO;
-    CurrentTSO = NULL;
-
-    /* Costs for the scheduler are assigned to CCS_SYSTEM */
-#ifdef PROFILING
-    CCCS = CCS_SYSTEM;
-#endif
-
-    switch (ret) {
-
-    case HeapOverflow:
-      IF_DEBUG(scheduler,belch("Thread %ld stopped: HeapOverflow\n", t->id));
-      threadPaused(t);
-      PUSH_ON_RUN_QUEUE(t);
-      GarbageCollect(GetRoots);
-      break;
-
-    case StackOverflow:
-      IF_DEBUG(scheduler,belch("Thread %ld stopped, StackOverflow\n", t->id));
-      { 
-	nat i;
-	/* enlarge the stack */
-	StgTSO *new_t = threadStackOverflow(t);
-	
-	/* This TSO has moved, so update any pointers to it from the
-	 * main thread stack.  It better not be on any other queues...
-	 * (it shouldn't be)
-	 */
-	for (i = 0; i < next_main_thread; i++) {
-	  if (main_threads[i] == t) {
-	    main_threads[i] = new_t;
-	  }
-	}
-	t = new_t;
-      }
-      PUSH_ON_RUN_QUEUE(t);
-      break;
-
-    case ThreadYielding:
-      IF_DEBUG(scheduler,
-               if (t->whatNext == ThreadEnterHugs) {
-		   /* ToDo: or maybe a timer expired when we were in Hugs?
-		    * or maybe someone hit ctrl-C
-                    */
-                   belch("Thread %ld stopped to switch to Hugs\n", t->id);
-               } else {
-                   belch("Thread %ld stopped, timer expired\n", t->id);
-               }
-               );
-      threadPaused(t);
-      if (interrupted) {
-          IF_DEBUG(scheduler,belch("Scheduler interrupted - returning"));
-	  deleteThread(t);
-	  while (run_queue_hd != END_TSO_QUEUE) {
-	      run_queue_hd = t->link;
-	      deleteThread(t);
-	  }
-	  run_queue_tl = END_TSO_QUEUE;
-	  /* ToDo: should I do the same with blocked queues? */
-          return Interrupted;
-      }
-
-      /* Put the thread back on the run queue, at the end.
-       * t->link is already set to END_TSO_QUEUE.
-       */
-      APPEND_TO_RUN_QUEUE(t);
-      break;
-
-    case ThreadBlocked:
-      IF_DEBUG(scheduler,
-	       fprintf(stderr, "Thread %d stopped, ", t->id);
-	       printThreadBlockage(t);
-	       fprintf(stderr, "\n"));
-      threadPaused(t);
-      /* assume the thread has put itself on some blocked queue
-       * somewhere.
-       */
-      break;
-
-    case ThreadFinished:
-      IF_DEBUG(scheduler,fprintf(stderr,"thread %ld finished\n", t->id));
-      t->whatNext = ThreadComplete;
-      break;
-
-    default:
-      barf("schedule: invalid thread return code");
-    }
-
-    /* check for signals each time around the scheduler */
-#ifndef __MINGW32__
-    if (signals_pending()) {
-      start_signal_handlers();
-    }
-#endif
-    /* If our main thread has finished or been killed, return.
-     * If we were re-entered as a result of a _ccall_gc, then
-     * pop the blocked thread off the ccalling_threads stack back
-     * into CurrentTSO.
-     */
-    if ((*MainTSO)->whatNext == ThreadComplete
-	|| (*MainTSO)->whatNext == ThreadKilled) {
-      next_main_thread--;
-      if (in_ccall_gc) {
-	CurrentTSO = ccalling_threads;
-	ccalling_threads = ccalling_threads->link;
-	/* remember to stub the link field of CurrentTSO */
-	CurrentTSO->link = END_TSO_QUEUE;
-      }
-      if ((*MainTSO)->whatNext == ThreadComplete) {
-	/* we finished successfully, fill in the return value */
-	if (ret_val) { *ret_val = (StgClosure *)(*MainTSO)->sp[0]; };
-	return Success;
-      } else {
-	return Killed;
-      }
-    }
-
-  next_thread:
-    /* Checked whether any waiting threads need to be woken up.
-     * If the run queue is empty, we can wait indefinitely for
-     * something to happen.
-     */
-    if (blocked_queue_hd != END_TSO_QUEUE) {
-      awaitEvent(run_queue_hd == END_TSO_QUEUE);
-    }
-
-    t = POP_RUN_QUEUE();
-  }
-
-  /* If we got to here, then we ran out of threads to run, but the
-   * main thread hasn't finished yet.  It must be blocked on an MVar
-   * or a black hole somewhere, so we return deadlock.
-   */
-  return Deadlock;
-}
-#endif
-
 /* -----------------------------------------------------------------------------
    Debugging: why is a thread blocked
    -------------------------------------------------------------------------- */
@@ -1605,7 +1390,7 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
 	 * this will also wake up any threads currently
 	 * waiting on the result.
 	 */
-	UPD_IND(su->updatee,ap);  /* revert the black hole */
+	UPD_IND_NOLOCK(su->updatee,ap);  /* revert the black hole */
 	su = su->link;
 	sp += sizeofW(StgUpdateFrame) -1;
 	sp[0] = (W_)ap; /* push onto stack */
diff --git a/ghc/rts/Schedule.h b/ghc/rts/Schedule.h
index 085ad22..4d8db44 100644
--- a/ghc/rts/Schedule.h
+++ b/ghc/rts/Schedule.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Schedule.h,v 1.9 1999/11/02 15:06:02 simonmar Exp $
+ * $Id: Schedule.h,v 1.10 1999/11/09 15:46:55 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -97,7 +97,9 @@ extern pthread_cond_t  gc_pending_cond;
 #ifdef SMP
 typedef struct {
   pthread_t id;
+  double    elapsedtimestart;
   double    mut_time;
+  double    mut_etime;
   double    gc_time;
   double    gc_etime;
 } task_info;
diff --git a/ghc/rts/Signals.c b/ghc/rts/Signals.c
index 730ede4..2193349 100644
--- a/ghc/rts/Signals.c
+++ b/ghc/rts/Signals.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Signals.c,v 1.9 1999/11/02 15:06:02 simonmar Exp $
+ * $Id: Signals.c,v 1.10 1999/11/09 15:46:57 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -257,7 +257,7 @@ pthread_t startup_guy;
 #endif
 
 static void
-shutdown_handler(int sig)
+shutdown_handler(int sig STG_UNUSED)
 {
 #ifdef SMP
   /* if I'm a worker thread, send this signal to the guy who
diff --git a/ghc/rts/Stats.c b/ghc/rts/Stats.c
index 097b5b9..64bd175 100644
--- a/ghc/rts/Stats.c
+++ b/ghc/rts/Stats.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Stats.c,v 1.16 1999/11/02 17:19:16 simonmar Exp $
+ * $Id: Stats.c,v 1.17 1999/11/09 15:46:57 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -63,9 +63,11 @@ static double TicksPerSecond   = 0.0;
 
 static double InitUserTime = 0.0;
 static double InitElapsedTime = 0.0;
+static double InitElapsedStamp = 0.0;
 
 static double MutUserTime = 0.0;
 static double MutElapsedTime = 0.0;
+static double MutElapsedStamp = 0.0;
 
 static double ExitUserTime = 0.0;
 static double ExitElapsedTime = 0.0;
@@ -117,7 +119,7 @@ elapsedtime(void)
 
     FT2longlong(kT,kernelTime);
     FT2longlong(uT,userTime);
-    return (((StgDouble)(uT + kT))/TicksPerSecond - ElapsedTimeStart);
+    return (((StgDouble)(uT + kT))/TicksPerSecond);
 }
 
 #else 
@@ -125,6 +127,7 @@ elapsedtime(void)
 double
 elapsedtime(void)
 {
+
 # if ! (defined(HAVE_TIMES) || defined(HAVE_FTIME))
     /* We will #ifdef around the fprintf for machines
        we *know* are unsupported. (WDP 94/05)
@@ -142,13 +145,13 @@ elapsedtime(void)
     struct tms t;
     clock_t r = times(&t);
 
-    return (((double)r)/TicksPerSecond - ElapsedTimeStart);
+    return (((double)r)/TicksPerSecond);
 
 #  else /* HAVE_FTIME */
     struct timeb t;
 
     ftime(&t);
-    return (fabs(t.time + 1e-3*t.millitm - ElapsedTimeStart));
+    return (fabs(t.time + 1e-3*t.millitm));
 
 #  endif /* HAVE_FTIME */
 # endif /* not stumped */
@@ -294,16 +297,24 @@ void
 end_init(void)
 {
   InitUserTime = usertime();
-  InitElapsedTime = elapsedtime();
+  InitElapsedStamp = elapsedtime(); 
+  InitElapsedTime = InitElapsedStamp - ElapsedTimeStart;
   if (InitElapsedTime < 0.0) {
     InitElapsedTime = 0.0;
   }
 }
 
+/* -----------------------------------------------------------------------------
+   stat_startExit and stat_endExit
+   
+   These two measure the time taken in shutdownHaskell().
+   -------------------------------------------------------------------------- */
+
 void
 stat_startExit(void)
 {
-  MutElapsedTime = elapsedtime() - GCe_tot_time - InitElapsedTime;
+  MutElapsedStamp = elapsedtime(); 
+  MutElapsedTime = MutElapsedStamp - GCe_tot_time - InitElapsedStamp;
   if (MutElapsedTime < 0) { MutElapsedTime = 0; }	/* sometimes -0.00 */
 
   /* for SMP, we don't know the mutator time yet, we have to inspect
@@ -327,7 +338,7 @@ stat_endExit(void)
 #else
   ExitUserTime = usertime() - MutUserTime - GC_tot_time - InitUserTime;
 #endif
-  ExitElapsedTime = elapsedtime() - MutElapsedTime;
+  ExitElapsedTime = elapsedtime() - MutElapsedStamp;
   if (ExitUserTime < 0.0) {
     ExitUserTime = 0.0;
   }
@@ -404,8 +415,8 @@ stat_endGC(lnat alloc, lnat collect, lnat live, lnat copied, lnat gen)
 
 	GC_tot_copied += (ullong) copied;
 	GC_tot_alloc  += (ullong) alloc;
-	GC_tot_time   += time-GC_start_time;
-	GCe_tot_time  += etime-GCe_start_time;
+	GC_tot_time   += gc_time;
+	GCe_tot_time  += gc_etime;
 
 #ifdef SMP
 	{
@@ -437,6 +448,33 @@ stat_endGC(lnat alloc, lnat collect, lnat live, lnat copied, lnat gen)
 }
 
 /* -----------------------------------------------------------------------------
+   stat_workerStop
+
+   Called under SMP when a worker thread finishes.  We drop the timing
+   stats for this thread into the task_ids struct for that thread.
+   -------------------------------------------------------------------------- */
+
+#ifdef SMP
+void
+stat_workerStop(void)
+{
+  nat i;
+  pthread_t me = pthread_self();
+
+  for (i = 0; i < RtsFlags.ConcFlags.nNodes; i++) {
+    if (task_ids[i].id == me) {
+      task_ids[i].mut_time = usertime() - task_ids[i].gc_time;
+      task_ids[i].mut_etime = elapsedtime()
+	                         - GCe_tot_time
+	                         - task_ids[i].elapsedtimestart;
+      if (task_ids[i].mut_time < 0.0)  { task_ids[i].mut_time = 0.0;  }
+      if (task_ids[i].mut_etime < 0.0) { task_ids[i].mut_etime = 0.0; }
+    }
+  }
+}
+#endif
+
+/* -----------------------------------------------------------------------------
    Called at the end of execution
 
    NOTE: number of allocations is not entirely accurate: it doesn't
@@ -452,7 +490,7 @@ stat_exit(int alloc)
     if (sf != NULL){
 	char temp[BIG_STRING_LEN];
 	double time = usertime();
-	double etime = elapsedtime();
+	double etime = elapsedtime() - ElapsedTimeStart;
 
 	/* avoid divide by zero if time is measured as 0.00 seconds -- SDM */
 	if (time  == 0.0)  time = 0.0001;
@@ -498,13 +536,15 @@ stat_exit(int alloc)
 	  MutUserTime = 0.0;
 	  for (i = 0; i < RtsFlags.ConcFlags.nNodes; i++) {
 	    MutUserTime += task_ids[i].mut_time;
-	    fprintf(sf, "  Task %2d:  MUT time: %6.2fs,  GC time: %6.2fs\n", 
-		    i, task_ids[i].mut_time, task_ids[i].gc_time);
+	    fprintf(sf, "  Task %2d:  MUT time: %6.2fs  (%6.2fs elapsed)\n"
+		        "            GC  time: %6.2fs  (%6.2fs elapsed)\n\n", 
+		    i, 
+		    task_ids[i].mut_time, task_ids[i].mut_etime,
+		    task_ids[i].gc_time, task_ids[i].gc_etime);
 	  }
 	}
 	time = MutUserTime + GC_tot_time + InitUserTime + ExitUserTime;
 	if (MutUserTime < 0) { MutUserTime = 0; }
-	fprintf(sf,"\n");
 #endif
 
 	fprintf(sf, "  INIT  time  %6.2fs  (%6.2fs elapsed)\n",
diff --git a/ghc/rts/Stats.h b/ghc/rts/Stats.h
index 0bf0886..7db318d 100644
--- a/ghc/rts/Stats.h
+++ b/ghc/rts/Stats.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Stats.h,v 1.7 1999/11/02 17:19:17 simonmar Exp $
+ * $Id: Stats.h,v 1.8 1999/11/09 15:46:58 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -12,6 +12,7 @@ extern void      start_time(void);
 extern StgDouble usertime(void);
 extern void      end_init(void);
 extern void      stat_exit(int alloc);
+extern void      stat_workerStop(void);
 
 extern void      stat_startGC(void);
 extern void      stat_endGC(lnat alloc, lnat collect, lnat live, 
diff --git a/ghc/rts/StgStdThunks.hc b/ghc/rts/StgStdThunks.hc
index 42c06a3..10a9e4b 100644
--- a/ghc/rts/StgStdThunks.hc
+++ b/ghc/rts/StgStdThunks.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgStdThunks.hc,v 1.9 1999/11/02 15:06:04 simonmar Exp $
+ * $Id: StgStdThunks.hc,v 1.10 1999/11/09 15:46:58 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -7,7 +7,9 @@
  *
  * ---------------------------------------------------------------------------*/
 
-#include "Stg.h"
+#include "Rts.h"
+#include "StoragePriv.h"
+#include "HeapStackCheck.h"
 
 /* -----------------------------------------------------------------------------
    The code for a thunk that simply extracts a field from a
diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 0bf3e21..ec0728a 100644
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.20 1999/11/02 15:06:04 simonmar Exp $
+ * $Id: Storage.c,v 1.21 1999/11/09 15:46:59 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -236,13 +236,20 @@ allocNurseries( void )
 #ifdef SMP
   {
     Capability *cap;
-    
+    bdescr *bd;
+
     g0s0->blocks = NULL;
     g0s0->n_blocks = 0;
     for (cap = free_capabilities; cap != NULL; cap = cap->link) {
       cap->rNursery = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
       cap->rCurrentNursery = cap->rNursery;
+      for (bd = cap->rNursery; bd != NULL; bd = bd->link) {
+	bd->back = (bdescr *)cap;
+      }
     }
+    /* Set the back links to be equal to the Capability,
+     * so we can do slightly better informed locking.
+     */
   }
 #else /* SMP */
   nursery_blocks  = RtsFlags.GcFlags.minAllocAreaSize;
@@ -480,8 +487,11 @@ calcAllocated( void )
 #ifdef SMP
   Capability *cap;
 
-  /* All tasks must be stopped */
-  ASSERT(n_free_capabilities == RtsFlags.ConcFlags.nNodes);
+  /* All tasks must be stopped.  Can't assert that all the
+     capabilities are owned by the scheduler, though: one or more
+     tasks might have been stopped while they were running (non-main)
+     threads. */
+  /*  ASSERT(n_free_capabilities == RtsFlags.ConcFlags.nNodes); */
 
   allocated = 
     n_free_capabilities * RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W
diff --git a/ghc/rts/Storage.h b/ghc/rts/Storage.h
index a1e43dc..45c839f 100644
--- a/ghc/rts/Storage.h
+++ b/ghc/rts/Storage.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.h,v 1.10 1999/11/02 15:06:05 simonmar Exp $
+ * $Id: Storage.h,v 1.11 1999/11/09 15:46:59 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -128,27 +128,29 @@ recordOldToNewPtrs(StgMutClosure *p)
   }
 }
 
-#define updateWithIndirection(p1, p2)				\
-  {								\
-    bdescr *bd;							\
-								\
-    bd = Bdescr((P_)p1);					\
-    if (bd->gen->no == 0) {					\
-      ((StgInd *)p1)->indirectee = p2;				\
-      SET_INFO(p1,&IND_info);					\
-      TICK_UPD_NEW_IND();					\
-    } else {							\
-      ((StgIndOldGen *)p1)->indirectee = p2;			\
-      ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;	\
-      bd->gen->mut_once_list = (StgMutClosure *)p1;		\
-      SET_INFO(p1,&IND_OLDGEN_info);				\
-      TICK_UPD_OLD_IND();					\
-    }								\
+#define updateWithIndirection(info, p1, p2)				\
+  {									\
+    bdescr *bd;								\
+									\
+    bd = Bdescr((P_)p1);						\
+    if (bd->gen->no == 0) {						\
+      ((StgInd *)p1)->indirectee = p2;					\
+      SET_INFO(p1,&IND_info);						\
+      TICK_UPD_NEW_IND();						\
+    } else {								\
+      ((StgIndOldGen *)p1)->indirectee = p2;				\
+      if (info != &BLACKHOLE_BQ_info) {					\
+        ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;	\
+        bd->gen->mut_once_list = (StgMutClosure *)p1;			\
+      }									\
+      SET_INFO(p1,&IND_OLDGEN_info);					\
+      TICK_UPD_OLD_IND();						\
+    }									\
   }
 
 #if defined(TICKY_TICKY) || defined(PROFILING)
 static inline void
-updateWithPermIndirection(StgClosure *p1, StgClosure *p2) 
+updateWithPermIndirection(info, StgClosure *p1, StgClosure *p2) 
 {
   bdescr *bd;
 
@@ -159,8 +161,10 @@ updateWithPermIndirection(StgClosure *p1, StgClosure *p2)
     TICK_UPD_NEW_PERM_IND(p1);
   } else {
     ((StgIndOldGen *)p1)->indirectee = p2;
-    ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;
-    bd->gen->mut_once_list = (StgMutClosure *)p1;
+    if (info != &BLACKHOLE_BQ_info) {
+      ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;
+      bd->gen->mut_once_list = (StgMutClosure *)p1;
+    }
     SET_INFO(p1,&IND_OLDGEN_PERM_info);
     TICK_UPD_OLD_PERM_IND();
   }
diff --git a/ghc/rts/StoragePriv.h b/ghc/rts/StoragePriv.h
index f88e37e..5b4019d 100644
--- a/ghc/rts/StoragePriv.h
+++ b/ghc/rts/StoragePriv.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StoragePriv.h,v 1.9 1999/11/02 15:06:05 simonmar Exp $
+ * $Id: StoragePriv.h,v 1.10 1999/11/09 15:47:00 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -10,79 +10,6 @@
 #ifndef STORAGEPRIV_H
 #define STORAGEPRIV_H
 
-/* GENERATION GC NOTES
- *
- * We support an arbitrary number of generations, with an arbitrary number
- * of steps per generation.  Notes (in no particular order):
- *
- *       - all generations except the oldest should have two steps.  This gives
- *         objects a decent chance to age before being promoted, and in
- *         particular will ensure that we don't end up with too many
- *         thunks being updated in older generations.
- *
- *       - the oldest generation has one step.  There's no point in aging
- *         objects in the oldest generation.
- *
- *       - generation 0, step 0 (G0S0) is the allocation area.  It is given
- *         a fixed set of blocks during initialisation, and these blocks
- *         are never freed.
- *
- *       - during garbage collection, each step which is an evacuation
- *         destination (i.e. all steps except G0S0) is allocated a to-space.
- *         evacuated objects are allocated into the step's to-space until
- *         GC is finished, when the original step's contents may be freed
- *         and replaced by the to-space.
- *
- *       - the mutable-list is per-generation (not per-step).  G0 doesn't 
- *         have one (since every garbage collection collects at least G0).
- * 
- *       - block descriptors contain pointers to both the step and the
- *         generation that the block belongs to, for convenience.
- *
- *       - static objects are stored in per-generation lists.  See GC.c for
- *         details of how we collect CAFs in the generational scheme.
- *
- *       - large objects are per-step, and are promoted in the same way
- *         as small objects, except that we may allocate large objects into
- *         generation 1 initially.
- */
-
-typedef struct _step {
-  nat no;			/* step number */
-  bdescr *blocks;		/* blocks in this step */
-  nat n_blocks;			/* number of blocks */
-  struct _step *to;		/* where collected objects from this step go */
-  struct _generation *gen;	/* generation this step belongs to */
-  bdescr *large_objects;	/* large objects (doubly linked) */
-
-  /* temporary use during GC: */
-  StgPtr  hp;			/* next free locn in to-space */
-  StgPtr  hpLim;		/* end of current to-space block */
-  bdescr *hp_bd;		/* bdescr of current to-space block */
-  bdescr *to_space;		/* bdescr of first to-space block */
-  nat     to_blocks;		/* number of blocks in to-space */
-  bdescr *scan_bd;		/* block currently being scanned */
-  StgPtr  scan;			/* scan pointer in current block */
-  bdescr *new_large_objects;    /* large objects collected so far */
-  bdescr *scavenged_large_objects; /* live large objects after GC (dbl link) */
-} step;
-
-typedef struct _generation {
-  nat no;			/* generation number */
-  step *steps;			/* steps */
-  nat n_steps;			/* number of steps */
-  nat max_blocks;		/* max blocks in step 0 */
-  StgMutClosure *mut_list;      /* mutable objects in this generation (not G0)*/
-  StgMutClosure *mut_once_list; /* objects that point to younger generations */
-
-  /* temporary use during GC: */
-  StgMutClosure *saved_mut_list;
-
-  /* stats information */
-  nat collections;
-  nat failed_promotions;
-} generation;
-
 #define END_OF_STATIC_LIST stgCast(StgClosure*,1)
 
 extern generation *generations;
diff --git a/ghc/rts/Updates.hc b/ghc/rts/Updates.hc
index f09f942..3b1f5c2 100644
--- a/ghc/rts/Updates.hc
+++ b/ghc/rts/Updates.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Updates.hc,v 1.20 1999/11/02 15:06:05 simonmar Exp $
+ * $Id: Updates.hc,v 1.21 1999/11/09 15:47:00 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -58,10 +58,17 @@
 	  /* Tick - it must be a con, all the paps are handled		\
 	   * in stg_upd_PAP and PAP_entry below				\
 	   */								\
-	  TICK_UPD_CON_IN_NEW(sizeW_fromITBL(get_itbl(Su)));	\
+	  TICK_UPD_CON_IN_NEW(sizeW_fromITBL(get_itbl(Su)));		\
 									\
-	  /* update the updatee with an indirection to the return value */\
-	  UPD_IND(Su,R1.p);					\
+	  if (Bdescr(updatee)->back != BaseReg) {			\
+		LOCK_CLOSURE(Su);					\
+	  }								\
+									\
+ 	  UPD_IND_NOLOCK(Su,R1.p);					\
+									\
+	  /* update the updatee with an indirection 			\
+	   * to the return value 					\
+	   */								\
 									\
 	  /* reset Su to the next update frame */			\
 	  Su = ((StgUpdateFrame *)Sp)->link;				\
@@ -88,8 +95,7 @@
 	   */								\
 	  TICK_UPD_CON_IN_NEW(sizeW_fromITBL(get_itbl(updatee)));	\
 									\
-	  /* update the updatee with an indirection to the return value */\
-	  UPD_IND(updatee,R1.p);					\
+	  UPD_IND(updatee, R1.cl);					\
 									\
 	  /* reset Su to the next update frame */			\
 	  Su = ((StgUpdateFrame *)Sp)->link;				\