[project @ 2005-03-27 13:41:13 by panne]
[ghc-hetmet.git] / ghc / rts / RetainerProfile.c
index e45f875..2461948 100644 (file)
@@ -1,5 +1,4 @@
 /* -----------------------------------------------------------------------------
- * $Id: RetainerProfile.c,v 1.12 2004/09/03 15:28:38 simonmar Exp $
  *
  * (c) The GHC Team, 2001
  * Author: Sungwoo Park
@@ -330,11 +329,11 @@ init_srt_fun( stackPos *info, StgFunInfoTable *infoTable )
 {
     if (infoTable->i.srt_bitmap == (StgHalfWord)(-1)) {
        info->type = posTypeLargeSRT;
-       info->next.large_srt.srt = (StgLargeSRT *)infoTable->f.srt;
+       info->next.large_srt.srt = (StgLargeSRT *)GET_FUN_SRT(infoTable);
        info->next.large_srt.offset = 0;
     } else {
        info->type = posTypeSRT;
-       info->next.srt.srt = (StgClosure **)(infoTable->f.srt);
+       info->next.srt.srt = (StgClosure **)GET_FUN_SRT(infoTable);
        info->next.srt.srt_bitmap = infoTable->i.srt_bitmap;
     }
 }
@@ -344,11 +343,11 @@ init_srt_thunk( stackPos *info, StgThunkInfoTable *infoTable )
 {
     if (infoTable->i.srt_bitmap == (StgHalfWord)(-1)) {
        info->type = posTypeLargeSRT;
-       info->next.large_srt.srt = (StgLargeSRT *)infoTable->srt;
+       info->next.large_srt.srt = (StgLargeSRT *)GET_SRT(infoTable);
        info->next.large_srt.offset = 0;
     } else {
        info->type = posTypeSRT;
-       info->next.srt.srt = (StgClosure **)(infoTable->srt);
+       info->next.srt.srt = (StgClosure **)GET_SRT(infoTable);
        info->next.srt.srt_bitmap = infoTable->i.srt_bitmap;
     }
 }
@@ -465,7 +464,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 
        // one child (fixed), no SRT
     case MUT_VAR:
-    case MUT_CONS:
        *first_child = ((StgMutVar *)c)->var;
        return;
     case BLACKHOLE_BQ:
@@ -479,7 +477,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
     case IND_PERM:
     case IND_OLDGEN_PERM:
     case IND_OLDGEN:
-       *first_child = ((StgIndOldGen *)c)->indirectee;
+       *first_child = ((StgInd *)c)->indirectee;
        return;
     case CONSTR_1_0:
     case CONSTR_1_1:
@@ -896,7 +894,6 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
        case ARR_WORDS:
            // one child (fixed), no SRT
        case MUT_VAR:
-       case MUT_CONS:
        case BLACKHOLE_BQ:
        case THUNK_SELECTOR:
        case IND_PERM:
@@ -998,7 +995,6 @@ isRetainer( StgClosure *c )
        // mutable objects
     case MVAR:
     case MUT_VAR:
-    case MUT_CONS:
     case MUT_ARR_PTRS:
     case MUT_ARR_PTRS_FROZEN:
 
@@ -1320,7 +1316,7 @@ retainStack( StgClosure *c, retainer c_child_r,
            p = retain_small_bitmap(p, size, bitmap, c, c_child_r);
 
        follow_srt:
-           retainSRT((StgClosure **)info->srt, info->i.srt_bitmap, c, c_child_r);
+           retainSRT((StgClosure **)GET_SRT(info), info->i.srt_bitmap, c, c_child_r);
            continue;
 
        case RET_BCO: {
@@ -1339,9 +1335,9 @@ retainStack( StgClosure *c, retainer c_child_r,
            // large bitmap (> 32 entries, or > 64 on a 64-bit machine) 
        case RET_BIG:
        case RET_VEC_BIG:
-           size = info->i.layout.large_bitmap->size;
+           size = GET_LARGE_BITMAP(&info->i)->size;
            p++;
-           retain_large_bitmap(p, info->i.layout.large_bitmap,
+           retain_large_bitmap(p, GET_LARGE_BITMAP(&info->i),
                                size, c, c_child_r);
            p += size;
            // and don't forget to follow the SRT 
@@ -1384,8 +1380,8 @@ retainStack( StgClosure *c, retainer c_child_r,
                p = retain_small_bitmap(p, size, bitmap, c, c_child_r);
                break;
            case ARG_GEN_BIG:
-               size = ((StgLargeBitmap *)fun_info->f.bitmap)->size;
-               retain_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap, 
+               size = GET_FUN_LARGE_BITMAP(fun_info)->size;
+               retain_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), 
                                    size, c, c_child_r);
                p += size;
                break;
@@ -1440,7 +1436,7 @@ retain_PAP (StgPAP *pap, retainer c_child_r)
                                (StgClosure *)pap, c_child_r);
        break;
     case ARG_GEN_BIG:
-       retain_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap,
+       retain_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info),
                            size, (StgClosure *)pap, c_child_r);
        p += size;
        break;
@@ -1750,7 +1746,8 @@ computeRetainerSet( void )
     StgWeak *weak;
     RetainerSet *rtl;
     nat g;
-    StgMutClosure *ml;
+    StgPtr ml;
+    bdescr *bd;
 #ifdef DEBUG_RETAINER
     RetainerSet tmpRetainerSet;
 #endif
@@ -1773,81 +1770,44 @@ computeRetainerSet( void )
     // object (computing sumOfNewCostExtra and updating costArray[] when
     // debugging retainer profiler).
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-       ASSERT(g != 0 ||
-              (generations[g].mut_list == END_MUT_LIST &&
-               generations[g].mut_once_list == END_MUT_LIST));
-
-       // Todo:
-       // I think traversing through mut_list is unnecessary.
-       // Think about removing this part.
-       for (ml = generations[g].mut_list; ml != END_MUT_LIST;
-            ml = ml->mut_link) {
+        ASSERT(g != 0 || (generations[g].mut_list == NULL));
 
-           maybeInitRetainerSet((StgClosure *)ml);
-           rtl = retainerSetOf((StgClosure *)ml);
-
-#ifdef DEBUG_RETAINER
-           if (rtl == NULL) {
-               // first visit to *ml
-               // This is a violation of the interface rule!
-               RSET(ml) = (RetainerSet *)((StgWord)(&tmpRetainerSet) | flip);
-
-               switch (get_itbl((StgClosure *)ml)->type) {
-               case IND_STATIC:
-                   // no cost involved
-                   break;
-               case CONSTR_INTLIKE:
-               case CONSTR_CHARLIKE:
-               case CONSTR_NOCAF_STATIC:
-               case CONSTR_STATIC:
-               case THUNK_STATIC:
-               case FUN_STATIC:
-                   barf("Invalid object in computeRetainerSet(): %d", get_itbl((StgClosure*)ml)->type);
-                   break;
-               default:
-                   // dynamic objects
-                   costArray[get_itbl((StgClosure *)ml)->type] += cost((StgClosure *)ml);
-                   sumOfNewCostExtra += cost((StgClosure *)ml);
-                   break;
-               }
-           }
-#endif
-       }
-
-       // Traversing through mut_once_list is, in contrast, necessary
+       // Traversing through mut_list is necessary
        // because we can find MUT_VAR objects which have not been
        // visited during retainer profiling.
-       for (ml = generations[g].mut_once_list; ml != END_MUT_LIST;
-            ml = ml->mut_link) {
+       for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
+           for (ml = bd->start; ml < bd->free; ml++) {
+
+               maybeInitRetainerSet((StgClosure *)ml);
+               rtl = retainerSetOf((StgClosure *)ml);
 
-           maybeInitRetainerSet((StgClosure *)ml);
-           rtl = retainerSetOf((StgClosure *)ml);
 #ifdef DEBUG_RETAINER
-           if (rtl == NULL) {
-               // first visit to *ml
-               // This is a violation of the interface rule!
-               RSET(ml) = (RetainerSet *)((StgWord)(&tmpRetainerSet) | flip);
-
-               switch (get_itbl((StgClosure *)ml)->type) {
-               case IND_STATIC:
-                   // no cost involved
-                   break;
-               case CONSTR_INTLIKE:
-               case CONSTR_CHARLIKE:
-               case CONSTR_NOCAF_STATIC:
-               case CONSTR_STATIC:
-               case THUNK_STATIC:
-               case FUN_STATIC:
-                   barf("Invalid object in computeRetainerSet(): %d", get_itbl((StgClosure*)ml)->type);
-                   break;
-               default:
-                   // dynamic objects
-                   costArray[get_itbl((StgClosure *)ml)->type] += cost((StgClosure *)ml);
-                   sumOfNewCostExtra += cost((StgClosure *)ml);
-                   break;
+               if (rtl == NULL) {
+                   // first visit to *ml
+                   // This is a violation of the interface rule!
+                   RSET(ml) = (RetainerSet *)((StgWord)(&tmpRetainerSet) | flip);
+                   
+                   switch (get_itbl((StgClosure *)ml)->type) {
+                   case IND_STATIC:
+                       // no cost involved
+                       break;
+                   case CONSTR_INTLIKE:
+                   case CONSTR_CHARLIKE:
+                   case CONSTR_NOCAF_STATIC:
+                   case CONSTR_STATIC:
+                   case THUNK_STATIC:
+                   case FUN_STATIC:
+                       barf("Invalid object in computeRetainerSet(): %d", get_itbl((StgClosure*)ml)->type);
+                       break;
+                   default:
+                       // dynamic objects
+                       costArray[get_itbl((StgClosure *)ml)->type] += cost((StgClosure *)ml);
+                       sumOfNewCostExtra += cost((StgClosure *)ml);
+                       break;
+                   }
                }
-           }
 #endif
+           }
        }
     }
 }
@@ -2138,7 +2098,6 @@ sanityCheckHeapClosure( StgClosure *c )
     case FUN_0_2:
     case WEAK:
     case MUT_VAR:
-    case MUT_CONS:
     case CAF_BLACKHOLE:
     case BLACKHOLE:
     case SE_BLACKHOLE:
@@ -2376,6 +2335,6 @@ belongToHeap(StgPtr p)
        }
     }
 }
-#endif // DEBUG_RETAINER
+#endif /* DEBUG_RETAINER */
 
 #endif /* PROFILING */