1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 2001
6 * Lag/Drag/Void profiling.
8 * ---------------------------------------------------------------------------*/
13 #include "LdvProfile.h"
15 #include "Profiling.h"
21 /* --------------------------------------------------------------------------
22 * Fills in the slop when a *dynamic* closure changes its type.
23 * First calls LDV_recordDead() to declare the closure is dead, and then
27 * 1) blackholing, UPD_BH_UPDATABLE() and UPD_BH_SINGLE_ENTRY (in
28 * includes/StgMacros.h), threadLazyBlackHole() and
29 * threadSqueezeStack() (in GC.c).
30 * 2) updating with indirection closures, updateWithIndirection()
31 * and updateWithPermIndirection() (in Storage.h).
33 * LDV_recordDead_FILL_SLOP_DYNAMIC() is not called on 'inherently used'
34 * closures such as TSO. It is not called on PAP because PAP is not updatable.
35 * ----------------------------------------------------------------------- */
37 LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p )
42 #if defined(__GNUC__) && __GNUC__ < 3 && defined(DEBUG)
43 #error Please use gcc 3.0+ to compile this file with DEBUG; gcc < 3.0 miscompiles it
51 nw = stg_max(MIN_UPD_SIZE,1);
58 nw = stg_max(MIN_UPD_SIZE,2);
62 nw = stg_max(info->layout.payload.ptrs + info->layout.payload.nptrs,
66 nw = sizeofW(StgAP) - sizeofW(StgThunkHeader) + ((StgPAP *)p)->n_args;
69 nw = sizeofW(StgAP_STACK) - sizeofW(StgThunkHeader)
70 + ((StgAP_STACK *)p)->size;
75 case SE_CAF_BLACKHOLE:
76 nw = info->layout.payload.ptrs + info->layout.payload.nptrs;
79 barf("Unexpected closure type %u in LDV_recordDead_FILL_SLOP_DYNAMIC()", info->type);
82 LDV_recordDead((StgClosure *)(p), nw + sizeofW(StgHeader));
83 for (i = 0; i < nw; i++) {
84 ((StgClosure *)(p))->payload[i] = 0;
89 /* --------------------------------------------------------------------------
90 * This function is called eventually on every object destroyed during
91 * a garbage collection, whether it is a major garbage collection or
92 * not. If c is an 'inherently used' closure, nothing happens. If c
93 * is an ordinary closure, LDV_recordDead() is called on c with its
94 * proper size which excludes the profiling header portion in the
95 * closure. Returns the size of the closure, including the profiling
96 * header portion, so that the caller can find the next closure.
97 * ----------------------------------------------------------------------- */
99 processHeapClosureForDead( StgClosure *c )
106 if (info->type != EVACUATED) {
107 ASSERT(((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) <= era &&
108 ((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) > 0);
109 ASSERT(((LDVW(c) & LDV_STATE_MASK) == LDV_STATE_CREATE) ||
111 (LDVW(c) & LDV_LAST_MASK) <= era &&
112 (LDVW(c) & LDV_LAST_MASK) > 0
116 switch (info->type) {
118 'inherently used' cases: do nothing.
122 size = tso_sizeW((StgTSO *)c);
126 size = sizeofW(StgMVar);
130 case MUT_ARR_PTRS_FROZEN:
131 size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)c);
135 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);
157 size = sizeofW(StgHeader) + stg_max(MIN_UPD_SIZE, 1);
163 size = sizeofW(StgHeader) + stg_max(MIN_UPD_SIZE, 2);
167 size = ap_sizeW((StgAP *)c);
171 size = pap_sizeW((StgPAP *)c);
175 size = ap_stack_sizeW((StgAP_STACK *)c);
195 case SE_CAF_BLACKHOLE:
196 size = sizeW_fromITBL(info);
200 case IND_OLDGEN_PERM:
201 size = sizeofW(StgInd);
207 // Why can we ignore IND/IND_OLDGEN closures? We assume that
208 // any census is preceded by a major garbage collection, which
209 // IND/IND_OLDGEN closures cannot survive. Therefore, it is no
210 // use considering IND/IND_OLDGEN closures in the meanwhile
211 // because they will perish before the next census at any
215 size = sizeofW(StgInd);
219 // The size of the evacuated closure is currently stored in
220 // the LDV field. See SET_EVACUAEE_FOR_LDV() in
221 // includes/StgLdvProf.h.
233 case CONSTR_CHARLIKE:
234 case CONSTR_NOCAF_STATIC:
253 barf("Invalid object in processHeapClosureForDead(): %d", info->type);
257 // Found a dead closure: record its size
258 LDV_recordDead(c, size);
262 /* --------------------------------------------------------------------------
263 * Calls processHeapClosureForDead() on every *dead* closures in the
264 * heap blocks starting at bd.
265 * ----------------------------------------------------------------------- */
267 processHeapForDead( bdescr *bd )
273 while (p < bd->free) {
274 p += processHeapClosureForDead((StgClosure *)p);
275 while (p < bd->free && !*p) // skip slop
278 ASSERT(p == bd->free);
283 /* --------------------------------------------------------------------------
284 * Calls processHeapClosureForDead() on every *dead* closures in the nursery.
285 * ----------------------------------------------------------------------- */
287 processNurseryForDead( void )
292 bd = MainCapability.r.rNursery;
293 while (bd->start < bd->free) {
295 bdLimit = bd->start + BLOCK_SIZE_W;
296 while (p < bd->free && p < bdLimit) {
297 p += processHeapClosureForDead((StgClosure *)p);
298 while (p < bd->free && p < bdLimit && !*p) // skip slop
307 /* --------------------------------------------------------------------------
308 * Calls processHeapClosureForDead() on every *dead* closures in the
310 * ----------------------------------------------------------------------- */
312 processSmallObjectPoolForDead( void )
317 bd = small_alloc_list;
324 while (p < alloc_Hp) {
325 p += processHeapClosureForDead((StgClosure *)p);
326 while (p < alloc_Hp && !*p) // skip slop
329 ASSERT(p == alloc_Hp);
334 while (p < bd->free) {
335 p += processHeapClosureForDead((StgClosure *)p);
336 while (p < bd->free && !*p) // skip slop
339 ASSERT(p == bd->free);
344 /* --------------------------------------------------------------------------
345 * Calls processHeapClosureForDead() on every *dead* closures in the closure
347 * ----------------------------------------------------------------------- */
349 processChainForDead( bdescr *bd )
351 // Any object still in the chain is dead!
353 processHeapClosureForDead((StgClosure *)bd->start);
358 /* --------------------------------------------------------------------------
359 * Start a census for *dead* closures, and calls
360 * processHeapClosureForDead() on every closure which died in the
361 * current garbage collection. This function is called from a garbage
362 * collector right before tidying up, when all dead closures are still
363 * stored in the heap and easy to identify. Generations 0 through N
364 * have just beed garbage collected.
365 * ----------------------------------------------------------------------- */
367 LdvCensusForDead( nat N )
371 // ldvTime == 0 means that LDV profiling is currently turned off.
375 if (RtsFlags.GcFlags.generations == 1) {
377 // Todo: support LDV for two-space garbage collection.
379 barf("Lag/Drag/Void profiling not supported with -G1");
381 for (g = 0; g <= N; g++)
382 for (s = 0; s < generations[g].n_steps; s++) {
383 if (g == 0 && s == 0) {
384 processSmallObjectPoolForDead();
385 processNurseryForDead();
386 processChainForDead(generations[g].steps[s].large_objects);
388 processHeapForDead(generations[g].steps[s].blocks);
389 processChainForDead(generations[g].steps[s].large_objects);
395 /* --------------------------------------------------------------------------
396 * Regard any closure in the current heap as dead or moribund and update
397 * LDV statistics accordingly.
398 * Called from shutdownHaskell() in RtsStartup.c.
399 * Also, stops LDV profiling by resetting ldvTime to 0.
400 * ----------------------------------------------------------------------- */
402 LdvCensusKillAll( void )
404 LdvCensusForDead(RtsFlags.GcFlags.generations - 1);
407 #endif /* PROFILING */