diff options
-rw-r--r-- | docs/users_guide/profiling.rst | 5 | ||||
-rw-r--r-- | includes/rts/Flags.h | 4 | ||||
-rw-r--r-- | libraries/base/GHC/RTS/Flags.hsc | 6 | ||||
-rw-r--r-- | libraries/base/changelog.md | 6 | ||||
-rw-r--r-- | rts/ProfilerReport.c | 16 | ||||
-rw-r--r-- | rts/ProfilerReportJson.c | 127 | ||||
-rw-r--r-- | rts/ProfilerReportJson.h | 29 | ||||
-rw-r--r-- | rts/Profiling.c | 24 | ||||
-rw-r--r-- | rts/RtsFlags.c | 10 |
9 files changed, 200 insertions, 27 deletions
diff --git a/docs/users_guide/profiling.rst b/docs/users_guide/profiling.rst index d3fdd6233e..27b8839e3f 100644 --- a/docs/users_guide/profiling.rst +++ b/docs/users_guide/profiling.rst @@ -410,6 +410,11 @@ enclosed between ``+RTS ... -RTS`` as usual): The :rts-flag:`-pa` option produces the most detailed report containing all cost centres in addition to the actual time and allocation data. +.. rts-flag:: -pj + + The :rts-flag:`-pj` option produces a time/allocation profile report in JSON + format written into the file :file:`<program>.prof`. + .. rts-flag:: -V <secs> Sets the interval that the RTS clock ticks at, which is also the diff --git a/includes/rts/Flags.h b/includes/rts/Flags.h index 0412415aca..ebcf973742 100644 --- a/includes/rts/Flags.h +++ b/includes/rts/Flags.h @@ -115,7 +115,7 @@ typedef struct _COST_CENTRE_FLAGS { # define COST_CENTRES_SUMMARY 1 # define COST_CENTRES_VERBOSE 2 /* incl. serial time profile */ # define COST_CENTRES_ALL 3 -# define COST_CENTRES_XML 4 +# define COST_CENTRES_JSON 4 int profilerTicks; /* derived */ int msecsPerTick; /* derived */ @@ -136,7 +136,7 @@ typedef struct _PROFILING_FLAGS { Time heapProfileInterval; /* time between samples */ uint32_t heapProfileIntervalTicks; /* ticks between samples (derived) */ - bool includeTSOs; + bool includeTSOs; bool showCCSOnException; diff --git a/libraries/base/GHC/RTS/Flags.hsc b/libraries/base/GHC/RTS/Flags.hsc index 46534fed96..7bb10b60cb 100644 --- a/libraries/base/GHC/RTS/Flags.hsc +++ b/libraries/base/GHC/RTS/Flags.hsc @@ -166,7 +166,7 @@ data DoCostCentres | CostCentresSummary | CostCentresVerbose | CostCentresAll - | CostCentresXML + | CostCentresJSON deriving (Show) -- | @since 4.8.0.0 @@ -175,13 +175,13 @@ instance Enum DoCostCentres where fromEnum CostCentresSummary = #{const COST_CENTRES_SUMMARY} fromEnum CostCentresVerbose = #{const COST_CENTRES_VERBOSE} fromEnum CostCentresAll = #{const COST_CENTRES_ALL} - fromEnum CostCentresXML = #{const COST_CENTRES_XML} + fromEnum CostCentresJSON = #{const COST_CENTRES_JSON} toEnum #{const COST_CENTRES_NONE} = CostCentresNone toEnum #{const COST_CENTRES_SUMMARY} = CostCentresSummary toEnum #{const COST_CENTRES_VERBOSE} = CostCentresVerbose toEnum #{const COST_CENTRES_ALL} = CostCentresAll - toEnum #{const COST_CENTRES_XML} = CostCentresXML + toEnum #{const COST_CENTRES_JSON} = CostCentresJSON toEnum e = errorWithoutStackTrace ("invalid enum for DoCostCentres: " ++ show e) -- | Parameters pertaining to the cost-center profiler. diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 68650e323d..b8c246a3a7 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -1,6 +1,6 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) -## next *TBA* +## 4.10.0.0 *April 2017* * Bundled with GHC *TBA* * `Data.Type.Bool.Not` given a type family dependency (#12057). @@ -65,6 +65,10 @@ * `Data.Type.Equality` now provides a kind heterogeneous type equality evidence type, `(:~~:)`. + * The `CostCentresXML` constructor of `GHC.RTS.Flags.DoCostCentres` has been + replaced by `CostCentresJSON` due to the new JSON export format supported by + the cost centre profiler. + ## 4.9.0.0 *May 2016* * Bundled with GHC 8.0 diff --git a/rts/ProfilerReport.c b/rts/ProfilerReport.c index 83e2fba1bf..81f7fa046a 100644 --- a/rts/ProfilerReport.c +++ b/rts/ProfilerReport.c @@ -90,21 +90,6 @@ fprintHeader( FILE *prof_file, uint32_t max_label_len, uint32_t max_module_len, static CostCentre *sorted_cc_list; static void -aggregateCCCosts( CostCentreStack *ccs ) -{ - IndexTable *i; - - ccs->cc->mem_alloc += ccs->mem_alloc; - ccs->cc->time_ticks += ccs->time_ticks; - - for (i = ccs->indexTable; i != 0; i = i->next) { - if (!i->back_edge) { - aggregateCCCosts(i->ccs); - } - } -} - -static void insertCCInSortedList( CostCentre *new_cc ) { CostCentre **prev, *cc; @@ -130,7 +115,6 @@ reportPerCCCosts( FILE *prof_file, ProfilerTotals totals ) CostCentre *cc, *next; uint32_t max_label_len, max_module_len, max_src_len; - aggregateCCCosts(CCS_MAIN); sorted_cc_list = NULL; max_label_len = 11; // no shorter than the "COST CENTRE" header diff --git a/rts/ProfilerReportJson.c b/rts/ProfilerReportJson.c new file mode 100644 index 0000000000..b4c77042d7 --- /dev/null +++ b/rts/ProfilerReportJson.c @@ -0,0 +1,127 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2017 + * + * Generating cost-centre profiler JSON report + * + * ---------------------------------------------------------------------------*/ + +#ifdef PROFILING + +#include "PosixSource.h" +#include "Rts.h" + +#include "RtsUtils.h" +#include "ProfilerReportJson.h" +#include "Profiling.h" + +// This only handles characters that you might see in a Haskell cost-centre +// name. +static void escapeString(char const* str, char *out, int len) +{ + len--; // reserve character in output for terminating NUL + for (; str != '\0' && len > 0; str++) { + char c = *str; + if (c == '\\') { + if (len < 2) break; + *out = '\\'; out++; len--; + *out = '\\'; out++; len--; + } else if (c == '\n') { + if (len < 2) break; + *out = '\\'; out++; len--; + *out = 'n'; out++; len--; + } else { + *out = c; out++; len--; + } + } + *out = '\0'; +} + +static void +logCostCentres(FILE *prof_file) +{ + char tmp[256]; + bool needs_comma = false; + fprintf(prof_file, "[\n"); + for (CostCentre *cc = CC_LIST; cc != NULL; cc = cc->link) { + escapeString(cc->label, tmp, sizeof(tmp)); + fprintf(prof_file, + "%s" + "{\"id\": %" FMT_Int ", " + "\"label\": \"%s\", " + "\"module\": \"%s\", " + "\"src_loc\": \"%s\", " + "\"is_caf\": %s}", + needs_comma ? ", " : "", + cc->ccID, tmp, cc->module, cc->srcloc, + cc->is_caf ? "true" : "false"); + needs_comma = true; + } + fprintf(prof_file, "]\n"); +} + +static void +logCostCentreStack(FILE *prof_file, CostCentreStack const *ccs) +{ + fprintf(prof_file, + "{\"id\": %" FMT_Int ", " + "\"entries\": %" FMT_Word64 ", " + "\"alloc\": %" FMT_Word ", " + "\"ticks\": %" FMT_Word ", ", + ccs->cc->ccID, + ccs->scc_count, + ccs->mem_alloc * sizeof(W_), + ccs->time_ticks); + + bool need_comma = false; + fprintf(prof_file, "\"children\": ["); + for (IndexTable *i = ccs->indexTable; i != 0; i = i->next) { + if (!i->back_edge) { + if (need_comma) { + fprintf(prof_file, ","); + } + logCostCentreStack(prof_file, i->ccs); + need_comma = true; + } + } + fprintf(prof_file, "]}\n"); +} + +void +writeCCSReportJson(FILE *prof_file, + CostCentreStack const *stack, + ProfilerTotals totals) +{ + fprintf(prof_file, "{\n\"program\": \"%s\",\n", prog_name); + fprintf(prof_file, "\"arguments\": ["); + for (int count = 0; prog_argv[count]; count++) + fprintf(prof_file, "%s\"%s\"", + count == 0 ? "" : ", ", prog_argv[count]); + fprintf(prof_file, "],\n\"rts_arguments\": ["); + for (int count = 0; rts_argv[count]; count++) + fprintf(prof_file, "%s\"%s\"", + count == 0 ? "" : ", ", rts_argv[count]); + fprintf(prof_file, "],\n"); + + fprintf(prof_file, "\"end_time\": \"%s\",\n", time_str()); + fprintf(prof_file, "\"initial_capabilities\": %d,\n", + RtsFlags.ParFlags.nCapabilities); + fprintf(prof_file, "\"total_time\": %11.2f,\n", + ((double) totals.total_prof_ticks * + (double) RtsFlags.MiscFlags.tickInterval) / (TIME_RESOLUTION * n_capabilities)); + fprintf(prof_file, "\"total_ticks\": %lu,\n", + (unsigned long) totals.total_prof_ticks); + fprintf(prof_file, "\"tick_interval\": %d,\n", + (int) TimeToUS(RtsFlags.MiscFlags.tickInterval)); + fprintf(prof_file, "\"total_alloc\":%" FMT_Word64 ",\n", + totals.total_alloc * sizeof(W_)); + + fprintf(prof_file, "\"cost_centres\": "); + logCostCentres(prof_file); + fprintf(prof_file, ",\n\"profile\": "); + logCostCentreStack(prof_file, stack); + fprintf(prof_file, "}\n"); +} + + +#endif /* PROFILING */ diff --git a/rts/ProfilerReportJson.h b/rts/ProfilerReportJson.h new file mode 100644 index 0000000000..1e115d7265 --- /dev/null +++ b/rts/ProfilerReportJson.h @@ -0,0 +1,29 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2017 + * + * Generating cost-center profiler report + * + * ---------------------------------------------------------------------------*/ + +#ifndef PROFILER_REPORT_JSON_H +#define PROFILER_REPORT_JSON_H + +#include <stdio.h> + +#include "Rts.h" +#include "Profiling.h" + +#include "BeginPrivate.h" + +#ifdef PROFILING + +void writeCCSReportJson(FILE *prof_file, + CostCentreStack const *ccs, + ProfilerTotals totals ); + +#endif + +#include "EndPrivate.h" + +#endif /* PROFILER_REPORT_JSON_H */ diff --git a/rts/Profiling.c b/rts/Profiling.c index b0019a48fc..0dc1e26f80 100644 --- a/rts/Profiling.c +++ b/rts/Profiling.c @@ -118,6 +118,7 @@ static CostCentreStack * isInIndexTable ( IndexTable *, CostCentre * ); static IndexTable * addToIndexTable ( IndexTable *, CostCentreStack *, CostCentre *, unsigned int ); static void ccsSetSelected ( CostCentreStack *ccs ); +static void aggregateCCCosts( CostCentreStack *ccs ); static void initTimeProfiling ( void ); static void initProfilingLogFile ( void ); @@ -694,10 +695,16 @@ reportCCSProfiling( void ) if (RtsFlags.CcFlags.doCostCentres == 0) return; ProfilerTotals totals = countTickss(CCS_MAIN); + aggregateCCCosts(CCS_MAIN); inheritCosts(CCS_MAIN); CostCentreStack *stack = pruneCCSTree(CCS_MAIN); sortCCSTree(stack); - writeCCSReport(prof_file, stack, totals); + + if (RtsFlags.CcFlags.doCostCentres == COST_CENTRES_JSON) { + writeCCSReportJson(prof_file, stack, totals); + } else { + writeCCSReport(prof_file, stack, totals); + } } /* ----------------------------------------------------------------------------- @@ -752,6 +759,21 @@ inheritCosts(CostCentreStack *ccs) return; } +static void +aggregateCCCosts( CostCentreStack *ccs ) +{ + IndexTable *i; + + ccs->cc->mem_alloc += ccs->mem_alloc; + ccs->cc->time_ticks += ccs->time_ticks; + + for (i = ccs->indexTable; i != 0; i = i->next) { + if (!i->back_edge) { + aggregateCCCosts(i->ccs); + } + } +} + // // Prune CCSs with zero entries, zero ticks or zero allocation from // the tree, unless COST_CENTRES_ALL is on. diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index f924432de4..5fd368cb61 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -304,6 +304,7 @@ usage_text[] = { " -P More detailed Time/Allocation profile", " -Pa Give information about *all* cost centres", "", +" -Pj Output cost-center profile in JSON format", " -h<break-down> Heap residency profile (hp2ps) (output file <program>.hp)", " break-down: c = cost centre stack (default)", " m = module", @@ -1059,13 +1060,14 @@ error = true; error = true; } break; + case 'j': + RtsFlags.CcFlags.doCostCentres = COST_CENTRES_JSON; + break; case '\0': if (rts_argv[arg][1] == 'P') { - RtsFlags.CcFlags.doCostCentres = - COST_CENTRES_VERBOSE; + RtsFlags.CcFlags.doCostCentres = COST_CENTRES_VERBOSE; } else { - RtsFlags.CcFlags.doCostCentres = - COST_CENTRES_SUMMARY; + RtsFlags.CcFlags.doCostCentres = COST_CENTRES_SUMMARY; } break; default: |