rts: enable parallel GC scan of large (32M+) allocation area
[ghc.git] / rts / RetainerProfile.c
index 78daa89..6cd9c89 100644 (file)
  * Declarations...
  * -------------------------------------------------------------------------- */
 
-static nat retainerGeneration;  // generation
+static uint32_t retainerGeneration;  // generation
 
-static nat numObjectVisited;    // total number of objects visited
-static nat timesAnyObjectVisited; // number of times any objects are visited
+static uint32_t numObjectVisited;    // total number of objects visited
+static uint32_t timesAnyObjectVisited;  // number of times any objects are
+                                        // visited
 
 /*
   The rs field in the profile header of any object points to its retainer
@@ -79,18 +80,18 @@ static void belongToHeap(StgPtr p);
   Invariants:
     cStackSize <= maxCStackSize
  */
-static nat cStackSize, maxCStackSize;
+static uint32_t cStackSize, maxCStackSize;
 
-static nat sumOfNewCost;        // sum of the cost of each object, computed
+static uint32_t sumOfNewCost;        // sum of the cost of each object, computed
                                 // when the object is first visited
-static nat sumOfNewCostExtra;   // for those objects not visited during
+static uint32_t sumOfNewCostExtra;   // for those objects not visited during
                                 // retainer profiling, e.g., MUT_VAR
-static nat costArray[N_CLOSURE_TYPES];
+static uint32_t costArray[N_CLOSURE_TYPES];
 
-nat sumOfCostLinear;            // sum of the costs of all object, computed
+uint32_t sumOfCostLinear;            // sum of the costs of all object, computed
                                 // when linearly traversing the heap after
                                 // retainer profiling
-nat costArrayLinear[N_CLOSURE_TYPES];
+uint32_t costArrayLinear[N_CLOSURE_TYPES];
 #endif
 
 /* -----------------------------------------------------------------------------
@@ -116,14 +117,9 @@ typedef union {
 
     // layout.payload
     struct {
-    // See StgClosureInfo in InfoTables.h
-#if SIZEOF_VOID_P == 8
-        StgWord32 pos;
-        StgWord32 ptrs;
-#else
-        StgWord16 pos;
-        StgWord16 ptrs;
-#endif
+        // See StgClosureInfo in InfoTables.h
+        StgHalfWord pos;
+        StgHalfWord ptrs;
         StgPtr payload;
     } ptrs;
 
@@ -301,7 +297,7 @@ isOnBoundary( void )
  *   payload[] begins with ptrs pointers followed by non-pointers.
  * -------------------------------------------------------------------------- */
 static INLINE void
-init_ptrs( stackPos *info, nat ptrs, StgPtr payload )
+init_ptrs( stackPos *info, uint32_t ptrs, StgPtr payload )
 {
     info->type              = posTypePtrs;
     info->next.ptrs.pos     = 0;
@@ -388,7 +384,7 @@ find_srt( stackPos *info )
     }
     else {
         // Large SRT bitmap
-        nat i = info->next.large_srt.offset;
+        uint32_t i = info->next.large_srt.offset;
         StgWord bitmap;
 
         // Follow the pattern from GC.c:scavenge_large_srt_bitmap().
@@ -455,6 +451,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
     case CONSTR_0_1:
     case CONSTR_0_2:
     case ARR_WORDS:
+    case COMPACT_NFDATA:
         *first_child = NULL;
         return;
 
@@ -466,7 +463,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
     case THUNK_SELECTOR:
         *first_child = ((StgSelector *)c)->selectee;
         return;
-    case IND_PERM:
     case BLACKHOLE:
         *first_child = ((StgInd *)c)->indirectee;
         return;
@@ -837,8 +833,8 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
             // which field, and the rest of the bits indicate the
             // entry number (starting from zero).
             TRecEntry *entry;
-            nat entry_no = se->info.next.step >> 2;
-            nat field_no = se->info.next.step & 3;
+            uint32_t entry_no = se->info.next.step >> 2;
+            uint32_t field_no = se->info.next.step & 3;
             if (entry_no == ((StgTRecChunk *)se->c)->next_entry_idx) {
                 *c = NULL;
                 popOff();
@@ -934,7 +930,6 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
         case MUT_VAR_CLEAN:
         case MUT_VAR_DIRTY:
         case THUNK_SELECTOR:
-        case IND_PERM:
         case CONSTR_1_1:
             // cannot appear
         case PAP:
@@ -1070,7 +1065,6 @@ isRetainer( StgClosure *c )
         // partial applications
     case PAP:
         // indirection
-    case IND_PERM:
     // IND_STATIC used to be an error, but at the moment it can happen
     // as isAlive doesn't look through IND_STATIC as it ignores static
     // closures. See trac #3956 for a program that hit this error.
@@ -1165,10 +1159,10 @@ associate( StgClosure *c, RetainerSet *s )
    -------------------------------------------------------------------------- */
 
 static void
-retain_large_bitmap (StgPtr p, StgLargeBitmap *large_bitmap, nat size,
+retain_large_bitmap (StgPtr p, StgLargeBitmap *large_bitmap, uint32_t size,
                      StgClosure *c, retainer c_child_r)
 {
-    nat i, b;
+    uint32_t i, b;
     StgWord bitmap;
 
     b = 0;
@@ -1189,7 +1183,7 @@ retain_large_bitmap (StgPtr p, StgLargeBitmap *large_bitmap, nat size,
 }
 
 static INLINE StgPtr
-retain_small_bitmap (StgPtr p, nat size, StgWord bitmap,
+retain_small_bitmap (StgPtr p, uint32_t size, StgWord bitmap,
                      StgClosure *c, retainer c_child_r)
 {
     while (size > 0) {
@@ -1210,7 +1204,7 @@ retain_small_bitmap (StgPtr p, nat size, StgWord bitmap,
 static void
 retain_large_srt_bitmap (StgLargeSRT *srt, StgClosure *c, retainer c_child_r)
 {
-    nat i, b, size;
+    uint32_t i, b, size;
     StgWord bitmap;
     StgClosure **p;
 
@@ -1234,9 +1228,10 @@ retain_large_srt_bitmap (StgLargeSRT *srt, StgClosure *c, retainer c_child_r)
 }
 
 static INLINE void
-retainSRT (StgClosure **srt, nat srt_bitmap, StgClosure *c, retainer c_child_r)
+retainSRT (StgClosure **srt, uint32_t srt_bitmap, StgClosure *c,
+            retainer c_child_r)
 {
-  nat bitmap;
+  uint32_t bitmap;
   StgClosure **p;
 
   bitmap = srt_bitmap;
@@ -1291,7 +1286,7 @@ retainStack( StgClosure *c, retainer c_child_r,
     StgPtr p;
     StgRetInfoTable *info;
     StgWord bitmap;
-    nat size;
+    uint32_t size;
 
 #ifdef DEBUG_RETAINER
     cStackSize++;
@@ -1368,7 +1363,7 @@ retainStack( StgClosure *c, retainer c_child_r,
             StgFunInfoTable *fun_info;
 
             retainClosure(ret_fun->fun, c, c_child_r);
-            fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
+            fun_info = get_fun_itbl(UNTAG_CONST_CLOSURE(ret_fun->fun));
 
             p = (P_)&ret_fun->payload;
             switch (fun_info->f.fun_type) {
@@ -1767,7 +1762,7 @@ computeRetainerSet( void )
 {
     StgWeak *weak;
     RetainerSet *rtl;
-    nat g, n;
+    uint32_t g, n;
     StgPtr ml;
     bdescr *bd;
 #ifdef DEBUG_RETAINER
@@ -1873,7 +1868,7 @@ void
 resetStaticObjectForRetainerProfiling( StgClosure *static_objects )
 {
 #ifdef DEBUG_RETAINER
-    nat count;
+    uint32_t count;
 #endif
     StgClosure *p;
 
@@ -1881,7 +1876,8 @@ resetStaticObjectForRetainerProfiling( StgClosure *static_objects )
     count = 0;
 #endif
     p = static_objects;
-    while (p != END_OF_STATIC_LIST) {
+    while (p != END_OF_STATIC_OBJECT_LIST) {
+        p = UNTAG_STATIC_LIST_PTR(p);
 #ifdef DEBUG_RETAINER
         count++;
 #endif
@@ -1928,8 +1924,8 @@ void
 retainerProfile(void)
 {
 #ifdef DEBUG_RETAINER
-  nat i;
-  nat totalHeapSize;        // total raw heap size (computed by linear scanning)
+  uint32_t i;
+  uint32_t totalHeapSize;   // total raw heap size (computed by linear scanning)
 #endif
 
 #ifdef DEBUG_RETAINER
@@ -2065,13 +2061,11 @@ retainerProfile(void)
 
 #define LOOKS_LIKE_PTR(r) ((LOOKS_LIKE_STATIC_CLOSURE(r) || \
         ((HEAP_ALLOCED(r) && ((Bdescr((P_)r)->flags & BF_FREE) == 0)))) && \
-        ((StgWord)(*(StgPtr)r)!=0xaaaaaaaa))
+        ((StgWord)(*(StgPtr)r)!=(StgWord)0xaaaaaaaaaaaaaaaaULL))
 
-static nat
+static uint32_t
 sanityCheckHeapClosure( StgClosure *c )
 {
-    StgInfoTable *info;
-
     ASSERT(LOOKS_LIKE_GHC_INFO(c->header.info));
     ASSERT(!closure_STATIC(c));
     ASSERT(LOOKS_LIKE_PTR(c));
@@ -2096,11 +2090,11 @@ sanityCheckHeapClosure( StgClosure *c )
     return closure_sizeW(c);
 }
 
-static nat
+static uint32_t
 heapCheck( bdescr *bd )
 {
     StgPtr p;
-    static nat costSum, size;
+    static uint32_t costSum, size;
 
     costSum = 0;
     while (bd != NULL) {
@@ -2120,12 +2114,12 @@ heapCheck( bdescr *bd )
     return costSum;
 }
 
-static nat
+static uint32_t
 smallObjectPoolCheck(void)
 {
     bdescr *bd;
     StgPtr p;
-    static nat costSum, size;
+    static uint32_t costSum, size;
 
     bd = g0s0->blocks;
     costSum = 0;
@@ -2161,10 +2155,10 @@ smallObjectPoolCheck(void)
     return costSum;
 }
 
-static nat
+static uint32_t
 chainCheck(bdescr *bd)
 {
-    nat costSum, size;
+    uint32_t costSum, size;
 
     costSum = 0;
     while (bd != NULL) {
@@ -2181,10 +2175,10 @@ chainCheck(bdescr *bd)
     return costSum;
 }
 
-static nat
+static uint32_t
 checkHeapSanityForRetainerProfiling( void )
 {
-    nat costSum, g, s;
+    uint32_t costSum, g, s;
 
     costSum = 0;
     debugBelch("START: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
@@ -2225,7 +2219,7 @@ findPointer(StgPtr p)
 {
     StgPtr q, r, e;
     bdescr *bd;
-    nat g, s;
+    uint32_t g, s;
 
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
         for (s = 0; s < generations[g].n_steps; s++) {
@@ -2261,7 +2255,7 @@ static void
 belongToHeap(StgPtr p)
 {
     bdescr *bd;
-    nat g, s;
+    uint32_t g, s;
 
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
         for (s = 0; s < generations[g].n_steps; s++) {