1 /* -----------------------------------------------------------------------------
2 * $Id: LdvProfile.c,v 1.2 2001/11/26 16:54:21 simonmar Exp $
4 * (c) The GHC Team, 2001
7 * Lag/Drag/Void profiling.
9 * ---------------------------------------------------------------------------*/
15 #include "LdvProfile.h"
18 #include "Proftimer.h"
19 #include "Profiling.h"
25 // ldvTimeSave is set in LdvCensusKillAll(), and stores the final number of
26 // times that LDV profiling was proformed.
27 static nat ldvTimeSave;
29 /* --------------------------------------------------------------------------
30 * Fills in the slop when a *dynamic* closure changes its type.
31 * First calls LDV_recordDead() to declare the closure is dead, and then
35 * 1) blackholing, UPD_BH_UPDATABLE() and UPD_BH_SINGLE_ENTRY (in
36 * includes/StgMacros.h), threadLazyBlackHole() and
37 * threadSqueezeStack() (in GC.c).
38 * 2) updating with indirection closures, updateWithIndirection()
39 * and updateWithPermIndirection() (in Storage.h).
41 * LDV_recordDead_FILL_SLOP_DYNAMIC() is not called on 'inherently used'
42 * closures such as TSO. It is not called on PAP because PAP is not updatable.
43 * ----------------------------------------------------------------------- */
45 LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p )
48 StgInfoTable *inf = get_itbl((p));
60 nw = inf->layout.payload.ptrs + inf->layout.payload.nptrs;
61 if (nw < MIN_UPD_SIZE)
65 nw = sizeofW(StgPAP) - sizeofW(StgHeader) + ((StgPAP *)p)->n_args;
70 case SE_CAF_BLACKHOLE:
71 nw = inf->layout.payload.ptrs + inf->layout.payload.nptrs;
74 barf("Unexpected closure type %u in LDV_recordDead_FILL_SLOP_DYNAMIC()", inf->type);
77 LDV_recordDead((StgClosure *)(p), nw + sizeofW(StgHeader));
78 for (i = 0; i < nw; i++) {
79 ((StgClosure *)(p))->payload[i] = 0;
84 /* --------------------------------------------------------------------------
85 * This function is called eventually on every object destroyed during
86 * a garbage collection, whether it is a major garbage collection or
87 * not. If c is an 'inherently used' closure, nothing happens. If c
88 * is an ordinary closure, LDV_recordDead() is called on c with its
89 * proper size which excludes the profiling header portion in the
90 * closure. Returns the size of the closure, including the profiling
91 * header portion, so that the caller can find the next closure.
92 * ----------------------------------------------------------------------- */
94 processHeapClosureForDead( StgClosure *c )
101 if (info->type != EVACUATED) {
102 ASSERT(((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) <= era &&
103 ((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) > 0);
104 ASSERT(((LDVW(c) & LDV_STATE_MASK) == LDV_STATE_CREATE) ||
106 (LDVW(c) & LDV_LAST_MASK) <= era &&
107 (LDVW(c) & LDV_LAST_MASK) > 0
111 switch (info->type) {
113 'inherently used' cases: do nothing.
117 size = tso_sizeW((StgTSO *)c);
121 size = sizeofW(StgMVar);
125 case MUT_ARR_PTRS_FROZEN:
126 size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)c);
130 size = arr_words_sizeW((StgArrWords *)c);
139 size = sizeW_fromITBL(info);
143 ordinary cases: call LDV_recordDead().
147 size = stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
156 size = sizeofW(StgHeader) + MIN_UPD_SIZE;
161 size = pap_sizeW((StgPAP *)c);
182 case SE_CAF_BLACKHOLE:
183 size = sizeW_fromITBL(info);
187 size = sizeofW(StgInd);
190 case IND_OLDGEN_PERM:
191 size = sizeofW(StgIndOldGen);
197 // Why can we ignore IND/IND_OLDGEN closures? We assume that
198 // any census is preceded by a major garbage collection, which
199 // IND/IND_OLDGEN closures cannot survive. Therefore, it is no
200 // use considering IND/IND_OLDGEN closures in the meanwhile
201 // because they will perish before the next census at any
204 size = sizeofW(StgInd);
208 size = sizeofW(StgIndOldGen);
212 // The size of the evacuated closure is currently stored in
213 // the LDV field. See SET_EVACUAEE_FOR_LDV() in
214 // includes/StgLdvProf.h.
226 case CONSTR_CHARLIKE:
227 case CONSTR_NOCAF_STATIC:
247 barf("Invalid object in processHeapClosureForDead(): %d", info->type);
251 // Found a dead closure: record its size
252 LDV_recordDead(c, size);
256 /* --------------------------------------------------------------------------
257 * Calls processHeapClosureForDead() on every *dead* closures in the
258 * heap blocks starting at bd.
259 * ----------------------------------------------------------------------- */
261 processHeapForDead( bdescr *bd )
267 while (p < bd->free) {
268 p += processHeapClosureForDead((StgClosure *)p);
269 while (p < bd->free && !*p) // skip slop
272 ASSERT(p == bd->free);
277 /* --------------------------------------------------------------------------
278 * Calls processHeapClosureForDead() on every *dead* closures in the nursery.
279 * ----------------------------------------------------------------------- */
281 processNurseryForDead( void )
286 bd = MainCapability.r.rNursery;
287 while (bd->start < bd->free) {
289 bdLimit = bd->start + BLOCK_SIZE_W;
290 while (p < bd->free && p < bdLimit) {
291 p += processHeapClosureForDead((StgClosure *)p);
292 while (p < bd->free && p < bdLimit && !*p) // skip slop
301 /* --------------------------------------------------------------------------
302 * Calls processHeapClosureForDead() on every *dead* closures in the
304 * ----------------------------------------------------------------------- */
306 processSmallObjectPoolForDead( void )
311 bd = small_alloc_list;
318 while (p < alloc_Hp) {
319 p += processHeapClosureForDead((StgClosure *)p);
320 while (p < alloc_Hp && !*p) // skip slop
323 ASSERT(p == alloc_Hp);
328 while (p < bd->free) {
329 p += processHeapClosureForDead((StgClosure *)p);
330 while (p < bd->free && !*p) // skip slop
333 ASSERT(p == bd->free);
338 /* --------------------------------------------------------------------------
339 * Calls processHeapClosureForDead() on every *dead* closures in the closure
341 * ----------------------------------------------------------------------- */
343 processChainForDead( bdescr *bd )
345 // Any object still in the chain is dead!
347 processHeapClosureForDead((StgClosure *)bd->start);
352 /* --------------------------------------------------------------------------
353 * Start a census for *dead* closures, and calls
354 * processHeapClosureForDead() on every closure which died in the
355 * current garbage collection. This function is called from a garbage
356 * collector right before tidying up, when all dead closures are still
357 * stored in the heap and easy to identify. Generations 0 through N
358 * have just beed garbage collected.
359 * ----------------------------------------------------------------------- */
361 LdvCensusForDead( nat N )
365 // ldvTime == 0 means that LDV profiling is currently turned off.
369 if (RtsFlags.GcFlags.generations == 1) {
371 // Todo: support LDV for two-space garbage collection.
373 barf("Lag/Drag/Void profiling not supported with -G1");
375 for (g = 0; g <= N; g++)
376 for (s = 0; s < generations[g].n_steps; s++) {
377 if (g == 0 && s == 0) {
378 processSmallObjectPoolForDead();
379 processNurseryForDead();
380 processChainForDead(generations[g].steps[s].large_objects);
382 processHeapForDead(generations[g].steps[s].blocks);
383 processChainForDead(generations[g].steps[s].large_objects);
389 /* --------------------------------------------------------------------------
390 * Regard any closure in the current heap as dead or moribund and update
391 * LDV statistics accordingly.
392 * Called from shutdownHaskell() in RtsStartup.c.
393 * Also, stops LDV profiling by resetting ldvTime to 0.
394 * ----------------------------------------------------------------------- */
396 LdvCensusKillAll( void )
398 LdvCensusForDead(RtsFlags.GcFlags.generations - 1);
401 #endif /* PROFILING */