Rts: Consistently use StgWord for sizes of bitmaps
[ghc.git] / rts / sm / Compact.c
index eceaba4..3731dd6 100644 (file)
@@ -7,13 +7,14 @@
  * Documentation on the architecture of the Garbage Collector can be
  * found in the online commentary:
  * 
- *   http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
+ *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
  *
  * ---------------------------------------------------------------------------*/
 
 #include "PosixSource.h"
 #include "Rts.h"
 
+#include "GCThread.h"
 #include "Storage.h"
 #include "RtsUtils.h"
 #include "BlockAlloc.h"
@@ -182,7 +183,7 @@ loop:
 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
 // Remember, the two regions *might* overlap, but: to <= from.
 STATIC_INLINE void
-move(StgPtr to, StgPtr from, nat size)
+move(StgPtr to, StgPtr from, StgWord size)
 {
     for(; size > 0; --size) {
        *to++ = *from++;
@@ -224,9 +225,9 @@ thread_static( StgClosure* p )
 }
 
 STATIC_INLINE void
-thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
+thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, StgWord size )
 {
-    nat i, b;
+    W_ i, b;
     StgWord bitmap;
 
     b = 0;
@@ -251,7 +252,7 @@ thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
 {
     StgPtr p;
     StgWord bitmap;
-    nat size;
+    StgWord size;
 
     p = (StgPtr)args;
     switch (fun_info->f.fun_type) {
@@ -286,7 +287,7 @@ thread_stack(StgPtr p, StgPtr stack_end)
 {
     const StgRetInfoTable* info;
     StgWord bitmap;
-    nat size;
+    StgWord size;
     
     // highly similar to scavenge_stack, but we do pointer threading here.
     
@@ -300,37 +301,7 @@ thread_stack(StgPtr p, StgPtr stack_end)
        
        switch (info->i.type) {
            
-           // Dynamic bitmap: the mask is stored on the stack 
-       case RET_DYN:
-       {
-           StgWord dyn;
-           dyn = ((StgRetDyn *)p)->liveness;
-
-           // traverse the bitmap first
-           bitmap = RET_DYN_LIVENESS(dyn);
-           p      = (P_)&((StgRetDyn *)p)->payload[0];
-           size   = RET_DYN_BITMAP_SIZE;
-           while (size > 0) {
-               if ((bitmap & 1) == 0) {
-                   thread((StgClosure **)p);
-               }
-               p++;
-               bitmap = bitmap >> 1;
-               size--;
-           }
-           
-           // skip over the non-ptr words
-           p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
-           
-           // follow the ptr words
-           for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
-               thread((StgClosure **)p);
-               p++;
-           }
-           continue;
-       }
-           
-           // small bitmap (<= 32 entries, or 64 on a 64-bit machine) 
+            // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
         case CATCH_RETRY_FRAME:
         case CATCH_STM_FRAME:
         case ATOMICALLY_FRAME:
@@ -356,7 +327,6 @@ thread_stack(StgPtr p, StgPtr stack_end)
 
        case RET_BCO: {
            StgBCO *bco;
-           nat size;
            
            p++;
            bco = (StgBCO *)*p;
@@ -381,7 +351,7 @@ thread_stack(StgPtr p, StgPtr stack_end)
            StgRetFun *ret_fun = (StgRetFun *)p;
            StgFunInfoTable *fun_info;
            
-           fun_info = FUN_INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)
+           fun_info = FUN_INFO_PTR_TO_STRUCT((StgInfoTable *)UNTAG_CLOSURE((StgClosure *)
                            get_threaded_info((StgPtr)ret_fun->fun)));
                 // *before* threading it!
            thread(&ret_fun->fun);
@@ -403,7 +373,7 @@ thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
     StgWord bitmap;
     StgFunInfoTable *fun_info;
 
-    fun_info = FUN_INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)
+    fun_info = FUN_INFO_PTR_TO_STRUCT((StgInfoTable *)UNTAG_CLOSURE((StgClosure *)
                         get_threaded_info((StgPtr)fun)));
     ASSERT(fun_info->i.type != PAP);
 
@@ -471,9 +441,11 @@ thread_TSO (StgTSO *tso)
     thread_(&tso->global_link);
 
     if (   tso->why_blocked == BlockedOnMVar
+        || tso->why_blocked == BlockedOnMVarRead
        || tso->why_blocked == BlockedOnBlackHole
        || tso->why_blocked == BlockedOnMsgThrowTo
-       ) {
+        || tso->why_blocked == NotBlocked
+        ) {
        thread_(&tso->block_info.closure);
     }
     thread_(&tso->blocked_exceptions);
@@ -522,6 +494,21 @@ update_fwd_large( bdescr *bd )
           continue;
       }
 
+    case SMALL_MUT_ARR_PTRS_CLEAN:
+    case SMALL_MUT_ARR_PTRS_DIRTY:
+    case SMALL_MUT_ARR_PTRS_FROZEN:
+    case SMALL_MUT_ARR_PTRS_FROZEN0:
+      // follow everything 
+      {
+          StgSmallMutArrPtrs *a;
+
+          a = (StgSmallMutArrPtrs*)p;
+          for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) {
+              thread((StgClosure **)p);
+          }
+          continue;
+      }
+
     case STACK:
     {
         StgStack *stack = (StgStack*)p;
@@ -631,6 +618,7 @@ thread_obj (StgInfoTable *info, StgPtr p)
     case MUT_PRIM:
     case MUT_VAR_CLEAN:
     case MUT_VAR_DIRTY:
+    case TVAR:
     case BLACKHOLE:
     case BLOCKING_QUEUE:
     {
@@ -647,7 +635,7 @@ thread_obj (StgInfoTable *info, StgPtr p)
     case WEAK:
     {
        StgWeak *w = (StgWeak *)p;
-       thread(&w->cfinalizer);
+       thread(&w->cfinalizers);
        thread(&w->key);
        thread(&w->value);
        thread(&w->finalizer);
@@ -706,6 +694,22 @@ thread_obj (StgInfoTable *info, StgPtr p)
 
        return (StgPtr)a + mut_arr_ptrs_sizeW(a);
     }
+
+    case SMALL_MUT_ARR_PTRS_CLEAN:
+    case SMALL_MUT_ARR_PTRS_DIRTY:
+    case SMALL_MUT_ARR_PTRS_FROZEN:
+    case SMALL_MUT_ARR_PTRS_FROZEN0:
+       // follow everything 
+    {
+        StgSmallMutArrPtrs *a;
+
+        a = (StgSmallMutArrPtrs *)p;
+       for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) {
+           thread((StgClosure **)p);
+       }
+
+       return (StgPtr)a + small_mut_arr_ptrs_sizeW(a);
+    }
     
     case TSO:
        return thread_TSO((StgTSO *)p);
@@ -768,7 +772,7 @@ update_fwd_compact( bdescr *blocks )
 #endif
     bdescr *bd, *free_bd;
     StgInfoTable *info;
-    nat size;
+    StgWord size;
     StgWord iptr;
 
     bd = blocks;
@@ -816,7 +820,7 @@ update_fwd_compact( bdescr *blocks )
             // that if (p&BLOCK_MASK) >= (free&BLOCK_MASK), then we
             // definitely have enough room.  Also see bug #1147.
             iptr = get_threaded_info(p);
-           info = INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)iptr));
+           info = INFO_PTR_TO_STRUCT((StgInfoTable *)UNTAG_CLOSURE((StgClosure *)iptr));
 
            q = p;
 
@@ -844,7 +848,7 @@ update_fwd_compact( bdescr *blocks )
     }
 }
 
-static nat
+static W_
 update_bkwd_compact( generation *gen )
 {
     StgPtr p, free;
@@ -853,7 +857,8 @@ update_bkwd_compact( generation *gen )
 #endif
     bdescr *bd, *free_bd;
     StgInfoTable *info;
-    nat size, free_blocks;
+    StgWord size;
+    W_ free_blocks;
     StgWord iptr;
 
     bd = free_bd = gen->old_blocks;
@@ -935,27 +940,31 @@ update_bkwd_compact( generation *gen )
 void
 compact(StgClosure *static_objects)
 {
-    nat g, blocks;
+    W_ n, g, blocks;
     generation *gen;
 
     // 1. thread the roots
     markCapabilities((evac_fn)thread_root, NULL);
 
+    markScheduler((evac_fn)thread_root, NULL);
+
     // the weak pointer lists...
-    if (weak_ptr_list != NULL) {
-       thread((void *)&weak_ptr_list);
+    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+        if (generations[g].weak_ptr_list != NULL) {
+            thread((void *)&generations[g].weak_ptr_list);
+        }
     }
-    if (old_weak_ptr_list != NULL) {
-       thread((void *)&old_weak_ptr_list); // tmp
+
+    if (dead_weak_ptr_list != NULL) {
+        thread((void *)&dead_weak_ptr_list); // tmp
     }
 
     // mutable lists
     for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
-       bdescr *bd;
-       StgPtr p;
-        nat n;
+        bdescr *bd;
+        StgPtr p;
         for (n = 0; n < n_capabilities; n++) {
-            for (bd = capabilities[n].mut_lists[g]; 
+            for (bd = capabilities[n]->mut_lists[g];
                  bd != NULL; bd = bd->link) {
                 for (p = bd->start; p < bd->free; p++) {
                     thread((StgClosure **)p);
@@ -976,7 +985,7 @@ compact(StgClosure *static_objects)
     {
        Task *task;
         InCall *incall;
-       for (task = all_tasks; task != NULL; task = task->all_link) {
+        for (task = all_tasks; task != NULL; task = task->all_next) {
             for (incall = task->incall; incall != NULL; 
                  incall = incall->prev_stack) {
                 if (incall->tso) {
@@ -990,7 +999,7 @@ compact(StgClosure *static_objects)
     thread_static(static_objects /* ToDo: ok? */);
 
     // the stable pointer table
-    threadStablePtrTable((evac_fn)thread_root, NULL);
+    threadStableTables((evac_fn)thread_root, NULL);
 
     // the CAF list (used by GHCi)
     markCAFs((evac_fn)thread_root, NULL);
@@ -1001,6 +1010,10 @@ compact(StgClosure *static_objects)
         debugTrace(DEBUG_gc, "update_fwd:  %d", g);
 
         update_fwd(gen->blocks);
+        for (n = 0; n < n_capabilities; n++) {
+            update_fwd(gc_threads[n]->gens[g].todo_bd);
+            update_fwd(gc_threads[n]->gens[g].part_list);
+        }
         update_fwd_large(gen->scavenged_large_objects);
         if (g == RtsFlags.GcFlags.generations-1 && gen->old_blocks != NULL) {
             debugTrace(DEBUG_gc, "update_fwd:  %d (compact)", g);