rts/LdvProfile.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team, 2001
   4  * Author: Sungwoo Park
   5  *
   6  * Lag/Drag/Void profiling.
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #ifdef PROFILING
  11
  12 #include "PosixSource.h"
  13 #include "Rts.h"
  14
  15 #include "Profiling.h"
  16 #include "LdvProfile.h"
  17 #include "Stats.h"
  18 #include "RtsUtils.h"
  19 #include "Schedule.h"
  20
  21 /* --------------------------------------------------------------------------
  22  * This function is called eventually on every object destroyed during
  23  * a garbage collection, whether it is a major garbage collection or
  24  * not.  If c is an 'inherently used' closure, nothing happens.  If c
  25  * is an ordinary closure, LDV_recordDead() is called on c with its
  26  * proper size which excludes the profiling header portion in the
  27  * closure.  Returns the size of the closure, including the profiling
  28  * header portion, so that the caller can find the next closure.
  29  * ----------------------------------------------------------------------- */
  30 STATIC_INLINE nat
  31 processHeapClosureForDead( StgClosure *c )
  32 {
  33     nat size;
  34     const StgInfoTable *info;
  35
  36     info = get_itbl(c);
  37
  38     info = c->header.info;
  39     if (IS_FORWARDING_PTR(info)) {
  40         // The size of the evacuated closure is currently stored in
  41         // the LDV field.  See SET_EVACUAEE_FOR_LDV() in
  42         // includes/StgLdvProf.h.
  43         return LDVW(c);
  44     }
  45     info = INFO_PTR_TO_STRUCT(info);
  46
  47     ASSERT(((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) <= era &&
  48            ((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) > 0);
  49     ASSERT(((LDVW(c) & LDV_STATE_MASK) == LDV_STATE_CREATE) ||
  50            (
  51                (LDVW(c) & LDV_LAST_MASK) <= era &&
  52                (LDVW(c) & LDV_LAST_MASK) > 0
  53                ));
  54
  55
  56     size = closure_sizeW(c);
  57
  58     switch (info->type) {
  59         /*
  60           'inherently used' cases: do nothing.
  61         */
  62     case TSO:
  63     case STACK:
  64     case MVAR_CLEAN:
  65     case MVAR_DIRTY:
  66     case MUT_ARR_PTRS_CLEAN:
  67     case MUT_ARR_PTRS_DIRTY:
  68     case MUT_ARR_PTRS_FROZEN:
  69     case MUT_ARR_PTRS_FROZEN0:
  70     case ARR_WORDS:
  71     case WEAK:
  72     case MUT_VAR_CLEAN:
  73     case MUT_VAR_DIRTY:
  74     case BCO:
  75     case PRIM:
  76     case MUT_PRIM:
  77     case TREC_CHUNK:
  78         return size;
  79
  80         /*
  81           ordinary cases: call LDV_recordDead().
  82         */
  83     case THUNK:
  84     case THUNK_1_0:
  85     case THUNK_0_1:
  86     case THUNK_SELECTOR:
  87     case THUNK_2_0:
  88     case THUNK_1_1:
  89     case THUNK_0_2:
  90     case AP:
  91     case PAP:
  92     case AP_STACK:
  93     case CONSTR:
  94     case CONSTR_1_0:
  95     case CONSTR_0_1:
  96     case CONSTR_2_0:
  97     case CONSTR_1_1:
  98     case CONSTR_0_2:
  99     case FUN:
 100     case FUN_1_0:
 101     case FUN_0_1:
 102     case FUN_2_0:
 103     case FUN_1_1:
 104     case FUN_0_2:
 105     case BLACKHOLE:
 106     case BLOCKING_QUEUE:
 107     case IND_PERM:
 108         /*
 109           'Ingore' cases
 110         */
 111         // Why can we ignore IND closures? We assume that
 112         // any census is preceded by a major garbage collection, which
 113         // IND closures cannot survive. Therefore, it is no
 114         // use considering IND closures in the meanwhile
 115         // because they will perish before the next census at any
 116         // rate.
 117     case IND:
 118         // Found a dead closure: record its size
 119         LDV_recordDead(c, size);
 120         return size;
 121
 122         /*
 123           Error case
 124         */
 125         // static objects
 126     case IND_STATIC:
 127     case CONSTR_STATIC:
 128     case FUN_STATIC:
 129     case THUNK_STATIC:
 130     case CONSTR_NOCAF_STATIC:
 131         // stack objects
 132     case UPDATE_FRAME:
 133     case CATCH_FRAME:
 134     case UNDERFLOW_FRAME:
 135     case STOP_FRAME:
 136     case RET_DYN:
 137     case RET_BCO:
 138     case RET_SMALL:
 139     case RET_BIG:
 140         // others
 141     case INVALID_OBJECT:
 142     default:
 143         barf("Invalid object in processHeapClosureForDead(): %d", info->type);
 144         return 0;
 145     }
 146 }
 147
 148 /* --------------------------------------------------------------------------
 149  * Calls processHeapClosureForDead() on every *dead* closures in the
 150  * heap blocks starting at bd.
 151  * ----------------------------------------------------------------------- */
 152 static void
 153 processHeapForDead( bdescr *bd )
 154 {
 155     StgPtr p;
 156
 157     while (bd != NULL) {
 158         p = bd->start;
 159         while (p < bd->free) {
 160             p += processHeapClosureForDead((StgClosure *)p);
 161             while (p < bd->free && !*p)   // skip slop
 162                 p++;
 163         }
 164         ASSERT(p == bd->free);
 165         bd = bd->link;
 166     }
 167 }
 168
 169 /* --------------------------------------------------------------------------
 170  * Calls processHeapClosureForDead() on every *dead* closures in the nursery.
 171  * ----------------------------------------------------------------------- */
 172 static void
 173 processNurseryForDead( void )
 174 {
 175     StgPtr p, bdLimit;
 176     bdescr *bd;
 177
 178     bd = MainCapability.r.rNursery->blocks;
 179     while (bd->start < bd->free) {
 180         p = bd->start;
 181         bdLimit = bd->start + BLOCK_SIZE_W;
 182         while (p < bd->free && p < bdLimit) {
 183             p += processHeapClosureForDead((StgClosure *)p);
 184             while (p < bd->free && p < bdLimit && !*p)  // skip slop
 185                 p++;
 186         }
 187         bd = bd->link;
 188         if (bd == NULL)
 189             break;
 190     }
 191 }
 192
 193 /* --------------------------------------------------------------------------
 194  * Calls processHeapClosureForDead() on every *dead* closures in the closure
 195  * chain.
 196  * ----------------------------------------------------------------------- */
 197 static void
 198 processChainForDead( bdescr *bd )
 199 {
 200     // Any object still in the chain is dead!
 201     while (bd != NULL) {
 202         if (!(bd->flags & BF_PINNED)) {
 203             processHeapClosureForDead((StgClosure *)bd->start);
 204         }
 205         bd = bd->link;
 206     }
 207 }
 208
 209 /* --------------------------------------------------------------------------
 210  * Start a census for *dead* closures, and calls
 211  * processHeapClosureForDead() on every closure which died in the
 212  * current garbage collection.  This function is called from a garbage
 213  * collector right before tidying up, when all dead closures are still
 214  * stored in the heap and easy to identify.  Generations 0 through N
 215  * have just beed garbage collected.
 216  * ----------------------------------------------------------------------- */
 217 void
 218 LdvCensusForDead( nat N )
 219 {
 220     nat g;
 221
 222     // ldvTime == 0 means that LDV profiling is currently turned off.
 223     if (era == 0)
 224         return;
 225
 226     if (RtsFlags.GcFlags.generations == 1) {
 227         //
 228         // Todo: support LDV for two-space garbage collection.
 229         //
 230         barf("Lag/Drag/Void profiling not supported with -G1");
 231     } else {
 232         processNurseryForDead();
 233         for (g = 0; g <= N; g++) {
 234             processHeapForDead(generations[g].old_blocks);
 235             processChainForDead(generations[g].large_objects);
 236         }
 237     }
 238 }
 239
 240 /* --------------------------------------------------------------------------
 241  * Regard any closure in the current heap as dead or moribund and update
 242  * LDV statistics accordingly.
 243  * Called from shutdownHaskell() in RtsStartup.c.
 244  * Also, stops LDV profiling by resetting ldvTime to 0.
 245  * ----------------------------------------------------------------------- */
 246 void
 247 LdvCensusKillAll( void )
 248 {
 249     LdvCensusForDead(RtsFlags.GcFlags.generations - 1);
 250 }
 251
 252 #endif /* PROFILING */