/* -----------------------------------------------------------------------------
- * $Id: Profiling.h,v 1.4 1999/03/25 13:14:03 simonm Exp $
+ * $Id: Profiling.h,v 1.5 1999/04/23 09:47:30 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
unsigned long time_ticks;
unsigned long mem_alloc;
- char is_subsumed; /* inherits value from is_subsumed flag of top CostCentre */
+ CostCentre *root;
} CostCentreStack;
* Functions
* ---------------------------------------------------------------------------*/
+CostCentreStack *EnterFunCCS ( CostCentreStack *cccs, CostCentreStack *ccsfn );
CostCentreStack *PushCostCentre ( CostCentreStack *, CostCentre * );
CostCentreStack *AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 );
CostCentreStack *ActualPush ( CostCentreStack *, CostCentre * );
CostCentreStack *IsInIndexTable ( IndexTable *, CostCentre * );
IndexTable *AddToIndexTable ( IndexTable *, CostCentreStack *, CostCentre * );
+extern unsigned int entering_PAP;
+
#endif /* PROFILING */
#endif PROFILING_H
/* -----------------------------------------------------------------------------
- * $Id: StgProf.h,v 1.5 1999/04/08 15:43:44 simonm Exp $
+ * $Id: StgProf.h,v 1.6 1999/04/23 09:47:31 simonm Exp $
*
* (c) The GHC Team, 1998
*
sub_cafcc_count : 0, \
time_ticks : 0, \
mem_alloc : 0, \
- is_subsumed : subsumed, \
+ root : 0, \
}};
# define CC_EXTERN(cc_ident) \
* On entering a closure we only count the enter to thunks ...
* ------------------------------------------------------------------------- */
-#define ENTER_CCS_T(ccs) \
- do { \
- CCCS = (CostCentreStack *)(ccs); \
- CCCS_DETAIL_COUNT(CCCS->thunk_count); \
+#define ENTER_CCS_T(ccs) \
+ do { \
+ CCCS = (CostCentreStack *)(ccs); \
+ CCCS_DETAIL_COUNT(CCCS->thunk_count); \
} while(0)
#define ENTER_CCS_TCL(closure) ENTER_CCS_T(CCS_HDR(closure))
* (b) The CCS is CAF-ish.
* -------------------------------------------------------------------------- */
-#define ENTER_CCS_F(stack) \
- do { \
- CostCentreStack *ccs = (CostCentreStack *) (stack); \
- if ( ! IS_CAF_OR_SUB_CCS(ccs) ) { \
- CCCS = ccs; \
- } else { \
- CCCS = AppendCCS(CCCS,ccs); \
- CCCS_DETAIL_COUNT(ccs->caffun_subsumed); \
- CCCS_DETAIL_COUNT(CCCS->subsumed_caf_count); \
- } \
- CCCS_DETAIL_COUNT(CCCS->function_count); \
+#define ENTER_CCS_F(stack) \
+ do { \
+ CostCentreStack *ccs = (CostCentreStack *) (stack); \
+ CCCS_DETAIL_COUNT(CCCS->function_count); \
+ CCCS = EnterFunCCS(CCCS,ccs); \
} while(0)
#define ENTER_CCS_FCL(closure) ENTER_CCS_F(CCS_HDR(closure))
/* Entering a top-level function: costs are subsumed by the caller
*/
-#define ENTER_CCS_FSUB() \
- do { \
- CCCS_DETAIL_COUNT(CCCS->subsumed_fun_count); \
- CCCS_DETAIL_COUNT(CCCS->function_count); \
+#define ENTER_CCS_FSUB() \
+ do { \
+ CCCS_DETAIL_COUNT(CCCS->subsumed_fun_count); \
+ CCCS_DETAIL_COUNT(CCCS->function_count); \
+ entering_PAP = 0; \
} while(0)
-#define ENTER_CCS_FCAF(stack) \
- do { \
- CostCentreStack *ccs = (CostCentreStack *) (stack); \
- CCCS_DETAIL_COUNT(ccs->caffun_subsumed); \
- CCCS_DETAIL_COUNT(CCCS->subsumed_caf_count); \
- CCCS_DETAIL_COUNT(CCCS->function_count); \
+#define ENTER_CCS_FCAF(stack) \
+ do { \
+ CostCentreStack *ccs = (CostCentreStack *) (stack); \
+ CCCS_DETAIL_COUNT(ccs->caffun_subsumed); \
+ CCCS_DETAIL_COUNT(CCCS->subsumed_caf_count); \
+ CCCS_DETAIL_COUNT(CCCS->function_count); \
+ entering_PAP = 0; \
} while(0)
#define ENTER_CCS_FLOAD(ccs) \
/* These ENTER_CC_PAP things are only used in the RTS */
-#define ENTER_CCS_PAP(stack) /* nothing */
-#if 0 /* old version */
- do { \
- CostCentreStack *ccs = (CostCentreStack *) (stack); \
- if ( ! IS_CAF_OR_SUB_CCS(ccs) ) { \
- CCCS = ccs; \
- } else { \
- CCCS = AppendCCS(CCCS,ccs); \
- CCCS_DETAIL_COUNT(ccs->caffun_subsumed); \
- CCCS_DETAIL_COUNT(CCCS->subsumed_caf_count); \
- } \
- CCCS_DETAIL_COUNT(CCCS->pap_count); \
- } while(0)
-#endif
+#define ENTER_CCS_PAP(stack) \
+ do { \
+ ENTER_CCS_F(stack); \
+ entering_PAP = rtsTrue; \
+ } while(0)
#define ENTER_CCS_PAP_CL(closure) \
ENTER_CCS_PAP((closure)->header.prof.ccs)
/* -----------------------------------------------------------------------------
- * $Id: Profiling.c,v 1.5 1999/04/08 15:43:45 simonm Exp $
+ * $Id: Profiling.c,v 1.6 1999/04/23 09:47:32 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
/* for the benefit of allocate()... */
CCCS = CCS_SYSTEM;
- if (!RtsFlags.CcFlags.doCostCentres)
- return;
-
- time_profiling = rtsTrue;
-
- /* Initialise the log file name */
- prof_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling");
- sprintf(prof_filename, "%s.prof", prog_argv[0]);
-
/* Initialize counters for IDs */
CC_ID = 0;
CCS_ID = 0;
CCCS = CCS_OVERHEAD;
registerCostCentres();
+ CCCS = CCS_SYSTEM;
+
+ if (!RtsFlags.CcFlags.doCostCentres)
+ return;
+
+ time_profiling = rtsTrue;
+
+ /* Initialise the log file name */
+ prof_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling");
+ sprintf(prof_filename, "%s.prof", prog_argv[0]);
/* find all the "special" cost centre stacks, and make them children
* of CCS_MAIN.
*/
ASSERT(CCS_MAIN->prevStack == 0);
+ CCS_MAIN->root = CC_MAIN;
for (ccs = CCS_LIST; ccs != CCS_MAIN; ) {
next = ccs->prevStack;
ccs->prevStack = 0;
ActualPush_(CCS_MAIN,ccs->cc,ccs);
+ ccs->root = ccs->cc;
ccs = next;
}
}
void
-heapCensus ( bdescr *bd )
+heapCensus ( bdescr *bd UNUSED )
{
/* nothing yet */
}
/* -----------------------------------------------------------------------------
+ Set cost centre stack when entering a function. Here we implement
+ the rule
+
+ "if CCSfn is an initial segment of CCCS,
+ then set CCCS to CCSfn,
+ else append CCSfn to CCCS"
+ -------------------------------------------------------------------------- */
+rtsBool entering_PAP;
+
+CostCentreStack *
+EnterFunCCS ( CostCentreStack *cccs, CostCentreStack *ccsfn )
+{
+ /* PAP_entry has already set CCCS for us */
+ if (entering_PAP) {
+ entering_PAP = rtsFalse;
+ return CCCS;
+ }
+
+ if (cccs->root == ccsfn->root) {
+ return ccsfn;
+ } else {
+ return AppendCCS(cccs,ccsfn);
+ }
+}
+
+/* -----------------------------------------------------------------------------
Cost-centre stack manipulation
-------------------------------------------------------------------------- */
AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
#define AppendCCS _AppendCCS
{
- CostCentreStack *ccs;
IF_DEBUG(prof,
if (ccs1 != ccs2) {
fprintf(stderr,"Appending ");
new_ccs->time_ticks = 0;
new_ccs->mem_alloc = 0;
- /* stacks are subsumed if either:
- - the top cost centre is boring, and the rest of the CCS is subsumed
- - the top cost centre is subsumed.
- */
- if (cc->is_subsumed == CC_IS_BORING) {
- new_ccs->is_subsumed = ccs->is_subsumed;
- } else {
- new_ccs->is_subsumed = cc->is_subsumed;
- }
-
+ new_ccs->root = ccs->root;
+
/* update the memoization table for the parent stack */
if (ccs != EMPTY_STACK)
ccs->indexTable = AddToIndexTable(ccs->indexTable, new_ccs, cc);
/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.19 1999/03/18 17:57:23 simonm Exp $
+ * $Id: StgMiscClosures.hc,v 1.20 1999/04/23 09:47:33 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
#include "HeapStackCheck.h" /* for stg_gen_yield */
#include "Storage.h"
#include "StoragePriv.h"
+#include "ProfRts.h"
#ifdef HAVE_STDIO_H
#include <stdio.h>
FB_
/* Don't add INDs to granularity cost */
- /* Dont: ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
+ /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
ling */
/* Enter PAP cost centre -- lexical scoping only */
FB_
TICK_ENT_IND(Node); /* tick */
+ /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
+ling */
+
+ /* Enter PAP cost centre -- lexical scoping only */
+ ENTER_CCS_PAP_CL(R1.cl);
+
R1.p = (P_) ((StgInd*)R1.p)->indirectee;
TICK_ENT_VIA_NODE();
JMP_(*R1.p);
/* -----------------------------------------------------------------------------
- * $Id: Updates.hc,v 1.14 1999/04/08 15:43:46 simonm Exp $
+ * $Id: Updates.hc,v 1.15 1999/04/23 09:47:33 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
#include "RtsUtils.h"
#include "HeapStackCheck.h"
#include "Storage.h"
+#include "ProfRts.h"
/*
The update frame return address must be *polymorphic*, that means
*/
CCCS = Su->header.prof.ccs;
- ENTER_CCS_PAP(pap->header.prof.ccs);
#endif /* PROFILING */
Su = Su->link;
{
nat Words, PapSize;
#ifdef PROFILING
- CostCentreStack *CCS_pap, *CCS_blame;
+ CostCentreStack *CCS_pap;
#endif
StgPAP* PapClosure;
StgClosure *Fun, *Updatee;
ASSERT((int)Words >= 0);
#if defined(PROFILING)
- /* set "CC_pap" to go in the updatee (see Sansom thesis, p 183) */
- CCS_pap = Fun->header.prof.ccs;
- CCS_blame = Fun->header.prof.ccs;
- if (IS_CAF_OR_SUB_CCS(CCS_pap)) {
- CCS_blame = CCCS;
- }
+ /* pretend we just entered the function closure */
+ ENTER_CCS_FCL(Fun);
+ CCS_pap = CCCS;
#endif
if (Words == 0) {
TICK_ALLOC_UPD_PAP(1/*fun*/ + Words, 0);
#ifdef PROFILING
- CCS_ALLOC(CCS_blame, PapSize);
+ CCS_ALLOC(CCS_pap, PapSize);
#endif
PapClosure = (StgPAP *)(Hp + 1 - PapSize); /* The new PapClosure */
#endif
#if defined(PROFILING)
- /*
- * Restore the Cost Centre too (if required); again see Sansom
- * thesis p 183. Take the CC out of the update frame if a CAF/DICT.
- */
CCCS = Su->header.prof.ccs;
ENTER_CCS_PAP(CCS_pap);
#endif /* PROFILING */
*/
JMP_(GET_ENTRY(R1.cl));
FE_
-}
+}
/* -----------------------------------------------------------------------------