rts: Allow profile output path to be specified on RTS command line

This introduces a RTS option, -po, which allows the user to override the stem
used to form the output file names of the heap profile and cost center summary.

It's a bit unclear to me whether this is really the interface we want.
Alternatively we could just allow the user to specify the `.hp` and `.prof` file
names separately. This would arguably be a bit more straightforward and would
allow the user to name JSON output with an appropriate `.json` suffix if they so
desired. However, this would come at the cost of taking more of the option
space, which is a somewhat precious commodity.

Test Plan: Validate, try using `-po` RTS option

Reviewers: simonmar, austin, erikd

Reviewed By: simonmar

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D3182

4 files changed, 44 insertions, 23 deletions

diff --git a/docs/users_guide/profiling.rst b/docs/users_guide/profiling.rst
index 764ee92c8d..832464e8b0 100644
--- a/docs/users_guide/profiling.rst
+++ b/docs/users_guide/profiling.rst
@@ -402,7 +402,8 @@ enclosed between ``+RTS ... -RTS`` as usual):
        single: time profile
 
     The :rts-flag:`-p` option produces a standard *time profile* report. It is
-    written into the file :file:`program.prof`.
+    written into the file :file:`<stem>.prof`; the stem is taken to be the program
+    name by default, but can be overridden by the :rts-flag:`-po` flag.
 
     The :rts-flag:`-P` option produces a more detailed report containing the
     actual time and allocation data as well. (Not used much.)
@@ -415,6 +416,16 @@ enclosed between ``+RTS ... -RTS`` as usual):
     The :rts-flag:`-pj` option produces a time/allocation profile report in JSON
     format written into the file :file:`<program>.prof`.
 
+.. rts-flag:: -po ⟨stem⟩
+
+    The :rts-flag:`-po` option overrides the stem used to form the output file
+    paths for the cost-center profiler (see :rts-flag:`-p` and :rts-flag:`-pj`
+    flags above) and heap profiler (see :rts-flag:`-h`).
+
+    For instance, running a program with ``+RTS -h -p -pohello-world`` would
+    produce a heap profile named :file:`hello-world.hp` and a cost-center
+    profile named :file:`hello-world.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 ebcf973742..c8f71d1342 100644
--- a/includes/rts/Flags.h
+++ b/includes/rts/Flags.h
@@ -119,6 +119,7 @@ typedef struct _COST_CENTRE_FLAGS {
 
     int	    profilerTicks;   /* derived */
     int	    msecsPerTick;    /* derived */
+    char const *oututFileNameStem;
 } COST_CENTRE_FLAGS;
 
 /* See Note [Synchronization of flags and base APIs] */
diff --git a/rts/Profiling.c b/rts/Profiling.c
index 0dc1e26f80..c0d60a5cec 100644
--- a/rts/Profiling.c
+++ b/rts/Profiling.c
@@ -228,32 +228,39 @@ CostCentre *mkCostCentre (char *label, char *module, char *srcloc)
 static void
 initProfilingLogFile(void)
 {
-    char *prog;
+    // Figure out output file name stem.
+    char const *stem;
+    if (RtsFlags.CcFlags.outputFileNameStem) {
+        stem = RtsFlags.CcFlags.outputFileNameStem;
+    } else {
+        char *prog;
 
-    prog = arenaAlloc(prof_arena, strlen(prog_name) + 1);
-    strcpy(prog, prog_name);
+        prog = arenaAlloc(prof_arena, strlen(prog_name) + 1);
+        strcpy(prog, prog_name);
 #ifdef mingw32_HOST_OS
-    // on Windows, drop the .exe suffix if there is one
-    {
-        char *suff;
-        suff = strrchr(prog,'.');
-        if (suff != NULL && !strcmp(suff,".exe")) {
-            *suff = '\0';
+        // on Windows, drop the .exe suffix if there is one
+        {
+            char *suff;
+            suff = strrchr(prog,'.');
+            if (suff != NULL && !strcmp(suff,".exe")) {
+                *suff = '\0';
+            }
         }
-    }
 #endif
+        stem = prog;
+    }
 
     if (RtsFlags.CcFlags.doCostCentres == 0 && !doingRetainerProfiling())
     {
-        /* No need for the <prog>.prof file */
+        /* No need for the <stem>.prof file */
         prof_filename = NULL;
         prof_file = NULL;
     }
     else
     {
         /* Initialise the log file name */
-        prof_filename = arenaAlloc(prof_arena, strlen(prog) + 6);
-        sprintf(prof_filename, "%s.prof", prog);
+        prof_filename = arenaAlloc(prof_arena, strlen(stem) + 6);
+        sprintf(prof_filename, "%s.prof", stem);
 
         /* open the log file */
         if ((prof_file = fopen(prof_filename, "w")) == NULL) {
@@ -269,13 +276,13 @@ initProfilingLogFile(void)
 
     if (RtsFlags.ProfFlags.doHeapProfile) {
         /* Initialise the log file name */
-        hp_filename = arenaAlloc(prof_arena, strlen(prog) + 6);
-        sprintf(hp_filename, "%s.hp", prog);
+        hp_filename = arenaAlloc(prof_arena, strlen(stem) + 6);
+        sprintf(hp_filename, "%s.hp", stem);
 
         /* open the log file */
         if ((hp_file = fopen(hp_filename, "w")) == NULL) {
             debugBelch("Can't open profiling report file %s\n",
-                    hp_filename);
+                       hp_filename);
             RtsFlags.ProfFlags.doHeapProfile = 0;
         }
     }
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 9cff81001e..8d713542cc 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -296,14 +296,16 @@ usage_text[] = {
 "  -S[<file>] Detailed GC statistics (if <file> omitted, uses stderr)",
 "",
 "",
-"  -Z       Don't squeeze out update frames on stack overflow",
-"  -B       Sound the bell at the start of each garbage collection",
+"  -Z         Don't squeeze out update frames on stack overflow",
+"  -B         Sound the bell at the start of each garbage collection",
 #if defined(PROFILING)
 "",
-"  -p       Time/allocation profile        (output file <program>.prof)",
-"  -P       More detailed Time/Allocation profile",
-"  -Pa      Give information about *all* cost centres",
-"  -pj      Output cost-center profile in JSON format",
+"  -p         Time/allocation profile in tree format ",
+"             (output file <output prefix>.prof)",
+"  -po<file>  Override profiling output file name prefix (program name by default)",
+"  -P         More detailed Time/Allocation profile in tree format",
+"  -Pa        Give information about *all* cost centres in tree format",
+"  -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)",