rts: Allow output filename of eventlog to be given by command-line

This introduces the `+RTS -ol` flag, which allows user to specify the
destination file for eventlog output.

Test Plan: Validate with included test

Reviewers: simonmar, erikd

Reviewed By: simonmar

Subscribers: rwbarton, carter

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

1 files changed, 37 insertions, 27 deletions

diff --git a/rts/eventlog/EventLogWriter.c b/rts/eventlog/EventLogWriter.c
index e6f560fc24..9f6f487d8e 100644
--- a/rts/eventlog/EventLogWriter.c
+++ b/rts/eventlog/EventLogWriter.c
@@ -33,43 +33,53 @@ static bool writeEventLogFile(void *eventlog, size_t eventlog_size);
 static void flushEventLogFile(void);
 static void stopEventLogFileWriter(void);
 
-static void
-initEventLogFileWriter(void)
+static char *outputFileName(void)
 {
-    char *prog, *event_log_filename;
 
-    prog = stgMallocBytes(strlen(prog_name) + 1, "initEventLogFileWriter");
-    strcpy(prog, prog_name);
+    if (RtsFlags.TraceFlags.trace_output) {
+        return strdup(RtsFlags.TraceFlags.trace_output);
+    } else {
+        char *prog = stgMallocBytes(strlen(prog_name) + 1,
+                                    "initEventLogFileWriter");
+        strcpy(prog, prog_name);
 #if defined(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
-    event_log_filename = stgMallocBytes(strlen(prog)
+        char *filename = stgMallocBytes(strlen(prog)
                                         + 10 /* .%d */
                                         + 10 /* .eventlog */,
                                         "initEventLogFileWriter");
 
-    if (event_log_pid == -1) { // #4512
-        // Single process
-        sprintf(event_log_filename, "%s.eventlog", prog);
-        event_log_pid = getpid();
-    } else {
-        // Forked process, eventlog already started by the parent
-        // before fork
-        event_log_pid = getpid();
-        // We don't have a FMT* symbol for pid_t, so we go via Word64
-        // to be sure of not losing range. It would be nicer to have a
-        // FMT* symbol or similar, though.
-        sprintf(event_log_filename, "%s.%" FMT_Word64 ".eventlog",
-                prog, (StgWord64)event_log_pid);
+        if (event_log_pid == -1) { // #4512
+            // Single process
+            sprintf(filename, "%s.eventlog", prog);
+            event_log_pid = getpid();
+        } else {
+            // Forked process, eventlog already started by the parent
+            // before fork
+            event_log_pid = getpid();
+            // We don't have a FMT* symbol for pid_t, so we go via Word64
+            // to be sure of not losing range. It would be nicer to have a
+            // FMT* symbol or similar, though.
+            sprintf(filename, "%s.%" FMT_Word64 ".eventlog",
+                    prog, (StgWord64)event_log_pid);
+        }
+        stgFree(prog);
+        return filename;
     }
-    stgFree(prog);
+}
+
+static void
+initEventLogFileWriter(void)
+{
+    char *event_log_filename = outputFileName();
 
     /* Open event log file for writing. */
     if ((event_log_file = __rts_fopen(event_log_filename, "wb")) == NULL) {