From cb1ce9cd75baa5e640ec795c1518eb537b1caa28 Mon Sep 17 00:00:00 2001 From: simonm Date: Fri, 23 Apr 1999 09:47:33 +0000 Subject: [PATCH] [project @ 1999-04-23 09:47:30 by simonm] More profiling fixes. Profiles looking more reasonable, but for best results add the -caf-all switch to GHC. --- ghc/includes/Profiling.h | 7 +++-- ghc/includes/StgProf.h | 69 ++++++++++++++++++-------------------------- ghc/rts/Profiling.c | 64 ++++++++++++++++++++++++++-------------- ghc/rts/StgMiscClosures.hc | 11 +++++-- ghc/rts/Updates.hc | 23 +++++---------- 5 files changed, 92 insertions(+), 82 deletions(-) diff --git a/ghc/includes/Profiling.h b/ghc/includes/Profiling.h index a29759e..85e815c 100644 --- a/ghc/includes/Profiling.h +++ b/ghc/includes/Profiling.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -84,7 +84,7 @@ typedef struct _CostCentreStack { unsigned long time_ticks; unsigned long mem_alloc; - char is_subsumed; /* inherits value from is_subsumed flag of top CostCentre */ + CostCentre *root; } CostCentreStack; @@ -157,6 +157,7 @@ extern hash_t max_type_no; /* Hash on type description */ * Functions * ---------------------------------------------------------------------------*/ +CostCentreStack *EnterFunCCS ( CostCentreStack *cccs, CostCentreStack *ccsfn ); CostCentreStack *PushCostCentre ( CostCentreStack *, CostCentre * ); CostCentreStack *AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 ); CostCentreStack *ActualPush ( CostCentreStack *, CostCentre * ); @@ -165,6 +166,8 @@ CostCentreStack *RemoveCC ( CostCentreStack *, CostCentre * ); CostCentreStack *IsInIndexTable ( IndexTable *, CostCentre * ); IndexTable *AddToIndexTable ( IndexTable *, CostCentreStack *, CostCentre * ); +extern unsigned int entering_PAP; + #endif /* PROFILING */ #endif PROFILING_H diff --git a/ghc/includes/StgProf.h b/ghc/includes/StgProf.h index 76fcdc3..ebd1735 100644 --- a/ghc/includes/StgProf.h +++ b/ghc/includes/StgProf.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -104,7 +104,7 @@ extern CostCentreStack *CCS_LIST; /* registered CCS list */ sub_cafcc_count : 0, \ time_ticks : 0, \ mem_alloc : 0, \ - is_subsumed : subsumed, \ + root : 0, \ }}; # define CC_EXTERN(cc_ident) \ @@ -215,10 +215,10 @@ extern CostCentreStack *CCS_LIST; /* registered CCS list */ * 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)) @@ -231,35 +231,31 @@ extern CostCentreStack *CCS_LIST; /* registered CCS list */ * (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) \ @@ -270,20 +266,11 @@ extern CostCentreStack *CCS_LIST; /* registered CCS list */ /* 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) diff --git a/ghc/rts/Profiling.c b/ghc/rts/Profiling.c index 69b0881..2dc0b61 100644 --- a/ghc/rts/Profiling.c +++ b/ghc/rts/Profiling.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -132,15 +132,6 @@ initProfiling (void) /* 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; @@ -168,15 +159,27 @@ initProfiling (void) 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; } @@ -193,7 +196,7 @@ endProfiling ( void ) } void -heapCensus ( bdescr *bd ) +heapCensus ( bdescr *bd UNUSED ) { /* nothing yet */ } @@ -234,6 +237,32 @@ registerCostCentres ( void ) /* ----------------------------------------------------------------------------- + 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 -------------------------------------------------------------------------- */ @@ -289,7 +318,6 @@ CostCentreStack * AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 ) #define AppendCCS _AppendCCS { - CostCentreStack *ccs; IF_DEBUG(prof, if (ccs1 != ccs2) { fprintf(stderr,"Appending "); @@ -359,16 +387,8 @@ ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs ) 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); diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index 67dadf0..3b83f5b 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -13,6 +13,7 @@ #include "HeapStackCheck.h" /* for stg_gen_yield */ #include "Storage.h" #include "StoragePriv.h" +#include "ProfRts.h" #ifdef HAVE_STDIO_H #include @@ -54,7 +55,7 @@ STGFUN(IND_PERM_entry) 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 */ @@ -86,6 +87,12 @@ STGFUN(IND_OLDGEN_PERM_entry) 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); diff --git a/ghc/rts/Updates.hc b/ghc/rts/Updates.hc index adc9a6c..f4aa7eb 100644 --- a/ghc/rts/Updates.hc +++ b/ghc/rts/Updates.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -11,6 +11,7 @@ #include "RtsUtils.h" #include "HeapStackCheck.h" #include "Storage.h" +#include "ProfRts.h" /* The update frame return address must be *polymorphic*, that means @@ -140,7 +141,6 @@ STGFUN(PAP_entry) */ CCCS = Su->header.prof.ccs; - ENTER_CCS_PAP(pap->header.prof.ccs); #endif /* PROFILING */ Su = Su->link; @@ -200,7 +200,7 @@ EXTFUN(stg_update_PAP) { nat Words, PapSize; #ifdef PROFILING - CostCentreStack *CCS_pap, *CCS_blame; + CostCentreStack *CCS_pap; #endif StgPAP* PapClosure; StgClosure *Fun, *Updatee; @@ -226,12 +226,9 @@ EXTFUN(stg_update_PAP) 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) { @@ -268,7 +265,7 @@ EXTFUN(stg_update_PAP) 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 */ @@ -348,10 +345,6 @@ EXTFUN(stg_update_PAP) #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 */ @@ -378,7 +371,7 @@ EXTFUN(stg_update_PAP) */ JMP_(GET_ENTRY(R1.cl)); FE_ -} +} /* ----------------------------------------------------------------------------- -- 1.7.10.4