1 /* -----------------------------------------------------------------------------
2 * $Id: LdvProfile.c,v 1.6 2003/11/12 17:49:08 sof Exp $
4 * (c) The GHC Team, 2001
7 * Lag/Drag/Void profiling.
9 * ---------------------------------------------------------------------------*/
15 #include "LdvProfile.h"
17 #include "Profiling.h"
23 /* --------------------------------------------------------------------------
24 * Fills in the slop when a *dynamic* closure changes its type.
25 * First calls LDV_recordDead() to declare the closure is dead, and then
29 * 1) blackholing, UPD_BH_UPDATABLE() and UPD_BH_SINGLE_ENTRY (in
30 * includes/StgMacros.h), threadLazyBlackHole() and
31 * threadSqueezeStack() (in GC.c).
32 * 2) updating with indirection closures, updateWithIndirection()
33 * and updateWithPermIndirection() (in Storage.h).
35 * LDV_recordDead_FILL_SLOP_DYNAMIC() is not called on 'inherently used'
36 * closures such as TSO. It is not called on PAP because PAP is not updatable.
37 * ----------------------------------------------------------------------- */
39 LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p )
44 #if defined(__GNUC__) && __GNUC__ < 3 && defined(DEBUG)
45 #error Please use gcc 3.0+ to compile this file with DEBUG; gcc < 3.0 miscompiles it
60 nw = info->layout.payload.ptrs + info->layout.payload.nptrs;
61 if (nw < MIN_UPD_SIZE)
65 nw = sizeofW(StgPAP) - sizeofW(StgHeader) + ((StgPAP *)p)->n_args;
68 nw = sizeofW(StgAP_STACK) - sizeofW(StgHeader)
69 + ((StgAP_STACK *)p)->size;
74 case SE_CAF_BLACKHOLE:
75 nw = info->layout.payload.ptrs + info->layout.payload.nptrs;
78 barf("Unexpected closure type %u in LDV_recordDead_FILL_SLOP_DYNAMIC()", info->type);
81 LDV_recordDead((StgClosure *)(p), nw + sizeofW(StgHeader));
82 for (i = 0; i < nw; i++) {
83 ((StgClosure *)(p))->payload[i] = 0;
88 /* --------------------------------------------------------------------------
89 * This function is called eventually on every object destroyed during
90 * a garbage collection, whether it is a major garbage collection or
91 * not. If c is an 'inherently used' closure, nothing happens. If c
92 * is an ordinary closure, LDV_recordDead() is called on c with its
93 * proper size which excludes the profiling header portion in the
94 * closure. Returns the size of the closure, including the profiling
95 * header portion, so that the caller can find the next closure.
96 * ----------------------------------------------------------------------- */
98 processHeapClosureForDead( StgClosure *c )
105 if (info->type != EVACUATED) {
106 ASSERT(((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) <= era &&
107 ((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) > 0);
108 ASSERT(((LDVW(c) & LDV_STATE_MASK) == LDV_STATE_CREATE) ||
110 (LDVW(c) & LDV_LAST_MASK) <= era &&
111 (LDVW(c) & LDV_LAST_MASK) > 0
115 switch (info->type) {
117 'inherently used' cases: do nothing.
121 size = tso_sizeW((StgTSO *)c);
125 size = sizeofW(StgMVar);
129 case MUT_ARR_PTRS_FROZEN:
130 size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)c);
134 size = arr_words_sizeW((StgArrWords *)c);
143 size = sizeW_fromITBL(info);
147 ordinary cases: call LDV_recordDead().
151 size = stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
160 size = sizeofW(StgHeader) + MIN_UPD_SIZE;
165 size = pap_sizeW((StgPAP *)c);
169 size = ap_stack_sizeW((StgAP_STACK *)c);
190 case SE_CAF_BLACKHOLE:
191 size = sizeW_fromITBL(info);
195 size = sizeofW(StgInd);
198 case IND_OLDGEN_PERM:
199 size = sizeofW(StgIndOldGen);
205 // Why can we ignore IND/IND_OLDGEN closures? We assume that
206 // any census is preceded by a major garbage collection, which
207 // IND/IND_OLDGEN closures cannot survive. Therefore, it is no
208 // use considering IND/IND_OLDGEN closures in the meanwhile
209 // because they will perish before the next census at any
212 size = sizeofW(StgInd);
216 size = sizeofW(StgIndOldGen);
220 // The size of the evacuated closure is currently stored in
221 // the LDV field. See SET_EVACUAEE_FOR_LDV() in
222 // includes/StgLdvProf.h.
234 case CONSTR_CHARLIKE:
235 case CONSTR_NOCAF_STATIC:
254 barf("Invalid object in processHeapClosureForDead(): %d", info->type);
258 // Found a dead closure: record its size
259 LDV_recordDead(c, size);
263 /* --------------------------------------------------------------------------
264 * Calls processHeapClosureForDead() on every *dead* closures in the
265 * heap blocks starting at bd.
266 * ----------------------------------------------------------------------- */
268 processHeapForDead( bdescr *bd )
274 while (p < bd->free) {
275 p += processHeapClosureForDead((StgClosure *)p);
276 while (p < bd->free && !*p) // skip slop
279 ASSERT(p == bd->free);
284 /* --------------------------------------------------------------------------
285 * Calls processHeapClosureForDead() on every *dead* closures in the nursery.
286 * ----------------------------------------------------------------------- */
288 processNurseryForDead( void )
293 bd = MainCapability.r.rNursery;
294 while (bd->start < bd->free) {
296 bdLimit = bd->start + BLOCK_SIZE_W;
297 while (p < bd->free && p < bdLimit) {
298 p += processHeapClosureForDead((StgClosure *)p);
299 while (p < bd->free && p < bdLimit && !*p) // skip slop
308 /* --------------------------------------------------------------------------
309 * Calls processHeapClosureForDead() on every *dead* closures in the
311 * ----------------------------------------------------------------------- */
313 processSmallObjectPoolForDead( void )
318 bd = small_alloc_list;
325 while (p < alloc_Hp) {
326 p += processHeapClosureForDead((StgClosure *)p);
327 while (p < alloc_Hp && !*p) // skip slop
330 ASSERT(p == alloc_Hp);
335 while (p < bd->free) {
336 p += processHeapClosureForDead((StgClosure *)p);
337 while (p < bd->free && !*p) // skip slop
340 ASSERT(p == bd->free);
345 /* --------------------------------------------------------------------------
346 * Calls processHeapClosureForDead() on every *dead* closures in the closure
348 * ----------------------------------------------------------------------- */
350 processChainForDead( bdescr *bd )
352 // Any object still in the chain is dead!
354 processHeapClosureForDead((StgClosure *)bd->start);
359 /* --------------------------------------------------------------------------
360 * Start a census for *dead* closures, and calls
361 * processHeapClosureForDead() on every closure which died in the
362 * current garbage collection. This function is called from a garbage
363 * collector right before tidying up, when all dead closures are still
364 * stored in the heap and easy to identify. Generations 0 through N
365 * have just beed garbage collected.
366 * ----------------------------------------------------------------------- */
368 LdvCensusForDead( nat N )
372 // ldvTime == 0 means that LDV profiling is currently turned off.
376 if (RtsFlags.GcFlags.generations == 1) {
378 // Todo: support LDV for two-space garbage collection.
380 barf("Lag/Drag/Void profiling not supported with -G1");
382 for (g = 0; g <= N; g++)
383 for (s = 0; s < generations[g].n_steps; s++) {
384 if (g == 0 && s == 0) {
385 processSmallObjectPoolForDead();
386 processNurseryForDead();
387 processChainForDead(generations[g].steps[s].large_objects);
389 processHeapForDead(generations[g].steps[s].blocks);
390 processChainForDead(generations[g].steps[s].large_objects);
396 /* --------------------------------------------------------------------------
397 * Regard any closure in the current heap as dead or moribund and update
398 * LDV statistics accordingly.
399 * Called from shutdownHaskell() in RtsStartup.c.
400 * Also, stops LDV profiling by resetting ldvTime to 0.
401 * ----------------------------------------------------------------------- */
403 LdvCensusKillAll( void )
405 LdvCensusForDead(RtsFlags.GcFlags.generations - 1);
408 #endif /* PROFILING */