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

1 files changed, 23 insertions, 16 deletions

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;
         }
     }