Commit db61851c authored by simonmar's avatar simonmar

[project @ 2001-11-22 14:25:11 by simonmar]

Retainer Profiling / Lag-drag-void profiling.

This is mostly work by Sungwoo Park, who spent a summer internship at
MSR Cambridge this year implementing these two types of heap profiling
in GHC.

Relative to Sungwoo's original work, I've made some improvements to
the code:

   - it's now possible to apply constraints to retainer and LDV profiles
     in the same way as we do for other types of heap profile (eg.
     +RTS -hc{foo,bar} -hR -RTS gives you a retainer profiling considering
     only closures with cost centres 'foo' and 'bar').

   - the heap-profile timer implementation is cleaned up.

   - heap profiling no longer has to be run in a two-space heap.

   - general cleanup of the code and application of the SDM C coding
     style guidelines.

Profiling will be a little slower and require more space than before,
mainly because closures have an extra header word to support either
retainer profiling or LDV profiling (you can't do both at the same
time).

We've used the new profiling tools on GHC itself, with moderate
success.  Fixes for some space leaks in GHC to follow...
parent a88cde39
/* ----------------------------------------------------------------------------
* $Id: ClosureMacros.h,v 1.32 2001/02/06 11:41:04 rrt Exp $
* $Id: ClosureMacros.h,v 1.33 2001/11/22 14:25:11 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -79,8 +79,39 @@ static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
-------------------------------------------------------------------------- */
#ifdef PROFILING
#define SET_PROF_HDR(c,ccs_) (c)->header.prof.ccs = ccs_
#define SET_STATIC_PROF_HDR(ccs_) prof : { ccs : ccs_ },
#ifdef DEBUG_RETAINER
/*
For the sake of debugging, we take the safest way for the moment. Actually, this
is useful to check the sanity of heap before beginning retainer profiling.
flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.
Note: change those functions building Haskell objects from C datatypes, i.e.,
all rts_mk???() functions in RtsAPI.c, as well.
*/
extern StgWord flip;
#define SET_PROF_HDR(c,ccs_) \
((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))
#else
/*
For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to
NULL | flip (flip is defined in RetainerProfile.c) because even when flip
is 1, rs is invalid and will be initialized to NULL | flip later when
the closure *c is visited.
*/
/*
#define SET_PROF_HDR(c,ccs_) \
((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)
*/
/*
The following macro works for both retainer profiling and LDV profiling:
for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.
See the invariants on ldvTime.
*/
#define SET_PROF_HDR(c,ccs_) \
((c)->header.prof.ccs = ccs_, \
LDV_recordCreate((c)))
#endif // DEBUG_RETAINER
#define SET_STATIC_PROF_HDR(ccs_) \
prof : { ccs : ccs_, hp : { rs : NULL } },
#else
#define SET_PROF_HDR(c,ccs)
#define SET_STATIC_PROF_HDR(ccs)
......@@ -109,6 +140,7 @@ static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
#define SET_TICKY_HDR(c,stuff)
#define SET_STATIC_TICKY_HDR(stuff)
#endif
#define SET_HDR(c,info,ccs) \
{ \
SET_INFO(c,info); \
......
/* ----------------------------------------------------------------------------
* $Id: Closures.h,v 1.28 2001/10/03 13:57:42 simonmar Exp $
* $Id: Closures.h,v 1.29 2001/11/22 14:25:11 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -20,7 +20,11 @@
-------------------------------------------------------------------------- */
typedef struct {
CostCentreStack *ccs;
CostCentreStack *ccs;
union {
RetainerSet *rs; // Retainer Set
StgWord ldvw; // Lag/Drag/Void Word
} hp;
} StgProfHeader;
/* -----------------------------------------------------------------------------
......
/* -----------------------------------------------------------------------------
* $Id: Stg.h,v 1.39 2001/10/27 21:44:54 sof Exp $
* $Id: Stg.h,v 1.40 2001/11/22 14:25:11 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -150,6 +150,8 @@ typedef StgWord64 LW_;
/* Profiling information */
#include "StgProf.h"
#include "StgRetainerProf.h"
#include "StgLdvProf.h"
/* Storage format definitions */
#include "Closures.h"
......
/* -----------------------------------------------------------------------------
* $Id: StgLdvProf.h,v 1.1 2001/11/22 14:25:11 simonmar Exp $
*
* (c) The GHC Team, 2001
* Author: Sungwoo Park
*
* Lag/Drag/Void profiling.
*
* ---------------------------------------------------------------------------*/
#ifndef STGLDVPROF_H
#define STGLDVPROF_H
#ifdef PROFILING
// Engine
// declared in LdvProfile.c
extern nat ldvTime;
// LdvGenInfo stores the statistics for one specific census.
typedef struct {
double time; // the time in MUT time at the corresponding census is made
// We employ int instead of nat, for some values may be negative temporarily,
// e.g., dragNew.
// computed at each census
int inherentlyUsed; // total size of 'inherently used' closures
int notUsed; // total size of 'never used' closures
int used; // total size of 'used at least once' closures
/*
voidNew and dragNew are updated when a closure is destroyed.
For instance, when a 'never used' closure of size s and creation time
t is destroyed at time u, voidNew of eras t through u - 1 is increased
by s.
Likewise, when a 'used at least once' closure of size s and last use time
t is destroyed at time u, dragNew of eras t + 1 through u - 1 is increase
by s.
In our implementation, voidNew and dragNew are computed indirectly: instead
of updating voidNew or dragNew of all intervening eras, we update that
of the end two eras (one is increased and the other is decreased).
*/
int voidNew; // current total size of 'destroyed without being used' closures
int dragNew; // current total size of 'used at least once and waiting to die'
// closures
// computed post-mortem
int voidTotal; // total size of closures in 'void' state
// lagTotal == notUsed - voidTotal // in 'lag' state
int dragTotal; // total size of closures in 'drag' state
// useTotal == used - dragTotal // in 'use' state
} LdvGenInfo;
extern LdvGenInfo *gi;
// retrieves the LDV word from closure c
#define LDVW(c) (((StgClosure *)(c))->header.prof.hp.ldvw)
/*
An LDV word is divided into 3 parts: state bits (LDV_STATE_MASK), creation
time bits (LDV_CREATE_MASK), and last use time bits (LDV_LAST_MASK).
*/
#if SIZEOF_VOID_P == 8
#define LDV_SHIFT 30
#define LDV_STATE_MASK 0x1000000000000000
#define LDV_CREATE_MASK 0x0FFFFFFFC0000000
#define LDV_LAST_MASK 0x000000003FFFFFFF
#define LDV_STATE_CREATE 0x0000000000000000
#define LDV_STATE_USE 0x1000000000000000
#else
#define LDV_SHIFT 15
#define LDV_STATE_MASK 0x40000000
#define LDV_CREATE_MASK 0x3FFF8000
#define LDV_LAST_MASK 0x00007FFF
#define LDV_STATE_CREATE 0x00000000
#define LDV_STATE_USE 0x40000000
#endif // SIZEOF_VOID_P
// Stores the creation time for closure c.
// This macro is called at the very moment of closure creation.
//
// NOTE: this initializes LDVW(c) to zero, which ensures that there
// is no conflict between retainer profiling and LDV profiling,
// because retainer profiling also expects LDVW(c) to be initialised
// to zero.
#define LDV_recordCreate(c) \
LDVW((c)) = (ldvTime << LDV_SHIFT) | LDV_STATE_CREATE
// Stores the last use time for closure c.
// This macro *must* be called whenever a closure is used, that is, it is
// entered.
#define LDV_recordUse(c) \
{ \
if (ldvTime > 0) \
LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) | \
ldvTime | \
LDV_STATE_USE; \
}
// Creates a 0-filled slop of size 'howManyBackwards' backwards from the
// address 'from'.
//
// Invoked when:
// 1) Hp is incremented and exceeds HpLim (in Updates.hc).
// 2) copypart() is called (in GC.c).
#define FILL_SLOP(from, howManyBackwards) \
if (ldvTime > 0) { \
int i; \
for (i = 0;i < (howManyBackwards); i++) \
((StgWord *)(from))[-i] = 0; \
}
// Informs the LDV profiler that closure c has just been evacuated.
// Evacuated objects are no longer needed, so we just store its original size in
// the LDV field.
#define SET_EVACUAEE_FOR_LDV(c, size) \
LDVW((c)) = (size)
// Macros called when a closure is entered.
// The closure is not an 'inherently used' one.
// The closure is not IND or IND_OLDGEN because neither is considered for LDV
// profiling.
#define LDV_ENTER(c) LDV_recordUse((c))
#else // !PROFILING
#define LDV_ENTER(c)
#endif // PROFILING
#endif // STGLDVPROF_H
/* -----------------------------------------------------------------------------
* $Id: StgMacros.h,v 1.41 2001/11/08 16:37:54 simonmar Exp $
* $Id: StgMacros.h,v 1.42 2001/11/22 14:25:11 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -144,7 +144,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
tag_assts \
(r) = (P_)ret; \
JMP_(stg_chk_##layout); \
}
}
#define HP_STK_CHK(stk_headroom,hp_headroom,ret,r,layout,tag_assts) \
DO_GRAN_ALLOCATE(hp_headroom) \
......@@ -153,7 +153,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
tag_assts \
(r) = (P_)ret; \
JMP_(stg_chk_##layout); \
}
}
/* -----------------------------------------------------------------------------
A Heap Check in a case alternative are much simpler: everything is
......@@ -186,7 +186,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
HpAlloc = (headroom); \
tag_assts \
JMP_(stg_gc_enter_##ptrs); \
}
}
#define HP_CHK_SEQ_NP(headroom,ptrs,tag_assts) \
DO_GRAN_ALLOCATE(headroom) \
......@@ -194,7 +194,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
HpAlloc = (headroom); \
tag_assts \
JMP_(stg_gc_seq_##ptrs); \
}
}
#define HP_STK_CHK_NP(stk_headroom, hp_headroom, ptrs, tag_assts) \
DO_GRAN_ALLOCATE(hp_headroom) \
......@@ -202,7 +202,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
HpAlloc = (hp_headroom); \
tag_assts \
JMP_(stg_gc_enter_##ptrs); \
}
}
/* Heap checks for branches of a primitive case / unboxed tuple return */
......@@ -214,7 +214,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
HpAlloc = (headroom); \
tag_assts \
JMP_(lbl); \
}
}
#define HP_CHK_NOREGS(headroom,tag_assts) \
GEN_HP_CHK_ALT(headroom,stg_gc_noregs,tag_assts);
......@@ -298,7 +298,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
R9.w = (W_)LIVENESS_MASK(liveness); \
R10.w = (W_)reentry; \
JMP_(stg_gen_chk); \
}
}
#define HP_CHK_GEN_TICKY(headroom,liveness,reentry,tag_assts) \
HP_CHK_GEN(headroom,liveness,reentry,tag_assts); \
......@@ -435,12 +435,29 @@ EXTINFO_RTS(stg_gen_chk_info);
} \
SET_INFO(R1.cl,&stg_BLACKHOLE_info)
# else
# ifndef PROFILING
# define UPD_BH_UPDATABLE(info) \
TICK_UPD_BH_UPDATABLE(); \
SET_INFO(R1.cl,&stg_BLACKHOLE_info)
# define UPD_BH_SINGLE_ENTRY(info) \
TICK_UPD_BH_SINGLE_ENTRY(); \
SET_INFO(R1.cl,&stg_SE_BLACKHOLE_info)
# else
// An object is replaced by a blackhole, so we fill the slop with zeros.
//
// Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
//
# define UPD_BH_UPDATABLE(info) \
TICK_UPD_BH_UPDATABLE(); \
LDV_recordDead_FILL_SLOP_DYNAMIC(R1.cl); \
SET_INFO(R1.cl,&stg_BLACKHOLE_info); \
LDV_recordCreate(R1.cl)
# define UPD_BH_SINGLE_ENTRY(info) \
TICK_UPD_BH_SINGLE_ENTRY(); \
LDV_recordDead_FILL_SLOP_DYNAMIC(R1.cl); \
SET_INFO(R1.cl,&stg_SE_BLACKHOLE_info) \
LDV_recordCreate(R1.cl)
# endif /* PROFILING */
# endif
#else /* !EAGER_BLACKHOLING */
# define UPD_BH_UPDATABLE(thunk) /* nothing */
......
/* -----------------------------------------------------------------------------
* $Id: StgProf.h,v 1.13 2001/10/18 13:46:47 simonmar Exp $
* $Id: StgProf.h,v 1.14 2001/11/22 14:25:11 simonmar Exp $
*
* (c) The GHC Team, 1998
*
......@@ -349,9 +349,6 @@ extern CostCentreStack *CCS_LIST; /* registered CCS list */
#define ENTER_CCS_PAP_CL(closure) \
ENTER_CCS_PAP((closure)->header.prof.ccs)
/* temp EW */
#define STATIC_CCS_REF(ccs) (ccs)
/* -----------------------------------------------------------------------------
When not profiling, these macros do nothing...
-------------------------------------------------------------------------- */
......
/* -----------------------------------------------------------------------------
* $Id: StgRetainerProf.h,v 1.1 2001/11/22 14:25:12 simonmar Exp $
*
* (c) The GHC Team, 2001
*
* Retainer profiling
* ---------------------------------------------------------------------------*/
#ifndef STGRETAINERPROF_H
#define STGRETAINERPROF_H
/*
Type 'retainer' defines the retainer identity.
Invariant:
1. The retainer identity of a given retainer cannot change during
program execution, no matter where it is actually stored.
For instance, the memory address of a retainer cannot be used as
its retainer identity because its location may change during garbage
collections.
2. Type 'retainer' must come with comparison operations as well as
an equality operation. That it, <, >, and == must be supported -
this is necessary to store retainers in a sorted order in retainer sets.
Therefore, you cannot use a huge structure type as 'retainer', for instance.
We illustrate three possibilities of defining 'retainer identity'.
Choose one of the following three compiler directives:
Retainer scheme 1 (RETAINER_SCHEME_INFO) : retainer = info table
Retainer scheme 2 (RETAINER_SCHEME_CCS) : retainer = cost centre stack
Retainer scheme 3 (RETAINER_SCHEME_CC) : retainer = cost centre
*/
// #define RETAINER_SCHEME_INFO
#define RETAINER_SCHEME_CCS
// #define RETAINER_SCHEME_CC
#ifdef RETAINER_SCHEME_INFO
struct _StgInfoTable;
typedef struct _StgInfoTable *retainer;
#endif
#ifdef RETAINER_SCHEME_CCS
typedef CostCentreStack *retainer;
#endif
#ifdef RETAINER_SCHEME_CC
typedef CostCentre *retainer;
#endif
/*
Type 'retainerSet' defines an abstract datatype for sets of retainers.
Invariants:
A retainer set stores its elements in increasing order (in element[] array).
*/
typedef struct _RetainerSet {
nat num; // number of elements
nat cost; // cost associated with this retainer set
StgWord hashKey; // hash key for this retainer set
struct _RetainerSet *link; // link to the next retainer set in the bucket
int id; // unique id of this retainer set (used when printing)
// Its absolute value is interpreted as its true id; if id is
// negative, it indicates that this retainer set has had a postive
// cost after some retainer profiling.
retainer element[0]; // elements of this retainer set
// do not put anything below here!
} RetainerSet;
//
// retainerSet - interface: see rts/RetainerSet.h
//
#endif /* STGRETAINERPROF_H */
/* -----------------------------------------------------------------------------
* $Id: Updates.h,v 1.25 2001/11/08 12:46:31 simonmar Exp $
* $Id: Updates.h,v 1.26 2001/11/22 14:25:12 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -178,7 +178,9 @@ extern void awakenBlockedQueue(StgTSO *q);
------------------------------------------------------------------------- */
#if defined(PROFILING)
#define PUSH_STD_CCCS(frame) frame->header.prof.ccs = CCCS
// frame->header.prof.hp.rs = NULL (or frame-header.prof.hp.ldvw = 0) is unnecessary
// because it is not used anyhow.
#define PUSH_STD_CCCS(frame) (frame->header.prof.ccs = CCCS)
#else
#define PUSH_STD_CCCS(frame)
#endif
......
/* -----------------------------------------------------------------------------
* $Id: Exception.hc,v 1.21 2001/08/17 14:44:54 simonmar Exp $
* $Id: Exception.hc,v 1.22 2001/11/22 14:25:12 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
......@@ -260,8 +260,8 @@ CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_5_entry,RET_VEC(Sp[SP_OFF],5));
CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_6_entry,RET_VEC(Sp[SP_OFF],6));
CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_7_entry,RET_VEC(Sp[SP_OFF],7));
#ifdef PROFILING
#define CATCH_FRAME_BITMAP 7
#if defined(PROFILING)
#define CATCH_FRAME_BITMAP 15
#else
#define CATCH_FRAME_BITMAP 3
#endif
......@@ -355,7 +355,7 @@ FN_(raisezh_fast)
* the info was only displayed for an *uncaught* exception.
*/
if (RtsFlags.ProfFlags.showCCSOnException) {
STGCALL2(print_ccs,stderr,CCCS);
STGCALL2(fprintCCS,stderr,CCCS);
}
#endif
......@@ -365,8 +365,18 @@ FN_(raisezh_fast)
* is the exception raise. It is used to overwrite all the
* thunks which are currently under evaluataion.
*/
/*
// @LDV profiling
// stg_raise_info has THUNK as its closure type. Since a THUNK takes at least
// MIN_UPD_SIZE words in its payload, MIN_UPD_SIZE is more approprate than 1.
// It seems that 1 does not cause any problem unless profiling is performed.
// However, when LDV profiling goes on, we need to linearly scan small object pool,
// where raise_closure is stored, so we should use MIN_UPD_SIZE.
raise_closure = (StgClosure *)RET_STGCALL1(P_,allocate,
sizeofW(StgClosure)+1);
*/
raise_closure = (StgClosure *)RET_STGCALL1(P_,allocate,
sizeofW(StgClosure)+MIN_UPD_SIZE);
SET_HDR(raise_closure, &stg_raise_info, CCCS);
raise_closure->payload[0] = R1.cl;
......
/* -----------------------------------------------------------------------------
* $Id: GC.c,v 1.126 2001/11/08 12:46:31 simonmar Exp $
* $Id: GC.c,v 1.127 2001/11/22 14:25:12 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
......@@ -42,6 +42,9 @@
#include "FrontPanel.h"
#endif
#include "RetainerProfile.h"
#include "LdvProfile.h"
/* STATIC OBJECT LIST.
*
* During GC:
......@@ -602,6 +605,13 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
}
}
#ifdef PROFILING
// We call processHeapClosureForDead() on every closure destroyed during
// the current garbage collection, so we invoke LdvCensusForDead().
if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV)
LdvCensusForDead(N);
#endif
// NO MORE EVACUATION AFTER THIS POINT!
// Finally: compaction of the oldest generation.
if (major_gc && oldest_gen->steps[0].is_compacted) {
......@@ -933,6 +943,12 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
if (major_gc) { gcCAFs(); }
#endif
#ifdef PROFILING
// resetStaticObjectForRetainerProfiling() must be called before
// zeroing below.
resetStaticObjectForRetainerProfiling();
#endif
// zero the scavenged static object list
if (major_gc) {
zero_static_object_list(scavenged_static_objects);
......@@ -963,7 +979,6 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
// restore enclosing cost centre
#ifdef PROFILING
heapCensus();
CCCS = prev_CCS;
#endif
......@@ -1271,6 +1286,10 @@ static __inline__ StgClosure *
copy(StgClosure *src, nat size, step *stp)
{
P_ to, from, dest;
#ifdef PROFILING
// @LDV profiling
nat size_org = size;
#endif
TICK_GC_WORDS_COPIED(size);
/* Find out where we're going, using the handy "to" pointer in
......@@ -1300,6 +1319,12 @@ copy(StgClosure *src, nat size, step *stp)
dest = stp->hp;
stp->hp = to;
upd_evacuee(src,(StgClosure *)dest);
#ifdef PROFILING
// @LDV profiling
// We store the size of the just evacuated object in the LDV word so that
// the profiler can guess the position of the next object later.
SET_EVACUAEE_FOR_LDV(src, size_org);
#endif
return (StgClosure *)dest;
}
......@@ -1309,10 +1334,14 @@ copy(StgClosure *src, nat size, step *stp)
*/
static __inline__ StgClosure *
static StgClosure *
copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp)
{
P_ dest, to, from;
#ifdef PROFILING
// @LDV profiling
nat size_to_copy_org = size_to_copy;
#endif
TICK_GC_WORDS_COPIED(size_to_copy);
if (stp->gen_no < evac_gen) {
......@@ -1334,6 +1363,17 @@ copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp)
dest = stp->hp;
stp->hp += size_to_reserve;
upd_evacuee(src,(StgClosure *)dest);
#ifdef PROFILING
// @LDV profiling
// We store the size of the just evacuated object in the LDV word so that
// the profiler can guess the position of the next object later.
// size_to_copy_org is wrong because the closure already occupies size_to_reserve
// words.
SET_EVACUAEE_FOR_LDV(src, size_to_reserve);
// fill the slop
if (size_to_reserve - size_to_copy_org > 0)
FILL_SLOP(stp->hp - 1, (int)(size_to_reserve - size_to_copy_org));
#endif
return (StgClosure *)dest;
}
......@@ -2162,9 +2202,23 @@ scavenge(step *stp)
}
case IND_PERM:
if (stp->gen_no != 0) {
SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
}
if (stp->gen->no != 0) {
#ifdef PROFILING
// @LDV profiling
// No need to call LDV_recordDead_FILL_SLOP_DYNAMIC() because an
// IND_OLDGEN_PERM closure is larger than an IND_PERM closure.
LDV_recordDead((StgClosure *)p, sizeofW(StgInd));
#endif
//
// Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
//
SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
#ifdef PROFILING
// @LDV profiling
// We pretend that p has just been created.
LDV_recordCreate((StgClosure *)p);
#endif
}
// fall through
case IND_OLDGEN_PERM:
((StgIndOldGen *)p)->indirectee =
......@@ -3589,8 +3643,18 @@ threadLazyBlackHole(StgTSO *tso)
bh->header.info != &stg_CAF_BLACKHOLE_info) {
#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
belch("Unexpected lazy BHing required at 0x%04x",(int)bh);
#endif
#ifdef PROFILING
// @LDV profiling
// We pretend that bh is now dead.
LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
#endif
SET_INFO(bh,&stg_BLACKHOLE_info);
#ifdef PROFILING
// @LDV profiling
// We pretend that bh has just been created.
LDV_recordCreate(bh);
#endif
}
update_frame = update_frame->link;
......@@ -3832,7 +3896,20 @@ threadSqueezeStack(StgTSO *tso)
}
}
#endif
#ifdef PROFILING
// @LDV profiling
// We pretend that bh is now dead.
LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
#endif
//
// Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
//
SET_INFO(bh,&stg_BLACKHOLE_info);
#ifdef PROFILING
// @LDV profiling
// We pretend that bh has just been created.
LDV_recordCreate(bh);
#endif
}
}
......
/* -----------------------------------------------------------------------------
* $Id: HeapStackCheck.hc,v 1.18 2001/11/08 12:46:31 simonmar Exp $
* $Id: HeapStackCheck.hc,v 1.19 2001/11/22 14:25:12 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -47,7 +47,6 @@
* ThreadRunGHC thread.
*/
#define GC_GENERIC \
if (Hp > HpLim) { \
Hp -= HpAlloc; \
......
/* -----------------------------------------------------------------------------
* $Id: Itimer.c,v 1.25 2001/11/21 20:55:10 sof Exp $
* $Id: Itimer.c,v 1.26 2001/11/22 14:25:12 simonmar Exp $
*
* (c) The GHC Team, 1995-1999
*
......@@ -142,6 +142,8 @@ initialize_virtual_timer(nat ms)
}
}
initProfTimer();
return 0;
}
......@@ -158,6 +160,10 @@ initialize_virtual_timer(nat ms)
timestamp = getourtimeofday();
#ifdef PROFILING
initProfTimer();
#endif
it.it_value.tv_sec = ms / 1000;
it.it_value.tv_usec = 1000 * (ms - (1000 * it.it_value.tv_sec));
it.it_interval = it.it_value;
......@@ -178,6 +184,8 @@ initialize_virtual_timer(nat ms)
timestamp = getourtimeofday();
initProfTimer();
se.sigev_notify = SIGEV_SIGNAL;
se.sigev_signo = SIGVTALRM;
se.sigev_value.sival_int = SIGVTALRM;
......
/* -----------------------------------------------------------------------------
* $Id: Itimer.h,v 1.8 2001/11/21 20:55:10 sof Exp $
* $Id: Itimer.h,v 1.9 2001/11/22 14:25:12 simonmar Exp $
*
* (c) The GHC Team 1998-1999
* (c) The GHC Team 1998-2001
*
* Interval timer for profiling and pre-emptive scheduling.
*
......@@ -15,11 +15,6 @@
*/
#define CS_MIN_MILLISECS TICK_MILLISECS /* milliseconds per slice */
extern rtsBool do_prof_ticks; /* profiling ticks on/off */
/* Total number of ticks since startup */
extern lnat total_ticks;
int initialize_virtual_timer ( nat ms );
int install_vtalrm_handler ( void );
void block_vtalrm_signal ( void );
......
This diff is collapsed.
/* -----------------------------------------------------------------------------
* $Id: LdvProfile.h,v 1.1 2001/11/22 14:25:12 simonmar Exp $
*
* (c) The GHC Team, 2001
* Author: Sungwoo Park
*
* Lag/Drag/Void profiling.
*
* ---------------------------------------------------------------------------*/
#ifndef LDVPROFILE_H
#define LDVPROFILE_H
#ifdef PROFILING
#include "ProfHeap.h"
void LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p );
// Precesses a closure 'c' being destroyed whose size is 'size'.
// Make sure that LDV_recordDead() is not invoked on 'inherently used' closures
// such as TSO; they should not be involved in computing dragNew or voidNew.
//
// Note: ldvTime is 0 if LDV profiling is turned off.
// ldvTime is > 0 if LDV profiling is turned on.
// size does not include StgProfHeader.
//
// Even though ldvTime is checked in both LdvCensusForDead() and
// LdvCensusKillAll(), we still need to make sure that ldvTime is > 0 because
// LDV_recordDead() may be called from elsewhere in the runtime system. E.g.,
// when a thunk is replaced by an indirection object.
static inline void
LDV_recordDead( StgClosure *c, nat size )
{
if (ldvTime > 0 && closureSatisfiesConstraints(c)) {
nat t;
size -= sizeofW(StgProfHeader);
if ((LDVW((c)) & LDV_STATE_MASK) == LDV_STATE_CREATE) {
t = (LDVW((c)) & LDV_CREATE_MASK) >> LDV_SHIFT;
if (t < ldvTime) {