[project @ 2001-11-08 12:46:31 by simonmar]

Fix the large block allocation bug (Yay!)
-----------------------------------------

In order to do this, I had to

 1. in each heap-check failure branch, return the amount of heap
    actually requested, in a known location (I added another slot
    in StgRegTable called HpAlloc for this purpose).  This is
    useful for other reasons - in particular it makes it possible
    to get accurate allocation statistics.

 2. In the scheduler, if a heap check fails and we wanted more than
    BLOCK_SIZE_W words, then allocate a special large block and place
    it in the nursery.  The nursery now has to be double-linked so
    we can insert the new block in the middle.

 3. The garbage collector has to be able to deal with multiple objects
    in a large block.  It turns out that this isn't a problem as long as
    the large blocks only occur in the nursery, because we always copy
    objects from the nursery during GC.  One small change had to be
    made: in evacuate(), we may need to follow the link field from the
    block descriptor to get to the block descriptor for the head of a
    large block.

 4. Various other parts of the storage manager had to be modified
    to cope with a nursery containing a mixture of block sizes.

Point (3) causes a slight pessimization in the garbage collector.  I
don't see a way to avoid this.  Point (1) causes some code bloat (a
rough measurement is around 5%), so to offset this I made the
following change which I'd been meaning to do for some time:

  - Store the values of some commonly-used absolute addresses
    (eg. stg_update_PAP) in the register table.  This lets us use
    shorter instruction forms for some absolute jumps and saves some
    code space.

  - The type of Capability is no longer the same as an StgRegTable.
    MainRegTable renamed to MainCapability.  See Regs.h for details.

Other minor changes:

  - remove individual declarations for the heap-check-failure jump
    points, and declare them all in StgMiscClosures.h instead.  Remove
    HeapStackCheck.h.

Updates to the native code generator to follow.

20 files changed, 373 insertions, 223 deletions

diff --git a/ghc/includes/Regs.h b/ghc/includes/Regs.h
index 4c2f911eb5..001e2cabf1 100644
--- a/ghc/includes/Regs.h
+++ b/ghc/includes/Regs.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Regs.h,v 1.9 2000/03/23 17:45:31 simonpj Exp $
+ * $Id: Regs.h,v 1.10 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -32,6 +32,13 @@ typedef struct StgSparkPool_ {
   StgClosure **tl;
 } StgSparkPool;
 
+typedef struct {
+  StgFunPtr      stgChk0;
+  StgFunPtr      stgChk1;
+  StgFunPtr      stgGCEnter1;
+  StgFunPtr      stgUpdatePAP;
+} StgFunTable;
+
 typedef struct StgRegTable_ {
   StgUnion 	  rR1;
   StgUnion   	  rR2;
@@ -41,8 +48,8 @@ typedef struct StgRegTable_ {
   StgUnion   	  rR6;
   StgUnion   	  rR7;
   StgUnion   	  rR8;
-  StgUnion   	  rR9;		/* used occasionally by heap/stack checks */
-  StgUnion   	  rR10;		/* used occasionally by heap/stack checks */
+  StgUnion   	  rR9;		// used occasionally by heap/stack checks
+  StgUnion   	  rR10;		// used occasionally by heap/stack checks
   StgFloat 	  rF1;
   StgFloat 	  rF2;
   StgFloat 	  rF3;
@@ -58,19 +65,31 @@ typedef struct StgRegTable_ {
   StgTSO         *rCurrentTSO;
   struct _bdescr *rNursery;
   struct _bdescr *rCurrentNursery;
+  StgWord         rHpAlloc;	// number of words being allocated in heap 
 #if defined(SMP) || defined(PAR)
-  StgSparkPool   rSparks;	/* per-task spark pool */
+  StgSparkPool   rSparks;	// per-task spark pool
 #endif
 #if defined(SMP)
-  struct StgRegTable_ *link;	/* per-task register tables are linked together */
+  struct StgRegTable_ *link;	// per-task register tables are linked together
 #endif
 } StgRegTable;
 
+
+/* A capability is a combination of a FunTable and a RegTable.  In STG
+ * code, BaseReg normally points to the RegTable portion of this
+ * structure, so that we can index both forwards and backwards to take
+ * advantage of shorter instruction forms on some archs (eg. x86).
+ */
+typedef struct {
+    StgFunTable f;
+    StgRegTable r;
+} Capability;
+
 /* No such thing as a MainRegTable under SMP - each thread must
  * have its own MainRegTable.
  */
 #ifndef SMP
-extern DLL_IMPORT_RTS StgRegTable  MainRegTable;
+extern DLL_IMPORT_RTS Capability  MainCapability;
 #endif
 
 #if IN_STG_CODE
@@ -113,6 +132,7 @@ extern DLL_IMPORT_RTS StgRegTable  MainRegTable;
 
 #define SAVE_CurrentTSO     (BaseReg->rCurrentTSO)
 #define SAVE_CurrentNursery (BaseReg->rCurrentNursery)
+#define SAVE_HpAlloc        (BaseReg->rHpAlloc)
 #if defined(SMP) || defined(PAR)
 #define SAVE_SparkHd 	    (BaseReg->rSparks.hd)
 #define SAVE_SparkTl        (BaseReg->rSparks.tl)
@@ -275,7 +295,7 @@ GLOBAL_REG_DECL(StgRegTable *,BaseReg,REG_Base)
 #ifdef SMP
 #error BaseReg must be in a register for SMP
 #endif
-#define BaseReg (&MainRegTable)
+#define BaseReg (&MainCapability.r)
 #endif
 
 #ifdef REG_Sp
@@ -320,6 +340,12 @@ GLOBAL_REG_DECL(bdescr *,CurrentNursery,REG_CurrentNursery)
 #define CurrentNursery (BaseReg->rCurrentNursery)
 #endif
 
+#ifdef REG_HpAlloc
+GLOBAL_REG_DECL(bdescr *,HpAlloc,REG_HpAlloc)
+#else
+#define HpAlloc (BaseReg->rHpAlloc)
+#endif
+
 #ifdef REG_SparkHd
 GLOBAL_REG_DECL(bdescr *,SparkHd,REG_SparkHd)
 #else
@@ -345,6 +371,39 @@ GLOBAL_REG_DECL(bdescr *,SparkLim,REG_SparkLim)
 #endif
 
 /* -----------------------------------------------------------------------------
+   Get absolute function pointers from the register table, to save
+   code space.  On x86, 
+
+       jmp  *-12(%ebx)
+
+   is shorter than
+   
+       jmp absolute_address
+
+   as long as the offset is within the range of a signed byte
+   (-128..+127).  So we pick some common absolute_addresses and put
+   them in the register table.  As a bonus, linking time should also
+   be reduced.
+
+   Other possible candidates in order of importance:
+      
+     stg_upd_frame_info
+     stg_CAF_BLACKHOLE_info
+     stg_IND_STATIC_info
+
+   anything else probably isn't worth the effort.
+
+   -------------------------------------------------------------------------- */
+
+
+#define FunReg ((StgFunTable *)((void *)BaseReg - sizeof(StgFunTable)))
+
+#define stg_chk_0          (FunReg->stgChk0)
+#define stg_chk_1          (FunReg->stgChk1)
+#define stg_gc_enter_1     (FunReg->stgGCEnter1)
+#define stg_update_PAP     (FunReg->stgUpdatePAP)
+
+/* -----------------------------------------------------------------------------
    For any registers which are denoted "caller-saves" by the C calling
    convention, we have to emit code to save and restore them across C
    calls.
@@ -553,6 +612,14 @@ GLOBAL_REG_DECL(bdescr *,SparkLim,REG_SparkLim)
 #define CALLER_RESTORE_CurrentNursery   /* nothing */
 #endif
 
+#ifdef CALLER_SAVES_HpAlloc
+#define CALLER_SAVE_HpAlloc   		SAVE_HpAlloc = HpAlloc;
+#define CALLER_RESTORE_HpAlloc		HpAlloc = SAVE_HpAlloc;
+#else
+#define CALLER_SAVE_HpAlloc   		/* nothing */
+#define CALLER_RESTORE_HpAlloc   	/* nothing */
+#endif
+
 #ifdef CALLER_SAVES_SparkHd
 #define CALLER_SAVE_SparkHd   		SAVE_SparkHd = SparkHd;
 #define CALLER_RESTORE_SparkHd		SparkHd = SAVE_SparkHd;
diff --git a/ghc/includes/StgMacros.h b/ghc/includes/StgMacros.h
index 9a0130961b..6f35a559c7 100644
--- a/ghc/includes/StgMacros.h
+++ b/ghc/includes/StgMacros.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMacros.h,v 1.38 2001/07/24 06:31:35 ken Exp $
+ * $Id: StgMacros.h,v 1.39 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -132,7 +132,6 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 
 #define STK_CHK(headroom,ret,r,layout,tag_assts)		\
 	if (Sp - headroom < SpLim) {				\
-	    EXTFUN_RTS(stg_chk_##layout);		 	\
 	    tag_assts						\
 	    (r) = (P_)ret;					\
 	    JMP_(stg_chk_##layout);				\
@@ -141,7 +140,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 #define HP_CHK(headroom,ret,r,layout,tag_assts)			\
         DO_GRAN_ALLOCATE(headroom)                              \
 	if ((Hp += headroom) > HpLim) {				\
-	    EXTFUN_RTS(stg_chk_##layout);		 	\
+            HpAlloc = (headroom);				\
 	    tag_assts						\
 	    (r) = (P_)ret;                                     	\
 	    JMP_(stg_chk_##layout);			   	\
@@ -150,7 +149,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 #define HP_STK_CHK(stk_headroom,hp_headroom,ret,r,layout,tag_assts) \
         DO_GRAN_ALLOCATE(hp_headroom)                              \
 	if (Sp - stk_headroom < SpLim || (Hp += hp_headroom) > HpLim) {	\
-	    EXTFUN_RTS(stg_chk_##layout);		 	\
+            HpAlloc = (hp_headroom);				\
 	    tag_assts						\
 	    (r) = (P_)ret;	                               	\
 	    JMP_(stg_chk_##layout);			   	\
@@ -177,7 +176,6 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 
 #define STK_CHK_NP(headroom,ptrs,tag_assts)			\
 	if ((Sp - (headroom)) < SpLim) {			\
-	    EXTFUN_RTS(stg_gc_enter_##ptrs);			\
             tag_assts						\
 	    JMP_(stg_gc_enter_##ptrs);				\
 	}
@@ -185,7 +183,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 #define HP_CHK_NP(headroom,ptrs,tag_assts)			\
         DO_GRAN_ALLOCATE(headroom)                              \
 	if ((Hp += (headroom)) > HpLim) {			\
-	    EXTFUN_RTS(stg_gc_enter_##ptrs);			\
+            HpAlloc = (headroom);				\
             tag_assts						\
 	    JMP_(stg_gc_enter_##ptrs);				\
 	}
@@ -193,7 +191,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 #define HP_CHK_SEQ_NP(headroom,ptrs,tag_assts)			\
         DO_GRAN_ALLOCATE(headroom)                              \
 	if ((Hp += (headroom)) > HpLim) {			\
-	    EXTFUN_RTS(stg_gc_seq_##ptrs);			\
+            HpAlloc = (headroom);				\
             tag_assts						\
 	    JMP_(stg_gc_seq_##ptrs);				\
 	}
@@ -201,7 +199,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 #define HP_STK_CHK_NP(stk_headroom, hp_headroom, ptrs, tag_assts) \
         DO_GRAN_ALLOCATE(hp_headroom)                              \
 	if ((Sp - (stk_headroom)) < SpLim || (Hp += (hp_headroom)) > HpLim) { \
-	    EXTFUN_RTS(stg_gc_enter_##ptrs);		 	\
+            HpAlloc = (hp_headroom);				\
             tag_assts						\
 	    JMP_(stg_gc_enter_##ptrs);			   	\
 	}
@@ -213,6 +211,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
         DO_GRAN_ALLOCATE(headroom)                              \
 	if ((Hp += (headroom)) > HpLim) {			\
 	    EXTFUN_RTS(lbl);					\
+            HpAlloc = (headroom);				\
             tag_assts						\
 	    JMP_(lbl);						\
 	}
@@ -294,7 +293,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 
 #define HP_CHK_GEN(headroom,liveness,reentry,tag_assts)	\
    if ((Hp += (headroom)) > HpLim ) {			\
-	EXTFUN_RTS(stg_gen_chk);				\
+        HpAlloc = (headroom);				\
         tag_assts					\
 	R9.w = (W_)LIVENESS_MASK(liveness);		\
         R10.w = (W_)reentry;				\
@@ -307,7 +306,6 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 
 #define STK_CHK_GEN(headroom,liveness,reentry,tag_assts)	\
    if ((Sp - (headroom)) < SpLim) {				\
-	EXTFUN_RTS(stg_gen_chk);					\
         tag_assts						\
 	R9.w = (W_)LIVENESS_MASK(liveness);			\
         R10.w = (W_)reentry;					\
@@ -316,7 +314,6 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
 
 #define MAYBE_GC(liveness,reentry)		\
    if (doYouWantToGC()) {			\
-	EXTFUN_RTS(stg_gen_hp);			\
 	R9.w = (W_)LIVENESS_MASK(liveness);	\
         R10.w = (W_)reentry;			\
         JMP_(stg_gen_hp);			\
@@ -787,17 +784,20 @@ LoadThreadState (void)
  * Suspending/resuming threads for doing external C-calls (_ccall_GC).
  * These functions are defined in rts/Schedule.c.
  */
-StgInt        suspendThread ( StgRegTable *cap );
-StgRegTable * resumeThread  ( StgInt );
+StgInt       suspendThread ( Capability *cap );
+Capability * resumeThread  ( StgInt );
 
 #define SUSPEND_THREAD(token)			\
    SaveThreadState();				\
-   token = suspendThread(BaseReg);
+   token = suspendThread((Capability *)((void *)BaseReg - sizeof(StgFunTable)));
 
 #ifdef SMP
-#define RESUME_THREAD(token)  			\
-   BaseReg = resumeThread(token);		\
-   LoadThreadState();
+#define RESUME_THREAD(token)			\
+  { Capability c;				\
+    c = resumeThread(token);			\
+    BaseReg = &c.r;				\
+    LoadThreadState();				\
+  }
 #else
 #define RESUME_THREAD(token)			\
    (void)resumeThread(token);			\
diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h
index eeaaf3ad4d..a4281c8406 100644
--- a/ghc/includes/StgMiscClosures.h
+++ b/ghc/includes/StgMiscClosures.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.h,v 1.39 2001/07/09 19:45:16 sof Exp $
+ * $Id: StgMiscClosures.h,v 1.40 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -238,3 +238,60 @@ EXTINFO_RTS stg_ap_6_upd_info;
 EXTINFO_RTS stg_ap_7_upd_info;
 EXTINFO_RTS stg_ap_8_upd_info;
 
+/* standard GC & stack check entry points */
+
+EXTFUN(stg_gc_entertop);
+EXTFUN(stg_gc_enter_1_hponly);
+EXTFUN(__stg_gc_enter_1);
+EXTFUN(stg_gc_enter_2);
+EXTFUN(stg_gc_enter_3);
+EXTFUN(stg_gc_enter_4);
+EXTFUN(stg_gc_enter_5);
+EXTFUN(stg_gc_enter_6);
+EXTFUN(stg_gc_enter_7);
+EXTFUN(stg_gc_enter_8);
+EXTFUN(stg_gc_seq_1);
+
+EI_(stg_gc_noregs_ret_info);
+EF_(stg_gc_noregs);
+
+EI_(stg_gc_unpt_r1_ret_info);
+EF_(stg_gc_unpt_r1);
+
+EI_(stg_gc_unbx_r1_ret_info);
+EF_(stg_gc_unbx_r1);
+
+EI_(stg_gc_f1_ret_info);
+EF_(stg_gc_f1);
+
+EI_(stg_gc_d1_ret_info);
+EF_(stg_gc_d1);
+
+EI_(stg_gc_ut_1_0_ret_info);
+EF_(stg_gc_ut_1_0);
+
+EI_(stg_gc_ut_0_1_ret_info);
+EF_(stg_gc_ut_0_1);
+
+EXTFUN(__stg_chk_0);
+EXTFUN(__stg_chk_1);
+EXTFUN(stg_chk_1n);
+EXTFUN(stg_chk_2);
+EXTFUN(stg_chk_3);
+EXTFUN(stg_chk_4);
+EXTFUN(stg_chk_5);
+EXTFUN(stg_chk_6);
+EXTFUN(stg_chk_7);
+EXTFUN(stg_chk_8);
+EXTFUN(stg_gen_chk_ret);
+EXTFUN(stg_gen_chk);
+EXTFUN(stg_gen_hp);
+EXTFUN(stg_gen_yield);
+EXTFUN(stg_yield_noregs);
+EXTFUN(stg_yield_to_interpreter);
+EXTFUN(stg_gen_block);
+EXTFUN(stg_block_noregs);
+EXTFUN(stg_block_1);
+EXTFUN(stg_block_takemvar);
+EXTFUN(stg_block_putmvar);
+
diff --git a/ghc/includes/StgStorage.h b/ghc/includes/StgStorage.h
index 3af566d891..11cca7033e 100644
--- a/ghc/includes/StgStorage.h
+++ b/ghc/includes/StgStorage.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgStorage.h,v 1.10 2001/07/24 16:36:44 simonmar Exp $
+ * $Id: StgStorage.h,v 1.11 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -104,7 +104,7 @@ typedef struct _generation {
 
 #define OpenNursery(hp,hplim)				\
   (hp    = CurrentNursery->free-1,			\
-   hplim = CurrentNursery->start + BLOCK_SIZE_W - 1)
+   hplim = CurrentNursery->start + CurrentNursery->blocks*BLOCK_SIZE_W - 1)
   
 #define CloseNursery(hp)  (CurrentNursery->free = (P_)(hp)+1)
 
diff --git a/ghc/includes/Updates.h b/ghc/includes/Updates.h
index b29fcc2353..d20332433f 100644
--- a/ghc/includes/Updates.h
+++ b/ghc/includes/Updates.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Updates.h,v 1.24 2001/03/22 03:51:09 hwloidl Exp $
+ * $Id: Updates.h,v 1.25 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -239,13 +239,13 @@ extern void newCAF(StgClosure*);
    Update-related prototypes
    -------------------------------------------------------------------------- */
 
+EXTFUN_RTS(__stg_update_PAP);
+
 DLL_IMPORT_RTS extern STGFUN(stg_upd_frame_entry);
 
 extern DLL_IMPORT_RTS const StgInfoTable stg_PAP_info;
 DLL_IMPORT_RTS STGFUN(stg_PAP_entry);
 
-EXTFUN_RTS(stg_update_PAP);
-
 extern DLL_IMPORT_RTS const StgInfoTable stg_AP_UPD_info;
 DLL_IMPORT_RTS STGFUN(stg_AP_UPD_entry);
 
diff --git a/ghc/includes/mkNativeHdr.c b/ghc/includes/mkNativeHdr.c
index 282864ddda..7b2bebd8eb 100644
--- a/ghc/includes/mkNativeHdr.c
+++ b/ghc/includes/mkNativeHdr.c
@@ -1,5 +1,5 @@
 /* --------------------------------------------------------------------------
- * $Id: mkNativeHdr.c,v 1.5 2000/08/17 14:30:26 simonmar Exp $
+ * $Id: mkNativeHdr.c,v 1.6 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1992-1998
  *
@@ -35,6 +35,14 @@
 #define OFFSET_HpLim OFFSET(RegTable, RegTable.rHpLim)
 #define OFFSET_CurrentTSO OFFSET(RegTable, RegTable.rCurrentTSO)
 #define OFFSET_CurrentNursery OFFSET(RegTable, RegTable.rCurrentNursery)
+#define OFFSET_HpAlloc OFFSET(RegTable, RegTable.rHpAlloc)
+
+#define FUN_OFFSET(sym) ((StgPtr)&cap.f.sym - (StgPtr)&cap.r)
+
+#define OFFSET_stgChk0       FUN_OFFSET(stgChk0)
+#define OFFSET_stgChk1       FUN_OFFSET(stgChk1)
+#define OFFSET_stgGCEnter1   FUN_OFFSET(stgGCEnter1)
+#define OFFSET_stgUpdatePAP  FUN_OFFSET(stgUpdatePAP)
 
 #define TSO_SP       OFFSET(tso, tso.sp)
 #define TSO_SU       OFFSET(tso, tso.su)
@@ -44,6 +52,9 @@
 #define BDESCR_FREE  OFFSET(bd, bd.free)
 
 StgRegTable RegTable;
+
+Capability cap;
+
 StgTSO tso;
 bdescr bd;
 
@@ -80,6 +91,12 @@ main()
     printf("#define OFFSET_HpLim %d\n", OFFSET_HpLim);
     printf("#define OFFSET_CurrentTSO %d\n", OFFSET_CurrentTSO);
     printf("#define OFFSET_CurrentNursery %d\n", OFFSET_CurrentNursery);
+    printf("#define OFFSET_HpAlloc %d\n", OFFSET_HpAlloc);
+
+    printf("#define OFFSET_stgChk0 (%d)\n", OFFSET_stgChk0);
+    printf("#define OFFSET_stgChk1 (%d)\n", OFFSET_stgChk1);
+    printf("#define OFFSET_stgGCEnter1 (%d)\n", OFFSET_stgGCEnter1);
+    printf("#define OFFSET_stgUpdatePAP (%d)\n", OFFSET_stgUpdatePAP);
 
     printf("\n-- Storage Manager offsets for the Native Code Generator\n");
 
diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 16712d4d3a..3ecde2b5eb 100644
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.125 2001/10/19 09:41:11 sewardj Exp $
+ * $Id: GC.c,v 1.126 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -920,6 +920,11 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
       }
       
       resizeNursery((nat)blocks);
+
+    } else {
+      // we might have added extra large blocks to the nursery, so
+      // resize back to minAllocAreaSize again.
+      resizeNursery(RtsFlags.GcFlags.minAllocAreaSize);
     }
   }
 
@@ -1467,6 +1472,9 @@ loop:
   if (HEAP_ALLOCED(q)) {
     bd = Bdescr((P_)q);
 
+    // not a group head: find the group head
+    if (bd->blocks == 0) { bd = bd->link; }
+
     if (bd->gen_no > N) {
 	/* Can't evacuate this object, because it's in a generation
 	 * older than the ones we're collecting.  Let's hope that it's
diff --git a/ghc/rts/HeapStackCheck.h b/ghc/rts/HeapStackCheck.h
deleted file mode 100644
index 1bbccd7e11..0000000000
--- a/ghc/rts/HeapStackCheck.h
+++ /dev/null
@@ -1,64 +0,0 @@
-/* -----------------------------------------------------------------------------
- * $Id: HeapStackCheck.h,v 1.7 2001/07/06 14:11:38 simonmar Exp $
- *
- * (c) The GHC Team, 1998-1999
- *
- * Prototypes for functions in HeapStackCheck.hc
- *
- * ---------------------------------------------------------------------------*/
-
-
-EXTFUN(stg_gc_entertop);
-EXTFUN(stg_gc_enter_1_hponly);
-EXTFUN(stg_gc_enter_1);
-EXTFUN(stg_gc_enter_2);
-EXTFUN(stg_gc_enter_3);
-EXTFUN(stg_gc_enter_4);
-EXTFUN(stg_gc_enter_5);
-EXTFUN(stg_gc_enter_6);
-EXTFUN(stg_gc_enter_7);
-EXTFUN(stg_gc_enter_8);
-EXTFUN(stg_gc_seq_1);
-
-EI_(stg_gc_noregs_ret_info);
-EF_(stg_gc_noregs);
-
-EI_(stg_gc_unpt_r1_ret_info);
-EF_(stg_gc_unpt_r1);
-
-EI_(stg_gc_unbx_r1_ret_info);
-EF_(stg_gc_unbx_r1);
-
-EI_(stg_gc_f1_ret_info);
-EF_(stg_gc_f1);
-
-EI_(stg_gc_d1_ret_info);
-EF_(stg_gc_d1);
-
-EI_(stg_gc_ut_1_0_ret_info);
-EF_(stg_gc_ut_1_0);
-
-EI_(stg_gc_ut_0_1_ret_info);
-EF_(stg_gc_ut_0_1);
-
-EXTFUN(stg_chk_0);
-EXTFUN(stg_chk_1);
-EXTFUN(stg_chk_1n);
-EXTFUN(stg_chk_2);
-EXTFUN(stg_chk_3);
-EXTFUN(stg_chk_4);
-EXTFUN(stg_chk_5);
-EXTFUN(stg_chk_6);
-EXTFUN(stg_chk_7);
-EXTFUN(stg_chk_8);
-EXTFUN(stg_gen_chk_ret);
-EXTFUN(stg_gen_chk);
-EXTFUN(stg_gen_hp);
-EXTFUN(stg_gen_yield);
-EXTFUN(stg_yield_noregs);
-EXTFUN(stg_yield_to_interpreter);
-EXTFUN(stg_gen_block);
-EXTFUN(stg_block_noregs);
-EXTFUN(stg_block_1);
-EXTFUN(stg_block_takemvar);
-EXTFUN(stg_block_putmvar);
diff --git a/ghc/rts/HeapStackCheck.hc b/ghc/rts/HeapStackCheck.hc
index 72ca5530e4..5fa5f100e8 100644
--- a/ghc/rts/HeapStackCheck.hc
+++ b/ghc/rts/HeapStackCheck.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: HeapStackCheck.hc,v 1.17 2001/07/06 14:11:38 simonmar Exp $
+ * $Id: HeapStackCheck.hc,v 1.18 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -12,7 +12,6 @@
 #include "Storage.h"   	/* for CurrentTSO */
 #include "StgRun.h"	/* for StgReturn and register saving */
 #include "Schedule.h"   /* for context_switch */
-#include "HeapStackCheck.h"
 
 /* Stack/Heap Check Failure
  * ------------------------
@@ -51,7 +50,8 @@
 
 #define GC_GENERIC					\
   if (Hp > HpLim) {					\
-    if (ExtendNursery(Hp,HpLim)) {			\
+    Hp -= HpAlloc;					\
+    if (HpAlloc <= BLOCK_SIZE_W && ExtendNursery(Hp,HpLim)) {\
 	if (context_switch) {				\
 	    R1.i = ThreadYielding;			\
 	} else {					\
@@ -70,7 +70,8 @@
 
 #define GC_ENTER					\
   if (Hp > HpLim) {					\
-    if (ExtendNursery(Hp,HpLim)) {			\
+    Hp -= HpAlloc;					\
+    if (HpAlloc <= BLOCK_SIZE_W && ExtendNursery(Hp,HpLim)) {\
 	if (context_switch) {				\
 	    R1.i = ThreadYielding;			\
 	} else {					\
@@ -151,7 +152,7 @@ EXTFUN(stg_gc_entertop)
    There are canned sequences for 'n' pointer values in registers.
    -------------------------------------------------------------------------- */
 
-EXTFUN(stg_gc_enter_1)
+EXTFUN(__stg_gc_enter_1)
 {
   FB_
   Sp -= 1;
@@ -880,7 +881,7 @@ EXTFUN(stg_gc_ut_0_1)
 
 /*- 0 Regs -------------------------------------------------------------------*/
 
-EXTFUN(stg_chk_0)
+EXTFUN(__stg_chk_0)
 {
   FB_
   Sp -= 1;
@@ -891,7 +892,7 @@ EXTFUN(stg_chk_0)
 
 /*- 1 Reg --------------------------------------------------------------------*/
 
-EXTFUN(stg_chk_1)
+EXTFUN(__stg_chk_1)
 {
   FB_
   Sp -= 2;
diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c
index deb42fb97b..27c3c5ca44 100644
--- a/ghc/rts/Interpreter.c
+++ b/ghc/rts/Interpreter.c
@@ -5,8 +5,8 @@
  * Copyright (c) 1994-2000.
  *
  * $RCSfile: Interpreter.c,v $
- * $Revision: 1.30 $
- * $Date: 2001/08/14 13:40:09 $
+ * $Revision: 1.31 $
+ * $Date: 2001/11/08 12:46:31 $
  * ---------------------------------------------------------------------------*/
 
 #include "PosixSource.h"
@@ -56,15 +56,15 @@
 #define BCO_ITBL(n)   itbls[n]
 
 #define LOAD_STACK_POINTERS          \
-    iSp = cap->rCurrentTSO->sp;      \
-    iSu = cap->rCurrentTSO->su;      \
+    iSp = cap->r.rCurrentTSO->sp;      \
+    iSu = cap->r.rCurrentTSO->su;      \
     /* We don't change this ... */   \
-    iSpLim = cap->rCurrentTSO->stack + RESERVED_STACK_WORDS;
+    iSpLim = cap->r.rCurrentTSO->stack + RESERVED_STACK_WORDS;
 
 
 #define SAVE_STACK_POINTERS          \
-    cap->rCurrentTSO->sp = iSp;      \
-    cap->rCurrentTSO->su = iSu;
+    cap->r.rCurrentTSO->sp = iSp;      \
+    cap->r.rCurrentTSO->su = iSu;
 
 #define RETURN(retcode)              \
    SAVE_STACK_POINTERS; return retcode;
@@ -196,10 +196,10 @@ StgThreadReturnCode interpretBCO ( Capability* cap )
 
 	     //	     checkSanity(1);
 	     //             iSp--; StackWord(0) = obj;
-	     //             checkStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
+	     //             checkStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
 	     //             iSp++;
 
-             printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
+             printStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
              fprintf(stderr, "\n\n");
             );
 
@@ -373,7 +373,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap )
           /* Heap check */
           if (doYouWantToGC()) {
 	     iSp--; StackWord(0) = (W_)bco;
-             cap->rCurrentTSO->what_next = ThreadEnterInterp;
+             cap->r.rCurrentTSO->what_next = ThreadEnterInterp;
              RETURN(HeapOverflow);
           }
 
@@ -381,7 +381,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap )
           if (iSp - (INTERP_STACK_CHECK_THRESH+1) < iSpLim) {
              iSp--;
              StackWord(0) = (W_)obj;
-             cap->rCurrentTSO->what_next = ThreadEnterInterp;
+             cap->r.rCurrentTSO->what_next = ThreadEnterInterp;
              RETURN(StackOverflow);
           }
 
@@ -389,7 +389,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap )
           if (context_switch) {
              iSp--;
              StackWord(0) = (W_)obj;
-             cap->rCurrentTSO->what_next = ThreadEnterInterp;
+             cap->r.rCurrentTSO->what_next = ThreadEnterInterp;
              RETURN(ThreadYielding);
 	  }
  
@@ -404,7 +404,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap )
           IF_DEBUG(evaluator,
 		   //if (do_print_stack) {
 		   //fprintf(stderr, "\n-- BEGIN stack\n");
-		   //printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
+		   //printStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
 		   //fprintf(stderr, "-- END stack\n\n");
 		   //}
                    do_print_stack = 1;
@@ -416,7 +416,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap )
                                 fprintf(stderr, "%d  %p\n", i, (StgPtr)(*(iSp+i)));
                              fprintf(stderr,"\n");
                            }
-		    //if (do_print_stack) checkStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
+		    //if (do_print_stack) checkStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
                   );
 
 #         ifdef INTERP_STATS
@@ -436,7 +436,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap )
                 if (iSp - stk_words_reqd < iSpLim) {
                    iSp--;
                    StackWord(0) = (W_)obj;
-                   cap->rCurrentTSO->what_next = ThreadEnterInterp;
+                   cap->r.rCurrentTSO->what_next = ThreadEnterInterp;
                    RETURN(StackOverflow);
                 }
                 goto nextInsn;
@@ -480,7 +480,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap )
                           fprintf(stderr,"\tBuilt "); 
                           printObj((StgClosure*)pap);
 		         );
-                 cap->rCurrentTSO->what_next = ThreadEnterGHC;
+                 cap->r.rCurrentTSO->what_next = ThreadEnterGHC;
                  RETURN(ThreadYielding);
               }
               case bci_PUSH_L: {
@@ -750,7 +750,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap )
                      StgInfoTable* magic_itbl = BCO_ITBL(o_itoc_itbl);
                      if (magic_itbl != NULL) {
                         StackWord(0) = (W_)magic_itbl;
-                        cap->rCurrentTSO->what_next = ThreadRunGHC;
+                        cap->r.rCurrentTSO->what_next = ThreadRunGHC;
                         RETURN(ThreadYielding);
                      } else {
                         /* Special case -- returning a VoidRep to
@@ -759,7 +759,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap )
                            tag and enter the itbl. */
 		        ASSERT(StackWord(0) == (W_)NULL);
 		        iSp ++;
-                        cap->rCurrentTSO->what_next = ThreadRunGHC;
+                        cap->r.rCurrentTSO->what_next = ThreadRunGHC;
                         RETURN(ThreadYielding);
                      }
                  }
@@ -819,7 +819,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap )
                    printObj(obj);
                   );
           iSp--; StackWord(0) = (W_)obj;
-          cap->rCurrentTSO->what_next = ThreadEnterGHC;
+          cap->r.rCurrentTSO->what_next = ThreadEnterGHC;
           RETURN(ThreadYielding);
        }
     } /* switch on object kind */
diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c
index 8cd1b021c2..aed20eef6a 100644
--- a/ghc/rts/Linker.c
+++ b/ghc/rts/Linker.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.72 2001/10/26 11:33:13 sewardj Exp $
+ * $Id: Linker.c,v 1.73 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 2000, 2001
  *
@@ -158,22 +158,22 @@ typedef struct _RtsSymbolVal {
       Sym(StgReturn)				\
       Sym(__stginit_PrelGHC)			\
       Sym(init_stack)				\
-      Sym(stg_chk_0)				\
-      Sym(stg_chk_1)				\
+      SymX(__stg_chk_0)				\
+      SymX(__stg_chk_1)				\
       Sym(stg_enterStackTop)			\
-      Sym(stg_gc_d1)				\
-      Sym(stg_gc_enter_1)			\
-      Sym(stg_gc_f1)				\
-      Sym(stg_gc_noregs)			\
-      Sym(stg_gc_seq_1)				\
-      Sym(stg_gc_unbx_r1)			\
-      Sym(stg_gc_unpt_r1)			\
-      Sym(stg_gc_ut_0_1)			\
-      Sym(stg_gc_ut_1_0)			\
-      Sym(stg_gen_chk)				\
-      Sym(stg_yield_to_interpreter)		\
+      SymX(stg_gc_d1)				\
+      SymX(__stg_gc_enter_1)			\
+      SymX(stg_gc_f1)				\
+      SymX(stg_gc_noregs)			\
+      SymX(stg_gc_seq_1)			\
+      SymX(stg_gc_unbx_r1)			\
+      SymX(stg_gc_unpt_r1)			\
+      SymX(stg_gc_ut_0_1)			\
+      SymX(stg_gc_ut_1_0)			\
+      SymX(stg_gen_chk)				\
+      SymX(stg_yield_to_interpreter)		\
       SymX(ErrorHdrHook)			\
-      SymX(MainRegTable)			\
+      SymX(MainCapability)			\
       SymX(MallocFailHook)			\
       SymX(NoRunnableThreadsHook)		\
       SymX(OnExitHook)				\
@@ -314,7 +314,7 @@ typedef struct _RtsSymbolVal {
       SymX(stg_sel_9_upd_info)			\
       SymX(stg_seq_frame_info)			\
       SymX(stg_upd_frame_info)			\
-      SymX(stg_update_PAP)			\
+      SymX(__stg_update_PAP)			\
       SymX(suspendThread)			\
       SymX(takeMVarzh_fast)			\
       SymX(timesIntegerzh_fast)			\
diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index 364e20ab6f..d36c18e0af 100644
--- a/ghc/rts/PrimOps.hc
+++ b/ghc/rts/PrimOps.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.83 2001/08/08 10:50:37 simonmar Exp $
+ * $Id: PrimOps.hc,v 1.84 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -18,7 +18,6 @@
 #include "Storage.h"
 #include "BlockAlloc.h" /* tmp */
 #include "StablePriv.h"
-#include "HeapStackCheck.h"
 #include "StgRun.h"
 #include "Itimer.h"
 #include "Prelude.h"
diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c
index 8e64ecb555..87c804fd17 100644
--- a/ghc/rts/RtsStartup.c
+++ b/ghc/rts/RtsStartup.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.54 2001/10/31 10:34:29 simonmar Exp $
+ * $Id: RtsStartup.c,v 1.55 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -228,7 +228,7 @@ initModules ( void (*init_root)(void) )
 #ifdef SMP
     Capability cap;
 #else
-#define cap MainRegTable
+#define cap MainCapability
 #endif
 
     init_sp = 0;
@@ -239,8 +239,8 @@ initModules ( void (*init_root)(void) )
 	init_stack[init_sp++] = (F_)init_root;
     }
     
-    cap.rSp = (P_)(init_stack + init_sp);
-    StgRun((StgFunPtr)stg_init, &cap);
+    cap.r.rSp = (P_)(init_stack + init_sp);
+    StgRun((StgFunPtr)stg_init, &cap.r);
 }
 
 /* -----------------------------------------------------------------------------
diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 35b9b79c5b..3371bad913 100644
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.104 2001/10/31 10:34:29 simonmar Exp $
+ * $Id: Schedule.c,v 1.105 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -225,13 +225,10 @@ StgThreadID next_thread_id = 1;
  * Locks required: sched_mutex.
  */
 #ifdef SMP
-//@cindex free_capabilities
-//@cindex n_free_capabilities
 Capability *free_capabilities; /* Available capabilities for running threads */
 nat n_free_capabilities;       /* total number of available capabilities */
 #else
-//@cindex MainRegTable
-Capability MainRegTable;       /* for non-SMP, we have one global capability */
+Capability MainCapability;     /* for non-SMP, we have one global capability */
 #endif
 
 #if defined(GRAN)
@@ -460,7 +457,8 @@ schedule( void )
       }
     }
 
-#else
+#else // not SMP
+
 # if defined(PAR)
     /* in GUM do this only on the Main PE */
     if (IAmMainThread)
@@ -527,7 +525,7 @@ schedule( void )
 	  pthread_cond_signal(&thread_ready_cond);
       }
     }
-#endif /* SMP */
+#endif // SMP
 
     /* check for signals each time around the scheduler */
 #ifndef mingw32_TARGET_OS
@@ -902,6 +900,9 @@ schedule( void )
      */
     ASSERT(run_queue_hd != END_TSO_QUEUE);
     t = POP_RUN_QUEUE();
+
+    // Sanity check the thread we're about to run.  This can be
+    // expensive if there is lots of thread switching going on...
     IF_DEBUG(sanity,checkTSO(t));
 
 #endif
@@ -913,10 +914,10 @@ schedule( void )
     free_capabilities = cap->link;
     n_free_capabilities--;
 #else
-    cap = &MainRegTable;
+    cap = &MainCapability;
 #endif
 
-    cap->rCurrentTSO = t;
+    cap->r.rCurrentTSO = t;
     
     /* context switches are now initiated by the timer signal, unless
      * the user specified "context switch as often as possible", with
@@ -938,17 +939,17 @@ schedule( void )
     /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
     /* Run the current thread 
      */
-    switch (cap->rCurrentTSO->what_next) {
+    switch (cap->r.rCurrentTSO->what_next) {
     case ThreadKilled:
     case ThreadComplete:
 	/* Thread already finished, return to scheduler. */
 	ret = ThreadFinished;
 	break;
     case ThreadEnterGHC:
-	ret = StgRun((StgFunPtr) stg_enterStackTop, cap);
+	ret = StgRun((StgFunPtr) stg_enterStackTop, &cap->r);
 	break;
     case ThreadRunGHC:
-	ret = StgRun((StgFunPtr) stg_returnToStackTop, cap);
+	ret = StgRun((StgFunPtr) stg_returnToStackTop, &cap->r);
 	break;
     case ThreadEnterInterp:
 	ret = interpretBCO(cap);
@@ -970,7 +971,7 @@ schedule( void )
 #elif !defined(GRAN) && !defined(PAR)
     IF_DEBUG(scheduler,fprintf(stderr,"scheduler: "););
 #endif
-    t = cap->rCurrentTSO;
+    t = cap->r.rCurrentTSO;
     
 #if defined(PAR)
     /* HACK 675: if the last thread didn't yield, make sure to print a 
@@ -983,14 +984,65 @@ schedule( void )
     switch (ret) {
     case HeapOverflow:
 #if defined(GRAN)
-      IF_DEBUG(gran, 
-	       DumpGranEvent(GR_DESCHEDULE, t));
+      IF_DEBUG(gran, DumpGranEvent(GR_DESCHEDULE, t));
       globalGranStats.tot_heapover++;
 #elif defined(PAR)
-      // IF_DEBUG(par, 
-      //DumpGranEvent(GR_DESCHEDULE, t);
       globalParStats.tot_heapover++;
 #endif
+
+      // did the task ask for a large block?
+      if (cap->r.rHpAlloc > BLOCK_SIZE_W) {
+	  // if so, get one and push it on the front of the nursery.
+	  bdescr *bd;
+	  nat blocks;
+	  
+	  blocks = (nat)BLOCK_ROUND_UP(cap->r.rHpAlloc * sizeof(W_)) / BLOCK_SIZE;
+
+	  IF_DEBUG(scheduler,belch("--<< thread %ld (%p; %s) stopped: requesting a large block (size %d)", 
+				   t->id, t,
+				   whatNext_strs[t->what_next], blocks));
+
+	  // don't do this if it would push us over the
+	  // alloc_blocks_lim limit; we'll GC first.
+	  if (alloc_blocks + blocks < alloc_blocks_lim) {
+
+	      alloc_blocks += blocks;
+	      bd = allocGroup( blocks );
+
+	      // link the new group into the list
+	      bd->link = cap->r.rCurrentNursery;
+	      bd->u.back = cap->r.rCurrentNursery->u.back;
+	      if (cap->r.rCurrentNursery->u.back != NULL) {
+		  cap->r.rCurrentNursery->u.back->link = bd;
+	      } else {
+		  ASSERT(g0s0->blocks == cap->r.rCurrentNursery &&
+			 g0s0->blocks == cap->r.rNursery);
+		  cap->r.rNursery = g0s0->blocks = bd;
+	      }		  
+	      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;
+
+	      // don't forget to update the block count in g0s0.
+	      g0s0->n_blocks += blocks;
+	      ASSERT(countBlocks(g0s0->blocks) == g0s0->n_blocks);
+
+	      // now update the nursery to point to the new block
+	      cap->r.rCurrentNursery = bd;
+
+	      // we might be unlucky and have another thread get on the
+	      // run queue before us and steal the large block, but in that
+	      // case the thread will just end up requesting another large
+	      // block.
+	      PUSH_ON_RUN_QUEUE(t);
+	      break;
+	  }
+      }
+
       /* make all the running tasks block on a condition variable,
        * maybe set context_switch and wait till they all pile in,
        * then have them wait on a GC condition variable.
@@ -1240,24 +1292,20 @@ schedule( void )
 	       G_CURR_THREADQ(0));
 #endif /* GRAN */
     }
+
 #if defined(GRAN)
   next_thread:
     IF_GRAN_DEBUG(unused,
 		  print_eventq(EventHd));
 
     event = get_next_event();
-
 #elif defined(PAR)
   next_thread:
     /* ToDo: wait for next message to arrive rather than busy wait */
-
-#else /* GRAN */
-  /* not any more
-  next_thread:
-    t = take_off_run_queue(END_TSO_QUEUE);
-  */
 #endif /* GRAN */
+
   } /* end of while(1) */
+
   IF_PAR_DEBUG(verbose,
 	       belch("== Leaving schedule() after having received Finish"));
 }
@@ -1315,14 +1363,14 @@ suspendThread( Capability *cap )
   ACQUIRE_LOCK(&sched_mutex);
 
   IF_DEBUG(scheduler,
-	   sched_belch("thread %d did a _ccall_gc", cap->rCurrentTSO->id));
+	   sched_belch("thread %d did a _ccall_gc", cap->r.rCurrentTSO->id));
 
-  threadPaused(cap->rCurrentTSO);
-  cap->rCurrentTSO->link = suspended_ccalling_threads;
-  suspended_ccalling_threads = cap->rCurrentTSO;
+  threadPaused(cap->r.rCurrentTSO);
+  cap->r.rCurrentTSO->link = suspended_ccalling_threads;
+  suspended_ccalling_threads = cap->r.rCurrentTSO;
 
   /* Use the thread ID as the token; it should be unique */
-  tok = cap->rCurrentTSO->id;
+  tok = cap->r.rCurrentTSO->id;
 
 #ifdef SMP
   cap->link = free_capabilities;
@@ -1366,10 +1414,10 @@ resumeThread( StgInt tok )
   free_capabilities = cap->link;
   n_free_capabilities--;
 #else  
-  cap = &MainRegTable;
+  cap = &MainCapability;
 #endif
 
-  cap->rCurrentTSO = tso;
+  cap->r.rCurrentTSO = tso;
 
   RELEASE_LOCK(&sched_mutex);
   return cap;
@@ -1738,7 +1786,15 @@ term_handler(int sig STG_UNUSED)
 }
 #endif
 
-//@cindex initScheduler
+static void
+initCapability( Capability *cap )
+{
+    cap->f.stgChk0         = (F_)__stg_chk_0;
+    cap->f.stgChk1         = (F_)__stg_chk_1;
+    cap->f.stgGCEnter1     = (F_)__stg_gc_enter_1;
+    cap->f.stgUpdatePAP    = (F_)__stg_update_PAP;
+}
+
 void 
 initScheduler(void)
 {
@@ -1795,6 +1851,7 @@ initScheduler(void)
     prev = NULL;
     for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
       cap = stgMallocBytes(sizeof(Capability), "initScheduler:capabilities");
+      initCapability(cap);
       cap->link = prev;
       prev = cap;
     }
@@ -1803,6 +1860,8 @@ initScheduler(void)
   }
   IF_DEBUG(scheduler,fprintf(stderr,"scheduler: Allocated %d capabilities\n",
 			     n_free_capabilities););
+#else
+  initCapability(&MainCapability);
 #endif
 
 #if defined(SMP) || defined(PAR)
diff --git a/ghc/rts/Schedule.h b/ghc/rts/Schedule.h
index 00b4de1797..71e84ce675 100644
--- a/ghc/rts/Schedule.h
+++ b/ghc/rts/Schedule.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Schedule.h,v 1.22 2001/03/22 03:51:10 hwloidl Exp $
+ * $Id: Schedule.h,v 1.23 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -124,11 +124,6 @@ extern rtsBool interrupted;
 extern nat timestamp;
 extern nat ticks_since_timestamp;
 
-//@cindex Capability
-/* Capability type
- */
-typedef StgRegTable Capability;
-
 /* Free capability list.
  * Locks required: sched_mutex.
  */
@@ -136,7 +131,7 @@ typedef StgRegTable Capability;
 extern Capability *free_capabilities;
 extern nat n_free_capabilities;
 #else
-extern Capability MainRegTable;
+extern Capability MainCapability;
 #endif
 
 /* Thread queues.
diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index 06286a0996..de36bea1ff 100644
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.68 2001/08/10 09:41:17 simonmar Exp $
+ * $Id: StgMiscClosures.hc,v 1.69 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -12,7 +12,6 @@
 #include "RtsUtils.h"
 #include "RtsFlags.h"
 #include "StgMiscClosures.h"
-#include "HeapStackCheck.h"   /* for stg_gen_yield */
 #include "Storage.h"
 #include "StoragePriv.h"
 #include "Profiling.h"
diff --git a/ghc/rts/StgStdThunks.hc b/ghc/rts/StgStdThunks.hc
index ce56a01304..9373dab228 100644
--- a/ghc/rts/StgStdThunks.hc
+++ b/ghc/rts/StgStdThunks.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgStdThunks.hc,v 1.16 2001/05/31 10:59:14 simonmar Exp $
+ * $Id: StgStdThunks.hc,v 1.17 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -10,7 +10,6 @@
 #include "Stg.h"
 #include "Rts.h"
 #include "StoragePriv.h"
-#include "HeapStackCheck.h"
 
 /* -----------------------------------------------------------------------------
    The code for a thunk that simply extracts a field from a
@@ -159,7 +158,7 @@ FN_(stg_ap_8_upd_entry);
  * in the compiler that means stg_ap_1 is generated occasionally (ToDo)
  */
 
-INFO_TABLE_SRT(stg_ap_1_upd_info,stg_ap_1_upd_entry,1,1,0,0,0,THUNK,,EF_,"stg_ap_1_upd_info","stg_ap_1_upd_info");
+INFO_TABLE_SRT(stg_ap_1_upd_info,stg_ap_1_upd_entry,1,1,0,0,0,THUNK_1_0,,EF_,"stg_ap_1_upd_info","stg_ap_1_upd_info");
 FN_(stg_ap_1_upd_entry) {
   FB_
   STK_CHK_NP(sizeofW(StgUpdateFrame),1,);
@@ -172,7 +171,7 @@ FN_(stg_ap_1_upd_entry) {
   FE_
 }
 
-INFO_TABLE_SRT(stg_ap_2_upd_info,stg_ap_2_upd_entry,2,0,0,0,0,THUNK,,EF_,"stg_ap_2_upd_info","stg_ap_2_upd_info");
+INFO_TABLE_SRT(stg_ap_2_upd_info,stg_ap_2_upd_entry,2,0,0,0,0,THUNK_2_0,,EF_,"stg_ap_2_upd_info","stg_ap_2_upd_info");
 FN_(stg_ap_2_upd_entry) {
   FB_
   STK_CHK_NP(sizeofW(StgUpdateFrame)+1,1,);
diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 6b4333d3c4..9080bf624d 100644
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.52 2001/10/18 14:41:01 simonmar Exp $
+ * $Id: Storage.c,v 1.53 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -23,10 +23,6 @@
 #include "Schedule.h"
 #include "StoragePriv.h"
 
-#ifndef SMP
-nat nursery_blocks;		/* number of blocks in the nursery */
-#endif
-
 StgClosure    *caf_list         = NULL;
 
 bdescr *small_alloc_list;	/* allocate()d small objects */
@@ -323,13 +319,12 @@ allocNurseries( void )
      */
   }
 #else /* SMP */
-  nursery_blocks    = RtsFlags.GcFlags.minAllocAreaSize;
-  g0s0->blocks      = allocNursery(NULL, nursery_blocks);
-  g0s0->n_blocks    = nursery_blocks;
+  g0s0->blocks      = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
+  g0s0->n_blocks    = RtsFlags.GcFlags.minAllocAreaSize;
   g0s0->to_blocks   = NULL;
   g0s0->n_to_blocks = 0;
-  MainRegTable.rNursery        = g0s0->blocks;
-  MainRegTable.rCurrentNursery = g0s0->blocks;
+  MainCapability.r.rNursery        = g0s0->blocks;
+  MainCapability.r.rCurrentNursery = g0s0->blocks;
   /* hp, hpLim, hp_bd, to_space etc. aren't used in G0S0 */
 #endif
 }
@@ -360,41 +355,49 @@ resetNurseries( void )
     ASSERT(bd->step == g0s0);
     IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
   }
-  MainRegTable.rNursery = g0s0->blocks;
-  MainRegTable.rCurrentNursery = g0s0->blocks;
+  MainCapability.r.rNursery = g0s0->blocks;
+  MainCapability.r.rCurrentNursery = g0s0->blocks;
 #endif
 }
 
 bdescr *
-allocNursery (bdescr *last_bd, nat blocks)
+allocNursery (bdescr *tail, nat blocks)
 {
   bdescr *bd;
   nat i;
 
-  /* Allocate a nursery */
+  // Allocate a nursery: we allocate fresh blocks one at a time and
+  // cons them on to the front of the list, not forgetting to update
+  // the back pointer on the tail of the list to point to the new block.
   for (i=0; i < blocks; i++) {
     bd = allocBlock();
-    bd->link = last_bd;
+    bd->link = tail;
+    // double-link the nursery: we might need to insert blocks
+    if (tail != NULL) {
+	tail->u.back = bd;
+    }
     bd->step = g0s0;
     bd->gen_no = 0;
     bd->flags = 0;
     bd->free = bd->start;
-    last_bd = bd;
+    tail = bd;
   }
-  return last_bd;
+  tail->u.back = NULL;
+  return tail;
 }
 
 void
 resizeNursery ( nat blocks )
 {
   bdescr *bd;
+  nat nursery_blocks;
 
 #ifdef SMP
   barf("resizeNursery: can't resize in SMP mode");
 #endif
 
+  nursery_blocks = g0s0->n_blocks;
   if (nursery_blocks == blocks) {
-    ASSERT(g0s0->n_blocks == blocks);
     return;
   }
 
@@ -409,15 +412,25 @@ resizeNursery ( nat blocks )
     
     IF_DEBUG(gc, fprintf(stderr, "Decreasing size of nursery to %d blocks\n", 
 			 blocks));
-    for (bd = g0s0->blocks; nursery_blocks > blocks; nursery_blocks--) {
-      next_bd = bd->link;
-      freeGroup(bd);
-      bd = next_bd;
+
+    bd = g0s0->blocks;
+    while (nursery_blocks > blocks) {
+	next_bd = bd->link;
+	next_bd->u.back = NULL;
+	nursery_blocks -= bd->blocks; // might be a large block
+	freeGroup(bd);
+	bd = next_bd;
     }
     g0s0->blocks = bd;
+    // might have gone just under, by freeing a large block, so make
+    // up the difference.
+    if (nursery_blocks < blocks) {
+	g0s0->blocks = allocNursery(g0s0->blocks, blocks-nursery_blocks);
+    }
   }
   
-  g0s0->n_blocks = nursery_blocks = blocks;
+  g0s0->n_blocks = blocks;
+  ASSERT(countBlocks(g0s0->blocks) == g0s0->n_blocks);
 }
 
 /* -----------------------------------------------------------------------------
@@ -642,9 +655,9 @@ calcAllocated( void )
   }
 
 #else /* !SMP */
-  bdescr *current_nursery = MainRegTable.rCurrentNursery;
+  bdescr *current_nursery = MainCapability.r.rCurrentNursery;
 
-  allocated = (nursery_blocks * BLOCK_SIZE_W) + allocated_bytes();
+  allocated = (g0s0->n_blocks * BLOCK_SIZE_W) + allocated_bytes();
   for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
     allocated -= BLOCK_SIZE_W;
   }
@@ -790,7 +803,8 @@ memInventory(void)
   ASSERT(total_blocks + free_blocks == mblocks_allocated * BLOCKS_PER_MBLOCK);
 }
 
-static nat
+
+nat
 countBlocks(bdescr *bd)
 {
     nat n;
@@ -813,13 +827,13 @@ checkSanity( void )
 	
 	for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 	    for (s = 0; s < generations[g].n_steps; s++) {
-		if (g == 0 && s == 0) { continue; }
-		checkHeap(generations[g].steps[s].blocks);
-		checkChain(generations[g].steps[s].large_objects);
 		ASSERT(countBlocks(generations[g].steps[s].blocks)
 		       == generations[g].steps[s].n_blocks);
 		ASSERT(countBlocks(generations[g].steps[s].large_objects)
 		       == generations[g].steps[s].n_large_blocks);
+		if (g == 0 && s == 0) { continue; }
+		checkHeap(generations[g].steps[s].blocks);
+		checkChain(generations[g].steps[s].large_objects);
 		if (g > 0) {
 		    checkMutableList(generations[g].mut_list, g);
 		    checkMutOnceList(generations[g].mut_once_list, g);
diff --git a/ghc/rts/StoragePriv.h b/ghc/rts/StoragePriv.h
index 0b0907fa27..033b06cf42 100644
--- a/ghc/rts/StoragePriv.h
+++ b/ghc/rts/StoragePriv.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StoragePriv.h,v 1.18 2001/10/19 09:41:11 sewardj Exp $
+ * $Id: StoragePriv.h,v 1.19 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -40,7 +40,6 @@ extern StgPtr alloc_HpLim;
 
 extern bdescr *nursery;
 
-extern nat nursery_blocks;
 extern nat alloc_blocks;
 extern nat alloc_blocks_lim;
 
@@ -77,6 +76,7 @@ dbl_link_onto(bdescr *bd, bdescr **list)
 #ifdef DEBUG
 extern void memInventory(void);
 extern void checkSanity(void);
+extern nat  countBlocks(bdescr *);
 #endif
 
 /* 
diff --git a/ghc/rts/Updates.hc b/ghc/rts/Updates.hc
index 6f0250f6c4..989ce2f90e 100644
--- a/ghc/rts/Updates.hc
+++ b/ghc/rts/Updates.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Updates.hc,v 1.34 2001/07/24 06:31:36 ken Exp $
+ * $Id: Updates.hc,v 1.35 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -11,7 +11,6 @@
 #include "Rts.h"
 #include "RtsUtils.h"
 #include "RtsFlags.h"
-#include "HeapStackCheck.h"
 #include "Storage.h"
 #if defined(GRAN) || defined(PAR)
 # include "FetchMe.h"
@@ -230,7 +229,7 @@ STGFUN(stg_PAP_entry)
    This function is called whenever an argument satisfaction check fails.
    -------------------------------------------------------------------------- */
 
-EXTFUN(stg_update_PAP)
+EXTFUN(__stg_update_PAP)
 {
   nat Words, PapSize;
 #ifdef PROFILING