From: simonmar Date: Wed, 12 Dec 2001 14:31:43 +0000 (+0000) Subject: [project @ 2001-12-12 14:31:42 by simonmar] X-Git-Tag: Approximately_9120_patches~402 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=55c8be525c07ee7b4a3d34c23d580580fd825fce;p=ghc-hetmet.git [project @ 2001-12-12 14:31:42 by simonmar] - Add a new type of restriction: -hC, which restricts to closures whose CCS contains the specified CCs *anywhere* (not just at the top). - Complain if the user tries to request both retainer and biographical profiling. We don't support both simultaneously, because they use the same header word in the closure. - Allow for the fact that the heap might contain some closures which don't have a valid retainer set during the heap census. The only known closures of this kind so far are DEAD_WEAK closures. - Some cruft-removal and renaming of functions to follow conventions. --- diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c index b8dfcf9..73ca19d 100644 --- a/ghc/rts/ProfHeap.c +++ b/ghc/rts/ProfHeap.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: ProfHeap.c,v 1.32 2001/11/29 16:38:13 simonmar Exp $ + * $Id: ProfHeap.c,v 1.33 2001/12/12 14:31:42 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -37,7 +37,7 @@ * RESTRICTION: * era must be no longer than LDV_SHIFT (15 or 30) bits. * Invariants: - * era is initialized to 0 in initHeapProfiling(). + * era is initialized to 1 in initHeapProfiling(). * * max_era is initialized to 2^LDV_SHIFT in initHeapProfiling(). * When era reaches max_era, the profiling stops because a closure can @@ -181,20 +181,27 @@ closureIdentity( StgClosure *p ) #ifdef PROFILING case HEAP_BY_CCS: - return ((StgClosure *)p)->header.prof.ccs; + return p->header.prof.ccs; case HEAP_BY_MOD: - return ((StgClosure *)p)->header.prof.ccs->cc->module; + return p->header.prof.ccs->cc->module; case HEAP_BY_DESCR: - return (get_itbl((StgClosure *)p))->prof.closure_desc; + return get_itbl(p)->prof.closure_desc; case HEAP_BY_TYPE: - return (get_itbl((StgClosure *)p))->prof.closure_type; + return get_itbl(p)->prof.closure_type; case HEAP_BY_RETAINER: - return retainerSetOf((StgClosure *)p); + // AFAIK, the only closures in the heap which might not have a + // valid retainer set are DEAD_WEAK closures. + if (isRetainerSetFieldValid(p)) + return retainerSetOf(p); + else + return NULL; + #else // DEBUG case HEAP_BY_INFOPTR: return (void *)((StgClosure *)p)->header.info; case HEAP_BY_CLOSURE_TYPE: return type_names[get_itbl(p)->type]; + #endif default: barf("closureIdentity"); @@ -366,6 +373,13 @@ initHeapProfiling(void) return 0; } +#ifdef PROFILING + if (doingLDVProfiling() && doingRetainerProfiling()) { + prog_belch("cannot mix -hb and -hr"); + stg_exit(1); + } +#endif + // we only count eras if we're doing LDV profiling. Otherwise era // is fixed at zero. #ifdef PROFILING @@ -505,9 +519,10 @@ fprint_ccs(FILE *fp, CostCentreStack *ccs, nat max_length) } fprintf(fp, "%s", buf); } +#endif // PROFILING -static rtsBool -str_matches_selector( char* str, char* sel ) +rtsBool +strMatchesSelector( char* str, char* sel ) { char* p; // fprintf(stderr, "str_matches_selector %s %s\n", str, sel); @@ -529,7 +544,6 @@ str_matches_selector( char* str, char* sel ) if (*sel == '\0') return rtsFalse; } } -#endif // PROFILING /* ----------------------------------------------------------------------------- * Figure out whether a closure should be counted in this census, by @@ -542,33 +556,31 @@ closureSatisfiesConstraints( StgClosure* p ) return rtsTrue; #else rtsBool b; - if (RtsFlags.ProfFlags.modSelector) { - b = str_matches_selector( ((StgClosure *)p)->header.prof.ccs->cc->module, - RtsFlags.ProfFlags.modSelector ); - if (!b) return rtsFalse; + + // The CCS has a selected field to indicate whether this closure is + // deselected by not being mentioned in the module, CC, or CCS + // selectors. + if (!p->header.prof.ccs->selected) { + return rtsFalse; } + if (RtsFlags.ProfFlags.descrSelector) { - b = str_matches_selector( (get_itbl((StgClosure *)p))->prof.closure_desc, + b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_desc, RtsFlags.ProfFlags.descrSelector ); if (!b) return rtsFalse; } if (RtsFlags.ProfFlags.typeSelector) { - b = str_matches_selector( (get_itbl((StgClosure *)p))->prof.closure_type, + b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_type, RtsFlags.ProfFlags.typeSelector ); if (!b) return rtsFalse; } - if (RtsFlags.ProfFlags.ccSelector) { - b = str_matches_selector( ((StgClosure *)p)->header.prof.ccs->cc->label, - RtsFlags.ProfFlags.ccSelector ); - if (!b) return rtsFalse; - } if (RtsFlags.ProfFlags.retainerSelector) { RetainerSet *rs; nat i; rs = retainerSetOf((StgClosure *)p); if (rs != NULL) { for (i = 0; i < rs->num; i++) { - b = str_matches_selector( rs->element[i]->cc->label, + b = strMatchesSelector( rs->element[i]->cc->label, RtsFlags.ProfFlags.retainerSelector ); if (b) return rtsTrue; } @@ -704,13 +716,13 @@ dumpCensus( Census *census ) #ifdef PROFILING if (RtsFlags.ProfFlags.bioSelector != NULL) { count = 0; - if (str_matches_selector("lag", RtsFlags.ProfFlags.bioSelector)) + if (strMatchesSelector("lag", RtsFlags.ProfFlags.bioSelector)) count += ctr->c.ldv.not_used - ctr->c.ldv.void_total; - if (str_matches_selector("drag", RtsFlags.ProfFlags.bioSelector)) + if (strMatchesSelector("drag", RtsFlags.ProfFlags.bioSelector)) count += ctr->c.ldv.drag_total; - if (str_matches_selector("void", RtsFlags.ProfFlags.bioSelector)) + if (strMatchesSelector("void", RtsFlags.ProfFlags.bioSelector)) count += ctr->c.ldv.void_total; - if (str_matches_selector("use", RtsFlags.ProfFlags.bioSelector)) + if (strMatchesSelector("use", RtsFlags.ProfFlags.bioSelector)) count += ctr->c.ldv.used - ctr->c.ldv.drag_total; } else #endif diff --git a/ghc/rts/ProfHeap.h b/ghc/rts/ProfHeap.h index 70d5ea0..82f0923 100644 --- a/ghc/rts/ProfHeap.h +++ b/ghc/rts/ProfHeap.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: ProfHeap.h,v 1.3 2001/11/26 16:54:21 simonmar Exp $ + * $Id: ProfHeap.h,v 1.4 2001/12/12 14:31:43 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -15,5 +15,6 @@ extern nat initHeapProfiling( void ); extern void endHeapProfiling( void ); extern rtsBool closureSatisfiesConstraints( StgClosure* p ); extern void LDV_recordDead( StgClosure *c, nat size ); +extern rtsBool strMatchesSelector( char* str, char* sel ); #endif diff --git a/ghc/rts/Profiling.c b/ghc/rts/Profiling.c index e8db830..c99de34 100644 --- a/ghc/rts/Profiling.c +++ b/ghc/rts/Profiling.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Profiling.c,v 1.28 2001/11/28 15:42:26 simonmar Exp $ + * $Id: Profiling.c,v 1.29 2001/12/12 14:31:43 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -36,21 +36,6 @@ unsigned int CC_ID; unsigned int CCS_ID; unsigned int HP_ID; -/* Table sizes from old profiling system. Not sure if we'll need - * these. - */ -nat time_intervals = 0; -nat earlier_ticks = 0; -nat max_cc_no = 0; -nat max_mod_no = 0; -nat max_grp_no = 0; -nat max_descr_no = 0; -nat max_type_no = 0; - -/* Are we time-profiling? - */ -rtsBool time_profiling = rtsFalse; - /* figures for the profiling report. */ static lnat total_alloc, total_prof_ticks; @@ -143,13 +128,12 @@ static CostCentreStack * ActualPush ( CostCentreStack *, CostCentre * ); static CostCentreStack * IsInIndexTable ( IndexTable *, CostCentre * ); static IndexTable * AddToIndexTable ( IndexTable *, CostCentreStack *, CostCentre *, unsigned int ); +static void ccsSetSelected ( CostCentreStack *ccs ); +static void initTimeProfiling ( void ); +static void initProfilingLogFile( void ); - -static void initTimeProfiling ( void ); -static void initProfilingLogFile( void ); - -static void reportCCS_XML ( CostCentreStack *ccs ); +static void reportCCS_XML ( CostCentreStack *ccs ); /* ----------------------------------------------------------------------------- Initialise the profiling environment @@ -212,7 +196,9 @@ initProfiling2 (void) */ ASSERT(CCS_MAIN->prevStack == 0); CCS_MAIN->root = CC_MAIN; + ccsSetSelected(CCS_MAIN); DecCCS(CCS_MAIN); + for (ccs = CCS_LIST; ccs != CCS_MAIN; ) { next = ccs->prevStack; ccs->prevStack = 0; @@ -229,7 +215,45 @@ initProfiling2 (void) initHeapProfiling(); } } - + +// Decide whether closures with this CCS should contribute to the heap +// profile. +static void +ccsSetSelected( CostCentreStack *ccs ) +{ + if (RtsFlags.ProfFlags.modSelector) { + if (! strMatchesSelector( ccs->cc->module, + RtsFlags.ProfFlags.modSelector ) ) { + ccs->selected = 0; + return; + } + } + if (RtsFlags.ProfFlags.ccSelector) { + if (! strMatchesSelector( ccs->cc->label, + RtsFlags.ProfFlags.ccSelector ) ) { + ccs->selected = 0; + return; + } + } + if (RtsFlags.ProfFlags.ccsSelector) { + CostCentreStack *c; + for (c = ccs; c != NULL; c = c->prevStack) { + if ( strMatchesSelector( c->cc->label, + RtsFlags.ProfFlags.ccsSelector )) { + break; + } + } + if (c == NULL) { + ccs->selected = 0; + return; + } + } + + ccs->selected = 1; + return; +} + + static void initProfilingLogFile(void) { @@ -281,8 +305,6 @@ initProfilingLogFile(void) void initTimeProfiling(void) { - time_profiling = rtsTrue; - /* Start ticking */ startProfTimer(); }; @@ -457,6 +479,9 @@ ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs ) new_ccs->root = ccs->root; + // Set the selected field. + ccsSetSelected(new_ccs); + /* update the memoization table for the parent stack */ if (ccs != EMPTY_STACK) ccs->indexTable = AddToIndexTable(ccs->indexTable, new_ccs, cc, @@ -669,7 +694,7 @@ fprint_header( void ) } void -report_ccs_profiling( void ) +reportCCSProfiling( void ) { nat count; char temp[128]; /* sigh: magic constant */ @@ -722,12 +747,6 @@ report_ccs_profiling( void ) fprint_header(); reportCCS(pruneCCSTree(CCS_MAIN), 0); - - // @retainer profiling - // @LDV profiling - // Now, prof_file is closed in shutdownHaskell() because this file - // is also used for retainer/LDV profiling. See shutdownHaskell(). - // fclose(prof_file); } static void @@ -745,8 +764,8 @@ reportCCS(CostCentreStack *ccs, nat indent) /* force printing of *all* cost centres if -P -P */ { - fprintf(prof_file, "%-*s%-*s %-10s", - indent, "", 24-indent, cc->label, cc->module); + fprintf(prof_file, "%6d %-*s%-*s %-10s", + ccs->ccsID, indent, "", 24-indent, cc->label, cc->module); fprintf(prof_file, "%8lld %5.1f %5.1f %5.1f %5.1f", ccs->scc_count, diff --git a/ghc/rts/Profiling.h b/ghc/rts/Profiling.h index 52db2da..dccf444 100644 --- a/ghc/rts/Profiling.h +++ b/ghc/rts/Profiling.h @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- - * $Id: Profiling.h,v 1.3 2001/11/22 14:25:12 simonmar Exp $ + * $Id: Profiling.h,v 1.4 2001/12/12 14:31:43 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -20,17 +20,10 @@ extern FILE *hp_file; #ifdef PROFILING void gen_XML_logfile ( void ); -void report_ccs_profiling ( void ); -void heap_profile_finish (void); +void reportCCSProfiling ( void ); void PrintNewStackDecls ( void ); -void print_ccs (FILE *, CostCentreStack *); - -# define DEFAULT_INTERVAL TICK_FREQUENCY - -extern rtsBool time_profiling; - extern lnat total_prof_ticks; extern void fprintCCS( FILE *f, CostCentreStack *ccs ); diff --git a/ghc/rts/Proftimer.c b/ghc/rts/Proftimer.c index 390dd69..a34752e 100644 --- a/ghc/rts/Proftimer.c +++ b/ghc/rts/Proftimer.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Proftimer.c,v 1.8 2001/11/22 14:25:12 simonmar Exp $ + * $Id: Proftimer.c,v 1.9 2001/12/12 14:31:43 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -29,17 +29,13 @@ rtsBool performHeapProfile; void stopProfTimer( void ) { - if (time_profiling) { - do_prof_ticks = rtsFalse; - } + do_prof_ticks = rtsFalse; } void startProfTimer( void ) { - if (time_profiling) { - do_prof_ticks = rtsTrue; - } + do_prof_ticks = rtsTrue; } void @@ -68,13 +64,13 @@ initProfTimer( void ) startHeapProfTimer(); } - + void handleProfTick(void) { if (do_prof_ticks) { - CCS_TICK(CCCS); + CCCS->time_ticks++; } if (do_heap_prof_ticks) { diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c index 24a4433..f9ddc83 100644 --- a/ghc/rts/RtsFlags.c +++ b/ghc/rts/RtsFlags.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsFlags.c,v 1.55 2001/12/03 14:34:45 simonmar Exp $ + * $Id: RtsFlags.c,v 1.56 2001/12/12 14:31:43 simonmar Exp $ * * (c) The AQUA Project, Glasgow University, 1994-1997 * (c) The GHC Team, 1998-1999 @@ -257,6 +257,7 @@ void initRtsFlagsDefaults(void) RtsFlags.ProfFlags.descrSelector = NULL; RtsFlags.ProfFlags.typeSelector = NULL; RtsFlags.ProfFlags.ccSelector = NULL; + RtsFlags.ProfFlags.ccsSelector = NULL; RtsFlags.ProfFlags.retainerSelector = NULL; RtsFlags.ProfFlags.bioSelector = NULL; @@ -426,7 +427,8 @@ usage_text[] = { " r = retainer", " b = biography (LAG,DRAG,VOID,USE)", " A subset of closures may be selected thusly:", -" -hc,... specific cost centre(s) (NOT STACKS!)", +" -hc,... specific cost centre(s) (top of stack only)", +" -hC,... specific cost centre(s) (anywhere in stack)", " -hm... all cost centres from the specified modules(s)", " -hd,... closures with specified closure descriptions", " -hy... closures with specified type descriptions", @@ -889,10 +891,12 @@ error = rtsTrue; *right = '\0'; switch (rts_argv[arg][2]) { - case 'C': case 'c': // cost centre label select RtsFlags.ProfFlags.ccSelector = left; break; + case 'C': + RtsFlags.ProfFlags.ccsSelector = left; + break; case 'M': case 'm': // cost centre module select RtsFlags.ProfFlags.modSelector = left; diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c index ce133dc..3bd4e0c 100644 --- a/ghc/rts/RtsStartup.c +++ b/ghc/rts/RtsStartup.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsStartup.c,v 1.59 2001/12/06 07:07:12 sof Exp $ + * $Id: RtsStartup.c,v 1.60 2001/12/12 14:31:43 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -326,7 +326,7 @@ shutdownHaskell(void) #endif #if defined(PROFILING) - report_ccs_profiling(); + reportCCSProfiling(); #endif #if defined(PROFILING) || defined(DEBUG)