From bc210f7d267e8351ccb66972f4b3a650eb9338bb Mon Sep 17 00:00:00 2001 From: sewardj Date: Wed, 14 Mar 2001 11:18:18 +0000 Subject: [PATCH] [project @ 2001-03-14 11:18:18 by sewardj] Add closure selection for heap profiling. You can use -hc{cc_names}, -hd{descrs}, -hy{types}, -hm{mods} to restrict profiled closures to the specified sets. Multiple restrictions are allowed. --- ghc/rts/ProfHeap.c | 130 +++++++++++++++++++++++++++++++++++++++++----------- ghc/rts/RtsFlags.c | 51 +++++++++++++++++++-- ghc/rts/RtsFlags.h | 10 ++-- 3 files changed, 158 insertions(+), 33 deletions(-) diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c index acd7778..02b714e 100644 --- a/ghc/rts/ProfHeap.c +++ b/ghc/rts/ProfHeap.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: ProfHeap.c,v 1.20 2000/12/11 12:36:59 simonmar Exp $ + * $Id: ProfHeap.c,v 1.21 2001/03/14 11:18:18 sewardj Exp $ * * (c) The GHC Team, 1998-2000 * @@ -172,7 +172,28 @@ initHeapProfiling(void) return 0; } - fprintf(hp_file, "JOB \"%s\"\n", prog_argv[0]); + fprintf(hp_file, "JOB \"%s", prog_argv[0]); + +# ifdef PROFILING + switch (RtsFlags.ProfFlags.doHeapProfile) { + case HEAP_BY_CCS: fprintf(hp_file, " -h%c", CCchar); break; + case HEAP_BY_MOD: fprintf(hp_file, " -h%c", MODchar); break; + case HEAP_BY_DESCR: fprintf(hp_file, " -h%c", DESCRchar); break; + case HEAP_BY_TYPE: fprintf(hp_file, " -h%c", TYPEchar); break; + default: /* nothing */ + } + if (RtsFlags.ProfFlags.ccSelector) + fprintf(hp_file, " -hc{%s}", RtsFlags.ProfFlags.ccSelector); + if (RtsFlags.ProfFlags.modSelector) + fprintf(hp_file, " -hm{%s}", RtsFlags.ProfFlags.modSelector); + if (RtsFlags.ProfFlags.descrSelector) + fprintf(hp_file, " -hd{%s}", RtsFlags.ProfFlags.descrSelector); + if (RtsFlags.ProfFlags.typeSelector) + fprintf(hp_file, " -hy{%s}", RtsFlags.ProfFlags.typeSelector); +# endif /* PROFILING */ + + fprintf(hp_file, "\"\n" ); + fprintf(hp_file, "DATE \"%s\"\n", time_str()); fprintf(hp_file, "SAMPLE_UNIT \"seconds\"\n"); @@ -285,9 +306,8 @@ static void fprint_data(FILE *fp) { nat i; - for (i = 0; i < SYMBOL_HASH_SIZE; i++) { - if (symbol_hash[i].data) { + if (symbol_hash[i].data > 0) { fprintf(fp, " %s %d\n", symbol_hash[i].name, symbol_hash[i].data); } } @@ -433,7 +453,62 @@ reportCCSResid(FILE *fp, CostCentreStack *ccs) } } } -#endif + +static +rtsBool str_matches_selector ( char* str, char* sel ) +{ + char* p; + /* fprintf(stderr, "str_matches_selector %s %s\n", str, sel); */ + while (1) { + /* Compare str against wherever we've got to in sel. */ + p = str; + while (*p != '\0' && *sel != ',' && *sel != '\0' && *p == *sel) { + p++; sel++; + } + /* Match if all of str used and have reached the end of a sel + fragment. */ + if (*p == '\0' && (*sel == ',' || *sel == '\0')) + return rtsTrue; + + /* No match. Advance sel to the start of the next elem. */ + while (*sel != ',' && *sel != '\0') sel++; + if (*sel == ',') sel++; + + /* Run out of sel ?? */ + if (*sel == '\0') return rtsFalse; + } +} + +/* Figure out whether a closure should be counted in this census, by + testing against all the specified constraints. */ +static +rtsBool satisfies_constraints ( StgClosure* p ) +{ + rtsBool b; + if (RtsFlags.ProfFlags.modSelector) { + b = str_matches_selector( ((StgClosure *)p)->header.prof.ccs->cc->module, + RtsFlags.ProfFlags.modSelector ); + if (!b) return rtsFalse; + } + if (RtsFlags.ProfFlags.descrSelector) { + b = str_matches_selector( (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, + 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; + } + return rtsTrue; +} +#endif /* PROFILING */ + void heapCensus(void) @@ -572,27 +647,30 @@ heapCensus(void) } #endif -#ifdef PROFILING - switch (RtsFlags.ProfFlags.doHeapProfile) { - case HEAP_BY_CCS: - ((StgClosure *)p)->header.prof.ccs->mem_resid += size; - break; - case HEAP_BY_MOD: - strToCtr(((StgClosure *)p)->header.prof.ccs->cc->module) - ->mem_resid += size; - break; - case HEAP_BY_DESCR: - strToCtr(get_itbl(((StgClosure *)p))->prof.closure_desc)->mem_resid - += size; - break; - case HEAP_BY_TYPE: - strToCtr(get_itbl(((StgClosure *)p))->prof.closure_type)->mem_resid - += size; - break; - default: - barf("heapCensus; doHeapProfile"); - } -#endif +# ifdef PROFILING + if (satisfies_constraints((StgClosure*)p)) { + switch (RtsFlags.ProfFlags.doHeapProfile) { + case HEAP_BY_CCS: + ((StgClosure *)p)->header.prof.ccs->mem_resid += size; + break; + case HEAP_BY_MOD: + strToCtr(((StgClosure *)p)->header.prof.ccs->cc->module) + ->mem_resid += size; + break; + case HEAP_BY_DESCR: + strToCtr(get_itbl(((StgClosure *)p))->prof.closure_desc)->mem_resid + += size; + break; + case HEAP_BY_TYPE: + strToCtr(get_itbl(((StgClosure *)p))->prof.closure_type)->mem_resid + += size; + break; + default: + barf("heapCensus; doHeapProfile"); + } + } +# endif + p += size; } bd = bd->link; diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c index f8b8e99..b6d210f 100644 --- a/ghc/rts/RtsFlags.c +++ b/ghc/rts/RtsFlags.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsFlags.c,v 1.36 2001/01/24 15:41:30 simonmar Exp $ + * $Id: RtsFlags.c,v 1.37 2001/03/14 11:18:18 sewardj Exp $ * * (c) The AQUA Project, Glasgow University, 1994-1997 * (c) The GHC Team, 1998-1999 @@ -238,10 +238,14 @@ void initRtsFlagsDefaults(void) #endif /* PROFILING or PAR */ #ifdef PROFILING - RtsFlags.ProfFlags.doHeapProfile = rtsFalse; + RtsFlags.ProfFlags.doHeapProfile = rtsFalse; RtsFlags.ProfFlags.showCCSOnException = rtsFalse; + RtsFlags.ProfFlags.modSelector = NULL; + RtsFlags.ProfFlags.descrSelector = NULL; + RtsFlags.ProfFlags.typeSelector = NULL; + RtsFlags.ProfFlags.ccSelector = NULL; #elif defined(DEBUG) - RtsFlags.ProfFlags.doHeapProfile = rtsFalse; + RtsFlags.ProfFlags.doHeapProfile = rtsFalse; #endif RtsFlags.ConcFlags.ctxtSwitchTime = CS_MIN_MILLISECS; /* In milliseconds */ @@ -383,13 +387,19 @@ usage_text[] = { " -px Time/allocation profile (XML) (output file .prof)", " -p Time/allocation profile (output file .prof)", " sort: T = time (default), A = alloc, C = cost centre label", -" -P More detailed Time/Allocation profile" +" -P More detailed Time/Allocation profile", + # if defined(PROFILING) "", " -hx Heap residency profile (XML) (output file .prof)", " -h Heap residency profile (text) (output file .prof)", " break-down: C = cost centre stack (default), M = module", " D = closure description, Y = type description", +" A subset of closures may be selected thusly:", +" -hc{cc, cc ...} specific cost centre(s) (NOT STACKS!)", +" -hm{mod,mod...} all cost centres from the specified modules(s)", +" -hd{des,des...} closures with specified closure descriptions", +" -hy{typ,typ...} closures with specified type descriptions", "", " -xc Show current cost centre stack on raising an exception", # endif @@ -747,11 +757,44 @@ error = rtsTrue; case TYPEchar: RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_TYPE; break; + case 'c': /* cost centre label select */ + case 'm': /* cost centre module select */ + case 'd': /* closure descr select */ + case 'y': /* closure type select */ + {char *left = strchr(rts_argv[arg], '{'); + char *right = strrchr(rts_argv[arg], '}'); + if (! left || ! right || + strrchr(rts_argv[arg], '{') != left || + strchr(rts_argv[arg], '}') != right) { + prog_belch( + "Invalid heap profiling selection bracketing\n %s\n", + rts_argv[arg]); + error = rtsTrue; + } else { + *right = '\0'; + switch (rts_argv[arg][2]) { + case 'c': /* cost centre label select */ + RtsFlags.ProfFlags.ccSelector = left + 1; + break; + case 'm': /* cost centre module select */ + RtsFlags.ProfFlags.modSelector = left + 1; + break; + case 'd': /* closure descr select */ + RtsFlags.ProfFlags.descrSelector = left + 1; + break; + case 'y': /* closure type select */ + RtsFlags.ProfFlags.typeSelector = left + 1; + break; + } + } + } + break; default: prog_belch("invalid heap profile option: %s",rts_argv[arg]); error = rtsTrue; } ) + #endif break; diff --git a/ghc/rts/RtsFlags.h b/ghc/rts/RtsFlags.h index 62ad3bd..1642247 100644 --- a/ghc/rts/RtsFlags.h +++ b/ghc/rts/RtsFlags.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsFlags.h,v 1.30 2000/12/19 12:50:37 simonmar Exp $ + * $Id: RtsFlags.h,v 1.31 2001/03/14 11:18:18 sewardj Exp $ * * (c) The GHC Team, 1998-1999 * @@ -92,7 +92,6 @@ struct PROFILING_FLAGS { # define HEAP_BY_MOD 2 # define HEAP_BY_DESCR 4 # define HEAP_BY_TYPE 5 -# define HEAP_BY_TIME 6 rtsBool showCCSOnException; @@ -100,7 +99,12 @@ struct PROFILING_FLAGS { # define MODchar 'M' # define DESCRchar 'D' # define TYPEchar 'Y' -# define TIMEchar 'T' + + char* modSelector; + char* descrSelector; + char* typeSelector; + char* ccSelector; + }; #elif defined(DEBUG) # define NO_HEAP_PROFILING 0 -- 1.7.10.4