[project @ 2005-04-05 12:19:54 by simonmar]

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

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index a470f32..64cfacd 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"
@@ -434,7 +435,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
          bitmap_size = stp->n_blocks * BLOCK_SIZE / (sizeof(W_)*BITS_PER_BYTE);
 
          if (bitmap_size > 0) {
-             bitmap_bdescr = allocGroup((nat)BLOCK_ROUND_UP(bitmap_size) 
+             bitmap_bdescr = allocGroup((lnat)BLOCK_ROUND_UP(bitmap_size) 
                                         / BLOCK_SIZE);
              stp->bitmap = bitmap_bdescr;
              bitmap = bitmap_bdescr->start;
@@ -1624,7 +1625,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 +1758,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 +1918,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 +2166,6 @@ selector_loop:
       case SE_CAF_BLACKHOLE:
       case SE_BLACKHOLE:
       case BLACKHOLE:
-      case BLACKHOLE_BQ:
 #if defined(PAR)
       case RBH:
       case BLOCKED_FETCH:
@@ -2352,8 +2350,8 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
     p = (StgPtr)args;
     switch (fun_info->f.fun_type) {
     case ARG_GEN:
-       bitmap = BITMAP_BITS(fun_info->f.bitmap);
-       size = BITMAP_SIZE(fun_info->f.bitmap);
+       bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
+       size = BITMAP_SIZE(fun_info->f.b.bitmap);
        goto small_bitmap;
     case ARG_GEN_BIG:
        size = GET_FUN_LARGE_BITMAP(fun_info)->size;
@@ -2393,7 +2391,7 @@ scavenge_PAP (StgPAP *pap)
 
     switch (fun_info->f.fun_type) {
     case ARG_GEN:
-       bitmap = BITMAP_BITS(fun_info->f.bitmap);
+       bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
        goto small_bitmap;
     case ARG_GEN_BIG:
        scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
@@ -2614,16 +2612,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 +2685,7 @@ scavenge(step *stp)
     }
 
 #if defined(PAR)
-    case RBH: // cf. BLACKHOLE_BQ
+    case RBH:
     { 
 #if 0
        nat size, ptrs, nonptrs, vhs;
@@ -2740,7 +2728,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 +2957,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 +3018,7 @@ linear_scan:
        }
 
 #if defined(PAR)
-       case RBH: // cf. BLACKHOLE_BQ
+       case RBH:
        { 
 #if 0
            nat size, ptrs, nonptrs, vhs;
@@ -3078,7 +3057,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 = 
@@ -3088,7 +3067,7 @@ linear_scan:
                           p, info_type((StgClosure *)p)));
            break;
        }
-#endif // PAR
+#endif /* PAR */
 
        case TVAR_WAIT_QUEUE:
          {
@@ -3271,16 +3250,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 +3316,7 @@ scavenge_one(StgPtr p)
     }
   
 #if defined(PAR)
-    case RBH: // cf. BLACKHOLE_BQ
+    case RBH:
     { 
 #if 0
        nat size, ptrs, nonptrs, vhs;
@@ -3387,7 +3356,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 = 
@@ -3849,14 +3818,14 @@ revertCAFs( void )
 {
     StgIndStatic *c;
 
-    for (c = (StgIndStatic *)caf_list; c != NULL; 
+    for (c = (StgIndStatic *)revertible_caf_list; c != NULL; 
         c = (StgIndStatic *)c->static_link) 
     {
        SET_INFO(c, c->saved_info);
        c->saved_info = NULL;
        // could, but not necessary: c->static_link = NULL; 
     }
-    caf_list = NULL;
+    revertible_caf_list = NULL;
 }
 
 void
@@ -3869,6 +3838,11 @@ markCAFs( evac_fn evac )
     {
        evac(&c->indirectee);
     }
+    for (c = (StgIndStatic *)revertible_caf_list; c != NULL; 
+        c = (StgIndStatic *)c->static_link) 
+    {
+       evac(&c->indirectee);
+    }
 }
 
 /* -----------------------------------------------------------------------------
@@ -3936,7 +3910,7 @@ threadLazyBlackHole(StgTSO *tso)
 {
     StgClosure *frame;
     StgRetInfoTable *info;
-    StgBlockingQueue *bh;
+    StgClosure *bh;
     StgPtr stack_end;
     
     stack_end = &tso->stack[tso->stack_size];
@@ -3949,7 +3923,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,
@@ -3962,8 +3936,7 @@ 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);
 #endif
@@ -4067,7 +4040,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);
                }
 
@@ -4085,11 +4057,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);
@@ -4250,4 +4221,4 @@ maybeLarge(StgClosure *closure)
 }
 
   
-#endif // DEBUG
+#endif /* DEBUG */