[project @ 2005-04-12 09:04:23 by simonmar]

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

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index ea88b21..7074a53 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -11,6 +11,7 @@
 #include "RtsFlags.h"
 #include "RtsUtils.h"
 #include "Apply.h"
+#include "OSThreads.h"
 #include "Storage.h"
 #include "LdvProfile.h"
 #include "Updates.h"
@@ -46,6 +47,12 @@
 
 #include <string.h>
 
+// Turn off inlining when debugging - it obfuscates things
+#ifdef DEBUG
+# undef  STATIC_INLINE
+# define STATIC_INLINE static
+#endif
+
 /* STATIC OBJECT LIST.
  *
  * During GC:
@@ -977,7 +984,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
        blocks = RtsFlags.GcFlags.minAllocAreaSize;
       }
     }
-    resizeNursery(blocks);
+    resizeNurseries(blocks);
     
   } else {
     /* Generational collector:
@@ -994,7 +1001,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
        * percentage of g0s0 that was live at the last minor GC.
        */
       if (N == 0) {
-       g0s0_pcnt_kept = (new_blocks * 100) / g0s0->n_blocks;
+       g0s0_pcnt_kept = (new_blocks * 100) / countNurseryBlocks();
       }
 
       /* Estimate a size for the allocation area based on the
@@ -1017,12 +1024,12 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
        blocks = RtsFlags.GcFlags.minAllocAreaSize;
       }
       
-      resizeNursery((nat)blocks);
+      resizeNurseries((nat)blocks);
 
     } else {
       // we might have added extra large blocks to the nursery, so
       // resize back to minAllocAreaSize again.
-      resizeNursery(RtsFlags.GcFlags.minAllocAreaSize);
+      resizeNurseries(RtsFlags.GcFlags.minAllocAreaSize);
     }
   }
 
@@ -1624,7 +1631,9 @@ evacuate_large(StgPtr p)
 REGPARM1 static StgClosure *
 evacuate(StgClosure *q)
 {
+#if defined(PAR)
   StgClosure *to;
+#endif
   bdescr *bd = NULL;
   step *stp;
   const StgInfoTable *info;
@@ -1755,10 +1764,6 @@ loop:
   case BLACKHOLE:
     return copyPart(q,BLACKHOLE_sizeW(),sizeofW(StgHeader),stp);
 
-  case BLACKHOLE_BQ:
-    to = copy(q,BLACKHOLE_sizeW(),stp); 
-    return to;
-
   case THUNK_SELECTOR:
     {
        StgClosure *p;
@@ -1919,7 +1924,7 @@ loop:
     }
 
 #if defined(PAR)
-  case RBH: // cf. BLACKHOLE_BQ
+  case RBH:
     {
       //StgInfoTable *rip = get_closure_info(q, &size, &ptrs, &nonptrs, &vhs, str);
       to = copy(q,BLACKHOLE_sizeW(),stp); 
@@ -2167,7 +2172,6 @@ selector_loop:
       case SE_CAF_BLACKHOLE:
       case SE_BLACKHOLE:
       case BLACKHOLE:
-      case BLACKHOLE_BQ:
 #if defined(PAR)
       case RBH:
       case BLOCKED_FETCH:
@@ -2614,16 +2618,6 @@ scavenge(step *stp)
        p += BLACKHOLE_sizeW();
        break;
 
-    case BLACKHOLE_BQ:
-    { 
-       StgBlockingQueue *bh = (StgBlockingQueue *)p;
-       bh->blocking_queue = 
-           (StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
-       failed_to_evac = rtsTrue;
-       p += BLACKHOLE_sizeW();
-       break;
-    }
-
     case THUNK_SELECTOR:
     { 
        StgSelector *s = (StgSelector *)p;
@@ -2697,7 +2691,7 @@ scavenge(step *stp)
     }
 
 #if defined(PAR)
-    case RBH: // cf. BLACKHOLE_BQ
+    case RBH:
     { 
 #if 0
        nat size, ptrs, nonptrs, vhs;
@@ -2740,7 +2734,7 @@ scavenge(step *stp)
        p += sizeofW(StgFetchMe);
        break; // nothing to do in this case
 
-    case FETCH_ME_BQ: // cf. BLACKHOLE_BQ
+    case FETCH_ME_BQ:
     { 
        StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
        (StgClosure *)fmbq->blocking_queue = 
@@ -2969,15 +2963,6 @@ linear_scan:
        case ARR_WORDS:
            break;
 
-       case BLACKHOLE_BQ:
-       { 
-           StgBlockingQueue *bh = (StgBlockingQueue *)p;
-           bh->blocking_queue = 
-               (StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
-           failed_to_evac = rtsTrue;
-           break;
-       }
-
        case THUNK_SELECTOR:
        { 
            StgSelector *s = (StgSelector *)p;
@@ -3039,7 +3024,7 @@ linear_scan:
        }
 
 #if defined(PAR)
-       case RBH: // cf. BLACKHOLE_BQ
+       case RBH:
        { 
 #if 0
            nat size, ptrs, nonptrs, vhs;
@@ -3078,7 +3063,7 @@ linear_scan:
        case FETCH_ME:
            break; // nothing to do in this case
 
-       case FETCH_ME_BQ: // cf. BLACKHOLE_BQ
+       case FETCH_ME_BQ:
        { 
            StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
            (StgClosure *)fmbq->blocking_queue = 
@@ -3271,16 +3256,6 @@ scavenge_one(StgPtr p)
     case BLACKHOLE:
        break;
        
-    case BLACKHOLE_BQ:
-    { 
-       StgBlockingQueue *bh = (StgBlockingQueue *)p;
-       evac_gen = 0;           // repeatedly mutable 
-       bh->blocking_queue = 
-           (StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
-       failed_to_evac = rtsTrue;
-       break;
-    }
-
     case THUNK_SELECTOR:
     { 
        StgSelector *s = (StgSelector *)p;
@@ -3347,7 +3322,7 @@ scavenge_one(StgPtr p)
     }
   
 #if defined(PAR)
-    case RBH: // cf. BLACKHOLE_BQ
+    case RBH:
     { 
 #if 0
        nat size, ptrs, nonptrs, vhs;
@@ -3387,7 +3362,7 @@ scavenge_one(StgPtr p)
     case FETCH_ME:
        break; // nothing to do in this case
 
-    case FETCH_ME_BQ: // cf. BLACKHOLE_BQ
+    case FETCH_ME_BQ:
     { 
        StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
        (StgClosure *)fmbq->blocking_queue = 
@@ -3941,7 +3916,7 @@ threadLazyBlackHole(StgTSO *tso)
 {
     StgClosure *frame;
     StgRetInfoTable *info;
-    StgBlockingQueue *bh;
+    StgClosure *bh;
     StgPtr stack_end;
     
     stack_end = &tso->stack[tso->stack_size];
@@ -3954,7 +3929,7 @@ threadLazyBlackHole(StgTSO *tso)
        switch (info->i.type) {
            
        case UPDATE_FRAME:
-           bh = (StgBlockingQueue *)((StgUpdateFrame *)frame)->updatee;
+           bh = ((StgUpdateFrame *)frame)->updatee;
            
            /* if the thunk is already blackholed, it means we've also
             * already blackholed the rest of the thunks on this stack,
@@ -3967,10 +3942,9 @@ threadLazyBlackHole(StgTSO *tso)
                return;
            }
            
-           if (bh->header.info != &stg_BLACKHOLE_BQ_info &&
-               bh->header.info != &stg_CAF_BLACKHOLE_info) {
+           if (bh->header.info != &stg_CAF_BLACKHOLE_info) {
 #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
-               debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh);
+               debugBelch("Unexpected lazy BHing required at 0x%04x\n",(int)bh);
 #endif
 #ifdef PROFILING
                // @LDV profiling
@@ -4072,7 +4046,6 @@ threadSqueezeStack(StgTSO *tso)
                 * screw us up if we don't check.
                 */
                if (upd->updatee != updatee && !closure_IND(upd->updatee)) {
-                   // this wakes the threads up 
                    UPD_IND_NOLOCK(upd->updatee, updatee);
                }
 
@@ -4090,11 +4063,10 @@ threadSqueezeStack(StgTSO *tso)
 
            // single update frame, or the topmost update frame in a series
            else {
-               StgBlockingQueue *bh = (StgBlockingQueue *)upd->updatee;
+               StgClosure *bh = upd->updatee;
 
                // Do lazy black-holing
                if (bh->header.info != &stg_BLACKHOLE_info &&
-                   bh->header.info != &stg_BLACKHOLE_BQ_info &&
                    bh->header.info != &stg_CAF_BLACKHOLE_info) {
 #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
                    debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh);