rts: Expose interface for configuring EventLogWriterswip/init-eventlogging

This exposes a set of interfaces from the GHC API for configuring
EventLogWriters. These can be used by consumers like
[ghc-eventlog-socket](https://github.com/bgamari/ghc-eventlog-socket).

11 files changed, 195 insertions, 50 deletions

diff --git a/docs/users_guide/8.10.1-notes.rst b/docs/users_guide/8.10.1-notes.rst
index d9b48d95e0..e5ed23ca3e 100644
--- a/docs/users_guide/8.10.1-notes.rst
+++ b/docs/users_guide/8.10.1-notes.rst
@@ -222,6 +222,10 @@ Runtime system
   out-of-the-box compatibility with OpenBSD and macOS Catalina (see
   :ghc-ticket:`17353`)
 
+- The RTS API now exposes :ref:`an interface <event_log_output_api>` to
+  configure ``EventLogWriters``, allowing eventlog data to fed to sinks other
+  than ``.eventlog`` files.
+
 Template Haskell
 ~~~~~~~~~~~~~~~~
 
diff --git a/docs/users_guide/runtime_control.rst b/docs/users_guide/runtime_control.rst
index 7ebb9eb207..1f4b766400 100644
--- a/docs/users_guide/runtime_control.rst
+++ b/docs/users_guide/runtime_control.rst
@@ -174,6 +174,8 @@ e.g., on stack overflow. The hooks for these are as follows:
 
     The message printed if ``malloc`` fails.
 
+.. _event_log_output_api:
+
 Event log output
 ################
 
@@ -190,7 +192,7 @@ Furthermore GHC lets you specify the way event log data (see :rts-flag:`-l
 
     .. c:member:: bool writeEventLog(void *eventlog, size_t eventlog_size)
 
-        Hands buffered event log data to your event log writer.
+        Hands buffered event log data to your event log writer. Return true on success.
         Required for a custom :c:type:`EventLogWriter`.
 
     .. c:member:: void flushEventLog(void)
@@ -202,6 +204,24 @@ Furthermore GHC lets you specify the way event log data (see :rts-flag:`-l
 
         Called when event logging is about to stop. This can be ``NULL``.
 
+To use an :c:type:`EventLogWriter` the RTS API provides the following functions:
+
+.. c:func:: enum EventLogStatus eventLogStatus(void)
+
+   Query whether the current runtime system supports the eventlog (e.g. whether
+   the current executable was linked with :ghc-flag:`-eventlog`) and, if it
+   is supported, whether it is currently logging.
+
+.. c:func:: bool startEventLogging(const EventLogWriter *writer)
+
+   Start logging events to the given :c:type:`EventLogWriter`. Returns true on
+   success or false is another writer has already been configured.
+
+.. c:func:: void endEventLogging()
+
+   Tear down the active :c:type:`EventLogWriter`.
+
+
 .. _rts-options-misc:
 
 Miscellaneous RTS options
diff --git a/includes/rts/EventLogWriter.h b/includes/rts/EventLogWriter.h
index 5eececd20e..4975b72b07 100644
--- a/includes/rts/EventLogWriter.h
+++ b/includes/rts/EventLogWriter.h
@@ -23,7 +23,7 @@ typedef struct {
     // Initialize an EventLogWriter (may be NULL)
     void (* initEventLogWriter) (void);
 
-    // Write a series of events
+    // Write a series of events returning true on success.
     bool (* writeEventLog) (void *eventlog, size_t eventlog_size);
 
     // Flush possibly existing buffers (may be NULL)
@@ -38,3 +38,29 @@ typedef struct {
  * a file `program.eventlog`.
  */
 extern const EventLogWriter FileEventLogWriter;
+
+enum EventLogStatus {
+  /* The runtime system wasn't compiled with eventlog support. */
+  EVENTLOG_NOT_SUPPORTED,
+  /* An EventLogWriter has not yet been configured */
+  EVENTLOG_NOT_CONFIGURED,
+  /* An EventLogWriter has been configured and is running. */
+  EVENTLOG_RUNNING,
+};
+
+/*
+ * Query whether the current runtime system supports eventlogging.
+ */
+enum EventLogStatus eventLogStatus(void);
+
+/*
+ * Initialize event logging using the given EventLogWriter.
+ * Returns true on success or false if an EventLogWriter is already configured
+ * or eventlogging isn't supported by the runtime.
+ */
+bool startEventLogging(const EventLogWriter *writer);
+
+/*
+ * Stop event logging and destroy the current EventLogWriter.
+ */
+void endEventLogging(void);
diff --git a/rts/Trace.c b/rts/Trace.c
index 8e44716eb0..b35be3c1e7 100644
--- a/rts/Trace.c
+++ b/rts/Trace.c
@@ -40,21 +40,12 @@ int TRACE_cap;
 static Mutex trace_utx;
 #endif
 
-static bool eventlog_enabled;
-
 /* ---------------------------------------------------------------------------
    Starting up / shutting down the tracing facilities
  --------------------------------------------------------------------------- */
 
-static const EventLogWriter *getEventLogWriter(void)
-{
-    return rtsConfig.eventlog_writer;
-}
-
 void initTracing (void)
 {
-    const EventLogWriter *eventlog_writer = getEventLogWriter();
-
 #if defined(THREADED_RTS)
     initMutex(&trace_utx);
 #endif
@@ -95,15 +86,14 @@ void initTracing (void)
         TRACE_spark_full ||
         TRACE_user;
 
-    eventlog_enabled = RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG &&
-                        eventlog_writer != NULL;
-
     /* Note: we can have any of the TRACE_* flags turned on even when
        eventlog_enabled is off. In the DEBUG way we may be tracing to stderr.
      */
+    initEventLogging();
 
-    if (eventlog_enabled) {
-        initEventLogging(eventlog_writer);
+    if (RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG
+            && rtsConfig.eventlog_writer != NULL) {
+        startEventLogging(rtsConfig.eventlog_writer);
     }
 }
 
@@ -121,17 +111,10 @@ void freeTracing (void)
     }
 }
 
+// Used to reset tracing in a forked child
 void resetTracing (void)
 {
-    const EventLogWriter *eventlog_writer;
-    eventlog_writer = getEventLogWriter();
-
-    if (eventlog_enabled) {
-        abortEventLogging(); // abort eventlog inherited from parent
-        if (eventlog_writer != NULL) {
-            initEventLogging(eventlog_writer); // child starts its own eventlog
-        }
-    }
+    restartEventLogging();
 }
 
 void flushTrace (void)
diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c
index 5f22af5bfc..e3597cd73c 100644
--- a/rts/eventlog/EventLog.c
+++ b/rts/eventlog/EventLog.c
@@ -26,7 +26,9 @@
 #include <unistd.h>
 #endif
 
-static const EventLogWriter *event_log_writer;
+bool eventlog_enabled;
+
+static const EventLogWriter *event_log_writer = NULL;
 
 #define EVENT_LOG_SIZE 2 * (1024 * 1024) // 2MB
 
@@ -516,16 +518,22 @@ postHeaderEvents(void)
     postInt32(&eventBuf, EVENT_DATA_BEGIN);
 }
 
-void
-initEventLogging(const EventLogWriter *ev_writer)
+static uint32_t
+get_n_capabilities(void)
 {
-    uint32_t n_caps;
+#if defined(THREADED_RTS)
+    // XXX n_capabilities may not have been initialized yet
+    return (n_capabilities != 0) ? n_capabilities : RtsFlags.ParFlags.nCapabilities;
+#else
+    return 1;
+#endif
+}
 
+void
+initEventLogging()
+{
     init_event_types();
 
-    event_log_writer = ev_writer;
-    initEventLogWriter();
-
     int num_descs = sizeof(EventDesc) / sizeof(char*);
     if (num_descs != NUM_GHC_EVENT_TAGS) {
         barf("EventDesc array has the wrong number of elements (%d, NUM_GHC_EVENT_TAGS=%d)",
@@ -542,18 +550,28 @@ initEventLogging(const EventLogWriter *ev_writer)
      * Use a single buffer to store the header with event types, then flush
      * the buffer so all buffers are empty for writing events.
      */
-#if defined(THREADED_RTS)
-    // XXX n_capabilities hasn't been initialized yet
-    n_caps = RtsFlags.ParFlags.nCapabilities;
-#else
-    n_caps = 1;
-#endif
-    moreCapEventBufs(0, n_caps);
+    moreCapEventBufs(0, get_n_capabilities());
 
     initEventsBuf(&eventBuf, EVENT_LOG_SIZE, (EventCapNo)(-1));
 #if defined(THREADED_RTS)
     initMutex(&eventBufMutex);
 #endif
+}
+
+enum EventLogStatus
+eventLogStatus(void)
+{
+    if (eventlog_enabled) {
+        return EVENTLOG_RUNNING;
+    } else {
+        return EVENTLOG_NOT_CONFIGURED;
+    }
+}
+
+static bool
+startEventLogging_(void)
+{
+    initEventLogWriter();
 
     postHeaderEvents();
 
@@ -564,14 +582,42 @@ initEventLogging(const EventLogWriter *ev_writer)
      */
     printAndClearEventBuf(&eventBuf);
 
-    for (uint32_t c = 0; c < n_caps; ++c) {
+    for (uint32_t c = 0; c < get_n_capabilities(); ++c) {
         postBlockMarker(&capEventBuf[c]);
     }
+    return true;
+}
+
+bool
+startEventLogging(const EventLogWriter *ev_writer)
+{
+    if (eventlog_enabled || event_log_writer) {
+        return false;
+    }
+
+    eventlog_enabled = true;
+    event_log_writer = ev_writer;
+    return startEventLogging_();
+}
+
+// Called during forkProcess in the child to restart the eventlog writer.
+void
+restartEventLogging(void)
+{
+    freeEventLogging();
+    stopEventLogWriter();
+    initEventLogging();  // allocate new per-capability buffers
+    if (event_log_writer != NULL) {
+        startEventLogging_(); // child starts its own eventlog
+    }
 }
 
 void
 endEventLogging(void)
 {
+    if (!eventlog_enabled)
+        return;
+
     // Flush all events remaining in the buffers.
     for (uint32_t c = 0; c < n_capabilities; ++c) {
         printAndClearEventBuf(&capEventBuf[c]);
@@ -586,6 +632,8 @@ endEventLogging(void)
     printAndClearEventBuf(&eventBuf);
 
     stopEventLogWriter();
+    event_log_writer = NULL;
+    eventlog_enabled = false;
 }
 
 void
@@ -626,13 +674,6 @@ freeEventLogging(void)
     }
 }
 
-void
-abortEventLogging(void)
-{
-    freeEventLogging();
-    stopEventLogWriter();
-}
-
 /*
  * Post an event message to the capability's eventlog buffer.
  * If the buffer is full, prints out the buffer and clears it.
@@ -1440,7 +1481,7 @@ void printAndClearEventBuf (EventsBuf *ebuf)
         size_t elog_size = ebuf->pos - ebuf->begin;
         if (!writeEventLog(ebuf->begin, elog_size)) {
             debugBelch(
-                    "printAndClearEventLog: could not flush event log"
+                    "printAndClearEventLog: could not flush event log\n"
                 );
             resetEventsBuf(ebuf);
             return;
@@ -1524,4 +1565,17 @@ void postEventType(EventsBuf *eb, EventType *et)
     postInt32(eb, EVENT_ET_END);
 }
 
+#else
+
+enum EventLogStatus eventLogStatus(void)
+{
+    return EVENTLOG_NOT_SUPPORTED;
+}
+
+bool startEventLogging(const EventLogWriter *writer STG_UNUSED) {
+    return false;
+}
+
+void endEventLogging(void) {}
+
 #endif /* TRACING */
diff --git a/rts/eventlog/EventLog.h b/rts/eventlog/EventLog.h
index 5bd3b5dadb..eca76619cd 100644
--- a/rts/eventlog/EventLog.h
+++ b/rts/eventlog/EventLog.h
@@ -22,8 +22,10 @@
  */
 extern char *EventTagDesc[];
 
-void initEventLogging(const EventLogWriter *writer);
-void endEventLogging(void);
+extern bool eventlog_enabled;
+
+void initEventLogging(void);
+void restartEventLogging(void);
 void freeEventLogging(void);
 void abortEventLogging(void); // #4512 - after fork child needs to abort
 void flushEventLog(void);     // event log inherited from parent
diff --git a/rts/eventlog/EventLogWriter.c b/rts/eventlog/EventLogWriter.c
index 4b486926a7..b19e617a4c 100644
--- a/rts/eventlog/EventLogWriter.c
+++ b/rts/eventlog/EventLogWriter.c
@@ -122,6 +122,7 @@ stopEventLogFileWriter(void)
 {
     if (event_log_file != NULL) {
         fclose(event_log_file);
+        event_log_file = NULL;
     }
 }
 
diff --git a/testsuite/tests/rts/InitEventLogging.hs b/testsuite/tests/rts/InitEventLogging.hs
new file mode 100644
index 0000000000..1ec1e65028
--- /dev/null
+++ b/testsuite/tests/rts/InitEventLogging.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+-- Test that the startEventLog interface works as expected.
+main :: IO ()
+main = do
+  putStrLn "Starting eventlog..."
+  c_init_eventlog
+  putStrLn "done"
+
+foreign import ccall unsafe "init_eventlog"
+  c_init_eventlog :: IO ()
diff --git a/testsuite/tests/rts/InitEventLogging.stdout b/testsuite/tests/rts/InitEventLogging.stdout
new file mode 100644
index 0000000000..7cbab8fe59
--- /dev/null
+++ b/testsuite/tests/rts/InitEventLogging.stdout
@@ -0,0 +1,8 @@
+Starting eventlog...
+done
+init
+write
+write
+write
+write
+stop
diff --git a/testsuite/tests/rts/InitEventLogging_c.c b/testsuite/tests/rts/InitEventLogging_c.c
new file mode 100644
index 0000000000..47e4520fc4
--- /dev/null
+++ b/testsuite/tests/rts/InitEventLogging_c.c
@@ -0,0 +1,33 @@
+#include <stdio.h>
+#include <Rts.h>
+
+void test_init(void) {
+  printf("init\n");
+}
+
+bool test_write(void *eventlog, size_t eventlog_size) {
+  printf("write\n");
+  return true;
+}
+
+void test_flush(void) {
+  printf("flush\n");
+}
+
+void test_stop(void) {
+  printf("stop\n");
+}
+
+const EventLogWriter writer = {
+  .initEventLogWriter = test_init,
+  .writeEventLog = test_write,
+  .flushEventLog = test_flush,
+  .stopEventLogWriter = test_stop
+};
+
+void init_eventlog(void) {
+  if (!startEventLogging(&writer)) {
+    printf("failed to start eventlog\n");
+  }
+}
+
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index bd634d1e56..0bbddfba3e 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -406,3 +406,6 @@ test('T13676',
      [when(opsys('darwin') or opsys('mingw32'), expect_broken(17447)),
       extra_files(['T13676.hs'])],
      ghci_script, ['T13676.script'])
+test('InitEventLogging',
+     [only_ways(['normal']), extra_run_opts('+RTS -RTS')],
+     compile_and_run, ['-eventlog InitEventLogging_c.c'])