[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.

1 files changed, 19 insertions, 19 deletions

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 */