1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 2001
6 * Lag/Drag/Void profiling.
8 * ---------------------------------------------------------------------------*/
13 #include "LdvProfile.h"
15 #include "Profiling.h"
20 /* --------------------------------------------------------------------------
21 * Fills in the slop when a *dynamic* closure changes its type.
22 * First calls LDV_recordDead() to declare the closure is dead, and then
26 * 1) blackholing, UPD_BH_UPDATABLE() and UPD_BH_SINGLE_ENTRY (in
27 * includes/StgMacros.h), threadLazyBlackHole() and
28 * threadSqueezeStack() (in GC.c).
29 * 2) updating with indirection closures, updateWithIndirection()
30 * and updateWithPermIndirection() (in Storage.h).
32 * LDV_recordDead_FILL_SLOP_DYNAMIC() is not called on 'inherently used'
33 * closures such as TSO. It is not called on PAP because PAP is not updatable.
34 * ----------------------------------------------------------------------- */
36 LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p )
40 #if defined(__GNUC__) && __GNUC__ < 3 && defined(DEBUG)
41 #error Please use gcc 3.0+ to compile this file with DEBUG; gcc < 3.0 miscompiles it
45 // very like FILL_SLOP(), except that we call LDV_recordDead().
46 size = closure_sizeW(p);
48 LDV_recordDead((StgClosure *)(p), size);
50 if (size > sizeofW(StgThunkHeader)) {
51 for (i = 0; i < size - sizeofW(StgThunkHeader); i++) {
52 ((StgThunk *)(p))->payload[i] = 0;
58 /* --------------------------------------------------------------------------
59 * This function is called eventually on every object destroyed during
60 * a garbage collection, whether it is a major garbage collection or
61 * not. If c is an 'inherently used' closure, nothing happens. If c
62 * is an ordinary closure, LDV_recordDead() is called on c with its
63 * proper size which excludes the profiling header portion in the
64 * closure. Returns the size of the closure, including the profiling
65 * header portion, so that the caller can find the next closure.
66 * ----------------------------------------------------------------------- */
68 processHeapClosureForDead( StgClosure *c )
75 if (info->type != EVACUATED) {
76 ASSERT(((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) <= era &&
77 ((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) > 0);
78 ASSERT(((LDVW(c) & LDV_STATE_MASK) == LDV_STATE_CREATE) ||
80 (LDVW(c) & LDV_LAST_MASK) <= era &&
81 (LDVW(c) & LDV_LAST_MASK) > 0
85 if (info->type == EVACUATED) {
86 // The size of the evacuated closure is currently stored in
87 // the LDV field. See SET_EVACUAEE_FOR_LDV() in
88 // includes/StgLdvProf.h.
92 size = closure_sizeW(c);
96 'inherently used' cases: do nothing.
100 case MUT_ARR_PTRS_CLEAN:
101 case MUT_ARR_PTRS_DIRTY:
102 case MUT_ARR_PTRS_FROZEN:
103 case MUT_ARR_PTRS_FROZEN0:
110 case TVAR_WATCH_QUEUE:
114 case INVARIANT_CHECK_QUEUE:
115 case ATOMIC_INVARIANT:
119 ordinary cases: call LDV_recordDead().
146 case SE_CAF_BLACKHOLE:
148 case IND_OLDGEN_PERM:
152 // Why can we ignore IND/IND_OLDGEN closures? We assume that
153 // any census is preceded by a major garbage collection, which
154 // IND/IND_OLDGEN closures cannot survive. Therefore, it is no
155 // use considering IND/IND_OLDGEN closures in the meanwhile
156 // because they will perish before the next census at any
160 // Found a dead closure: record its size
161 LDV_recordDead(c, size);
172 case CONSTR_NOCAF_STATIC:
191 barf("Invalid object in processHeapClosureForDead(): %d", info->type);
196 /* --------------------------------------------------------------------------
197 * Calls processHeapClosureForDead() on every *dead* closures in the
198 * heap blocks starting at bd.
199 * ----------------------------------------------------------------------- */
201 processHeapForDead( bdescr *bd )
207 while (p < bd->free) {
208 p += processHeapClosureForDead((StgClosure *)p);
209 while (p < bd->free && !*p) // skip slop
212 ASSERT(p == bd->free);
217 /* --------------------------------------------------------------------------
218 * Calls processHeapClosureForDead() on every *dead* closures in the nursery.
219 * ----------------------------------------------------------------------- */
221 processNurseryForDead( void )
226 bd = MainCapability.r.rNursery->blocks;
227 while (bd->start < bd->free) {
229 bdLimit = bd->start + BLOCK_SIZE_W;
230 while (p < bd->free && p < bdLimit) {
231 p += processHeapClosureForDead((StgClosure *)p);
232 while (p < bd->free && p < bdLimit && !*p) // skip slop
241 /* --------------------------------------------------------------------------
242 * Calls processHeapClosureForDead() on every *dead* closures in the
244 * ----------------------------------------------------------------------- */
246 processSmallObjectPoolForDead( void )
251 bd = small_alloc_list;
258 while (p < alloc_Hp) {
259 p += processHeapClosureForDead((StgClosure *)p);
260 while (p < alloc_Hp && !*p) // skip slop
263 ASSERT(p == alloc_Hp);
268 while (p < bd->free) {
269 p += processHeapClosureForDead((StgClosure *)p);
270 while (p < bd->free && !*p) // skip slop
273 ASSERT(p == bd->free);
278 /* --------------------------------------------------------------------------
279 * Calls processHeapClosureForDead() on every *dead* closures in the closure
281 * ----------------------------------------------------------------------- */
283 processChainForDead( bdescr *bd )
285 // Any object still in the chain is dead!
287 processHeapClosureForDead((StgClosure *)bd->start);
292 /* --------------------------------------------------------------------------
293 * Start a census for *dead* closures, and calls
294 * processHeapClosureForDead() on every closure which died in the
295 * current garbage collection. This function is called from a garbage
296 * collector right before tidying up, when all dead closures are still
297 * stored in the heap and easy to identify. Generations 0 through N
298 * have just beed garbage collected.
299 * ----------------------------------------------------------------------- */
301 LdvCensusForDead( nat N )
305 // ldvTime == 0 means that LDV profiling is currently turned off.
309 if (RtsFlags.GcFlags.generations == 1) {
311 // Todo: support LDV for two-space garbage collection.
313 barf("Lag/Drag/Void profiling not supported with -G1");
315 for (g = 0; g <= N; g++)
316 for (s = 0; s < generations[g].n_steps; s++) {
317 if (g == 0 && s == 0) {
318 processSmallObjectPoolForDead();
319 processNurseryForDead();
320 processChainForDead(generations[g].steps[s].large_objects);
322 processHeapForDead(generations[g].steps[s].old_blocks);
323 processChainForDead(generations[g].steps[s].large_objects);
329 /* --------------------------------------------------------------------------
330 * Regard any closure in the current heap as dead or moribund and update
331 * LDV statistics accordingly.
332 * Called from shutdownHaskell() in RtsStartup.c.
333 * Also, stops LDV profiling by resetting ldvTime to 0.
334 * ----------------------------------------------------------------------- */
336 LdvCensusKillAll( void )
338 LdvCensusForDead(RtsFlags.GcFlags.generations - 1);
341 #endif /* PROFILING */