Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 5cf7182615
Fetching contributors…

Cannot retrieve contributors at this time

253 lines (230 sloc) 6.889 kb
/* -----------------------------------------------------------------------------
*
* (c) The GHC Team, 2001
* Author: Sungwoo Park
*
* Lag/Drag/Void profiling.
*
* ---------------------------------------------------------------------------*/
#ifdef PROFILING
#include "PosixSource.h"
#include "Rts.h"
#include "Profiling.h"
#include "LdvProfile.h"
#include "Stats.h"
#include "RtsUtils.h"
#include "Schedule.h"
/* --------------------------------------------------------------------------
* This function is called eventually on every object destroyed during
* a garbage collection, whether it is a major garbage collection or
* not. If c is an 'inherently used' closure, nothing happens. If c
* is an ordinary closure, LDV_recordDead() is called on c with its
* proper size which excludes the profiling header portion in the
* closure. Returns the size of the closure, including the profiling
* header portion, so that the caller can find the next closure.
* ----------------------------------------------------------------------- */
STATIC_INLINE nat
processHeapClosureForDead( StgClosure *c )
{
nat size;
const StgInfoTable *info;
info = get_itbl(c);
info = c->header.info;
if (IS_FORWARDING_PTR(info)) {
// The size of the evacuated closure is currently stored in
// the LDV field. See SET_EVACUAEE_FOR_LDV() in
// includes/StgLdvProf.h.
return LDVW(c);
}
info = INFO_PTR_TO_STRUCT(info);
ASSERT(((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) <= era &&
((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) > 0);
ASSERT(((LDVW(c) & LDV_STATE_MASK) == LDV_STATE_CREATE) ||
(
(LDVW(c) & LDV_LAST_MASK) <= era &&
(LDVW(c) & LDV_LAST_MASK) > 0
));
size = closure_sizeW(c);
switch (info->type) {
/*
'inherently used' cases: do nothing.
*/
case TSO:
case STACK:
case MVAR_CLEAN:
case MVAR_DIRTY:
case MUT_ARR_PTRS_CLEAN:
case MUT_ARR_PTRS_DIRTY:
case MUT_ARR_PTRS_FROZEN:
case MUT_ARR_PTRS_FROZEN0:
case ARR_WORDS:
case WEAK:
case MUT_VAR_CLEAN:
case MUT_VAR_DIRTY:
case BCO:
case PRIM:
case MUT_PRIM:
case TREC_CHUNK:
return size;
/*
ordinary cases: call LDV_recordDead().
*/
case THUNK:
case THUNK_1_0:
case THUNK_0_1:
case THUNK_SELECTOR:
case THUNK_2_0:
case THUNK_1_1:
case THUNK_0_2:
case AP:
case PAP:
case AP_STACK:
case CONSTR:
case CONSTR_1_0:
case CONSTR_0_1:
case CONSTR_2_0:
case CONSTR_1_1:
case CONSTR_0_2:
case FUN:
case FUN_1_0:
case FUN_0_1:
case FUN_2_0:
case FUN_1_1:
case FUN_0_2:
case BLACKHOLE:
case BLOCKING_QUEUE:
case IND_PERM:
/*
'Ingore' cases
*/
// Why can we ignore IND closures? We assume that
// any census is preceded by a major garbage collection, which
// IND closures cannot survive. Therefore, it is no
// use considering IND closures in the meanwhile
// because they will perish before the next census at any
// rate.
case IND:
// Found a dead closure: record its size
LDV_recordDead(c, size);
return size;
/*
Error case
*/
// static objects
case IND_STATIC:
case CONSTR_STATIC:
case FUN_STATIC:
case THUNK_STATIC:
case CONSTR_NOCAF_STATIC:
// stack objects
case UPDATE_FRAME:
case CATCH_FRAME:
case UNDERFLOW_FRAME:
case STOP_FRAME:
case RET_DYN:
case RET_BCO:
case RET_SMALL:
case RET_BIG:
// others
case INVALID_OBJECT:
default:
barf("Invalid object in processHeapClosureForDead(): %d", info->type);
return 0;
}
}
/* --------------------------------------------------------------------------
* Calls processHeapClosureForDead() on every *dead* closures in the
* heap blocks starting at bd.
* ----------------------------------------------------------------------- */
static void
processHeapForDead( bdescr *bd )
{
StgPtr p;
while (bd != NULL) {
p = bd->start;
while (p < bd->free) {
p += processHeapClosureForDead((StgClosure *)p);
while (p < bd->free && !*p) // skip slop
p++;
}
ASSERT(p == bd->free);
bd = bd->link;
}
}
/* --------------------------------------------------------------------------
* Calls processHeapClosureForDead() on every *dead* closures in the nursery.
* ----------------------------------------------------------------------- */
static void
processNurseryForDead( void )
{
StgPtr p, bdLimit;
bdescr *bd;
bd = MainCapability.r.rNursery->blocks;
while (bd->start < bd->free) {
p = bd->start;
bdLimit = bd->start + BLOCK_SIZE_W;
while (p < bd->free && p < bdLimit) {
p += processHeapClosureForDead((StgClosure *)p);
while (p < bd->free && p < bdLimit && !*p) // skip slop
p++;
}
bd = bd->link;
if (bd == NULL)
break;
}
}
/* --------------------------------------------------------------------------
* Calls processHeapClosureForDead() on every *dead* closures in the closure
* chain.
* ----------------------------------------------------------------------- */
static void
processChainForDead( bdescr *bd )
{
// Any object still in the chain is dead!
while (bd != NULL) {
if (!(bd->flags & BF_PINNED)) {
processHeapClosureForDead((StgClosure *)bd->start);
}
bd = bd->link;
}
}
/* --------------------------------------------------------------------------
* Start a census for *dead* closures, and calls
* processHeapClosureForDead() on every closure which died in the
* current garbage collection. This function is called from a garbage
* collector right before tidying up, when all dead closures are still
* stored in the heap and easy to identify. Generations 0 through N
* have just beed garbage collected.
* ----------------------------------------------------------------------- */
void
LdvCensusForDead( nat N )
{
nat g;
// ldvTime == 0 means that LDV profiling is currently turned off.
if (era == 0)
return;
if (RtsFlags.GcFlags.generations == 1) {
//
// Todo: support LDV for two-space garbage collection.
//
barf("Lag/Drag/Void profiling not supported with -G1");
} else {
processNurseryForDead();
for (g = 0; g <= N; g++) {
processHeapForDead(generations[g].old_blocks);
processChainForDead(generations[g].large_objects);
}
}
}
/* --------------------------------------------------------------------------
* Regard any closure in the current heap as dead or moribund and update
* LDV statistics accordingly.
* Called from shutdownHaskell() in RtsStartup.c.
* Also, stops LDV profiling by resetting ldvTime to 0.
* ----------------------------------------------------------------------- */
void
LdvCensusKillAll( void )
{
LdvCensusForDead(RtsFlags.GcFlags.generations - 1);
}
#endif /* PROFILING */
Jump to Line
Something went wrong with that request. Please try again.