Optimize Info Table Provenance Entries (IPEs) Map creation and lookup

Using a hash map reduces the complexity of lookupIPE(), making it non linear.

On registration each IPE list is added to a temporary IPE lists buffer, reducing
registration time. The hash map is built lazily on first lookup.

IPE event output to stderr is added with tests.

For details, please see
Note [The Info Table Provenance Entry (IPE) Map].

A performance test for IPE registration and lookup can be found here:
https://gitlab.haskell.org/ghc/ghc/-/merge_requests/5724#note_370806

6 files changed, 199 insertions, 57 deletions

diff --git a/rts/IPE.c b/rts/IPE.c
index 122331e066..19db89a063 100644
--- a/rts/IPE.c
+++ b/rts/IPE.c
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team, 1998-2000
+ * (c) The GHC Team, 1998-2021
  *
  * Support for mapping info table pointers to source locations
  *
@@ -10,72 +10,189 @@
 #include "rts/PosixSource.h"
 #include "Rts.h"
 
-#include "RtsUtils.h"
-#include "Profiling.h"
 #include "Arena.h"
+#include "Capability.h"
+#include "Hash.h"
 #include "IPE.h"
 #include "Printer.h"
-#include "Capability.h"
+#include "Profiling.h"
+#include "RtsUtils.h"
 
 #include <fs_rts.h>
 #include <string.h>
 
-
 #if defined(TRACING)
 #include "Trace.h"
 #endif
 
-InfoProvEnt *IPE_LIST = NULL;
+/*
+Note [The Info Table Provenance Entry (IPE) Map]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+IPEs are stored in a hash map from info table address (pointer) to IPE. This
+ensures cheap lookup and traversal.
+
+Unfortunately, inserting into the hash map is relatively expensive. To keep
+startup times low, there's a temporary data structure that is optimized for
+collecting IPE lists on registration.
+
+It's a singly linked list of IPE list buffers. Each buffer contains space for
+126 IPE lists. This number is a bit arbitrary, but leaves a few bytes so that
+the whole structure might fit into 1024 bytes.
+
+On registering a new IPE list, there are three cases:
 
-void dumpIPEToEventLog(void)
-{
+- It's the first entry at all: Allocate a new IpeBufferListNode and make it the
+  buffer's first entry.
+- The current IpeBufferListNode has space in it's buffer: Add it to the buffer.
+- The current IpeBufferListNode's buffer is full: Allocate a new one and link it
+to the previous one, making this one the new current.
+
+Building the hash map is done lazily, i.e. on first lookup or traversal. For
+this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs.
+
+After the content of a IpeBufferListNode has been inserted, it's freed.
+*/
+
+static HashTable *ipeMap = NULL;
+
+static IpeBufferListNode *ipeBufferList = NULL;
+
+static Mutex ipeMapLock;
+
+void initIpeMapLock(void) { initMutex(&ipeMapLock); }
+
+void closeIpeMapLock(void) { closeMutex(&ipeMapLock); }
+
+void dumpIPEToEventLog(void) {
 #if defined(TRACING)
-    InfoProvEnt *ip, *next;
-    for (ip = IPE_LIST; ip != NULL; ip = next) {
-        next = ip->link;
-        traceIPE(ip->info, ip->prov.table_name, ip->prov.closure_desc, ip->prov.ty_desc
-                , ip->prov.label, ip->prov.module, ip->prov.srcloc);
+    ACQUIRE_LOCK(&ipeMapLock);
+
+    IpeBufferListNode *cursor = ipeBufferList;
+    while (cursor != NULL) {
+        for (int i = 0; i < cursor->count; i++) {
+            for (InfoProvEnt **ipeList = cursor->buffer[i]; *ipeList != NULL;
+                 ipeList++) {
+                InfoProvEnt *ipe = *ipeList;
+
+                traceIPE(ipe->info, ipe->prov.table_name,
+                         ipe->prov.closure_desc, ipe->prov.ty_desc,
+                         ipe->prov.label, ipe->prov.module, ipe->prov.srcloc);
+            }
+        }
+
+        cursor = cursor->next;
+    }
+
+    if (ipeMap != NULL) {
+        mapHashTable(ipeMap, NULL, &traceIPEFromHashTable);
     }
+
+    RELEASE_LOCK(&ipeMapLock);
 #endif
     return;
 }
 
+#if defined(TRACING)
+void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED,
+                           const void *value) {
+    InfoProvEnt *ipe = (InfoProvEnt *)value;
 
-/* -----------------------------------------------------------------------------
-   Registering IPEs
+    traceIPE(ipe->info, ipe->prov.table_name, ipe->prov.closure_desc,
+             ipe->prov.ty_desc, ipe->prov.label, ipe->prov.module,
+             ipe->prov.srcloc);
+}
+#endif
 
-   Registering a IPE consists of linking it onto the list of registered IPEs
+/* Registering IPEs
 
-   IPEs are registered at startup by a C constructor function
-   generated by the compiler (ProfInit.hs) in the _stub.c file for each module.
- -------------------------------------------------------------------------- */
+Adds the ent_list to the temporary buffer structure described in
+Note [The Info Table Provenance Entry (IPE) Map].
 
-static void
-registerInfoProvEnt(InfoProvEnt *ipe)
-{
-        ASSERT(ipe->link == NULL);
-        ipe->link = IPE_LIST;
-        IPE_LIST = ipe;
-}
+Statically initialized IPE lists are registered at startup by a C constructor
+function generated by the compiler (CodeOutput.hs) in a *.c file for each
+module.
+
+A performance test for IPE registration and lookup can be found here:
+https://gitlab.haskell.org/ghc/ghc/-/merge_requests/5724#note_370806
+*/
+void registerInfoProvList(InfoProvEnt **ent_list) {
+    // The list must be dereferenceable.
+    ASSERT(ent_list[0] == NULL || ent_list[0] != NULL);
 
-void registerInfoProvList(InfoProvEnt **ent_list)
-{
-    for (InfoProvEnt **i = ent_list; *i != NULL; i++) {
-        registerInfoProvEnt(*i);
+    // Ignore empty lists
+    if (ent_list[0] == NULL) {
+        return;
+    }
+
+    ACQUIRE_LOCK(&ipeMapLock);
+
+    if (ipeBufferList == NULL) {
+        ASSERT(ipeBufferList == NULL);
+
+        ipeBufferList = stgMallocBytes(sizeof(IpeBufferListNode),
+                                       "registerInfoProvList-firstNode");
+        ipeBufferList->buffer[0] = ent_list;
+        ipeBufferList->count = 1;
+        ipeBufferList->next = NULL;
+    } else {
+        if (ipeBufferList->count < IPE_LIST_NODE_BUFFER_SIZE) {
+            ipeBufferList->buffer[ipeBufferList->count] = ent_list;
+            ipeBufferList->count = ipeBufferList->count + 1;
+
+            ASSERT(ipeBufferList->next == NULL ||
+                   ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE);
+        } else {
+            IpeBufferListNode *newNode = stgMallocBytes(
+                sizeof(IpeBufferListNode), "registerInfoProvList-nextNode");
+            newNode->buffer[0] = ent_list;
+            newNode->count = 1;
+            newNode->next = ipeBufferList;
+            ipeBufferList = newNode;
+
+            ASSERT(ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE);
+        }
     }
+
+    RELEASE_LOCK(&ipeMapLock);
+}
+
+InfoProvEnt *lookupIPE(StgInfoTable *info) {
+    updateIpeMap();
+    return lookupHashTable(ipeMap, (StgWord)info);
 }
 
+void updateIpeMap() {
+    // Check if there's any work at all. If not so, we can circumvent locking,
+    // which decreases performance.
+    if (ipeMap != NULL && ipeBufferList == NULL) {
+        return;
+    }
+
+    ACQUIRE_LOCK(&ipeMapLock);
 
-// MP: TODO: This should not be a linear search, need to improve
-// the IPE_LIST structure
-InfoProvEnt * lookupIPE(StgInfoTable *info)
-{
-    InfoProvEnt *ip, *next;
-    for (ip = IPE_LIST; ip != NULL; ip = next) {
-        if (ip->info == info) {
-            return ip;
+    if (ipeMap == NULL) {
+        ipeMap = allocHashTable();
+    }
+
+    while (ipeBufferList != NULL) {
+        ASSERT(ipeBufferList->next == NULL ||
+               ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE);
+        ASSERT(ipeBufferList->count > 0 &&
+               ipeBufferList->count <= IPE_LIST_NODE_BUFFER_SIZE);
+
+        IpeBufferListNode *currentNode = ipeBufferList;
+
+        for (int i = 0; i < currentNode->count; i++) {
+            for (InfoProvEnt **ipeList = currentNode->buffer[i];
+                 *ipeList != NULL; ipeList++) {
+                insertHashTable(ipeMap, (StgWord)(*ipeList)->info, *ipeList);
+            }
         }
-        next = ip->link;
+
+        ipeBufferList = currentNode->next;
+        stgFree(currentNode);
     }
-    return NULL;
+
+    RELEASE_LOCK(&ipeMapLock);
 }
diff --git a/rts/IPE.h b/rts/IPE.h
index 48b4c62f00..064ff9d7ad 100644
--- a/rts/IPE.h
+++ b/rts/IPE.h
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team, 1998-2005
+ * (c) The GHC Team, 1998-2021
  *
  * Support for IPE
  *
@@ -8,11 +8,27 @@
 
 #pragma once
 
-#include <stdio.h>
 #include "Rts.h"
+#include <stdio.h>
 
 #include "BeginPrivate.h"
 
+#define IPE_LIST_NODE_BUFFER_SIZE 126
+
+typedef struct IpeBufferListNode_ {
+    InfoProvEnt **buffer[IPE_LIST_NODE_BUFFER_SIZE];
+    StgWord8 count;
+    struct IpeBufferListNode_ *next;
+} IpeBufferListNode;
+
 void dumpIPEToEventLog(void);
+void updateIpeMap(void);
+void initIpeMapLock(void);
+void closeIpeMapLock(void);
+
+#if defined(TRACING)
+void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED,
+                           const void *value);
+#endif
 
 #include "EndPrivate.h"
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 371c96d08c..86d5b2f2d9 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -370,6 +370,7 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
 #if defined(PROFILING)
     initProfiling();
 #endif
+    initIpeMapLock();
     traceInitEvent(dumpIPEToEventLog);
     initHeapProfiling();
 
@@ -593,6 +594,8 @@ hs_exit_(bool wait_foreign)
 
     // Free threading resources
     freeThreadingResources();
+
+    closeIpeMapLock();
 }
 
 // Flush stdout and stderr.  We do this during shutdown so that it
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index 0632dfa6df..b17d017c31 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -536,7 +536,6 @@
 #define RTS_PROF_SYMBOLS                        \
       SymI_HasProto(CCS_DONT_CARE)              \
       SymI_HasProto(CC_LIST)                    \
-      SymI_HasProto(IPE_LIST)                    \
       SymI_HasProto(stg_restore_cccs_info)      \
       SymI_HasProto(enterFunCCS)                \
       SymI_HasProto(pushCostCentre)             \
diff --git a/rts/Trace.c b/rts/Trace.c
index d08b19a69d..8f2877a536 100644
--- a/rts/Trace.c
+++ b/rts/Trace.c
@@ -668,6 +668,17 @@ void traceIPE(StgInfoTable * info,
               const char *module,
               const char *srcloc )
 {
+#if defined(DEBUG)
+    if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
+        ACQUIRE_LOCK(&trace_utx);
+
+        tracePreface();
+        debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s\n",
+                   table_name, closure_desc, ty_desc, label, module, srcloc);
+
+        RELEASE_LOCK(&trace_utx);
+    } else
+#endif
     if (eventlog_enabled) {
         postIPE((W_) INFO_PTR_TO_STRUCT(info), table_name, closure_desc, ty_desc, label, module, srcloc);
     }
diff --git a/rts/include/rts/IPE.h b/rts/include/rts/IPE.h
index 81a6d553d0..07026979d8 100644
--- a/rts/include/rts/IPE.h
+++ b/rts/include/rts/IPE.h
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team, 2017-2018
+ * (c) The GHC Team, 2017-2021
  *
  * IPE API
  *
@@ -13,23 +13,19 @@
 
 #pragma once
 
-
-typedef struct InfoProv_{
-    char * table_name;
-    char * closure_desc;
-    char * ty_desc;
-    char * label;
-    char * module;
-    char * srcloc;
+typedef struct InfoProv_ {
+    char *table_name;
+    char *closure_desc;
+    char *ty_desc;
+    char *label;
+    char *module;
+    char *srcloc;
 } InfoProv;
 
 typedef struct InfoProvEnt_ {
-    StgInfoTable * info;
+    StgInfoTable *info;
     InfoProv prov;
-    struct InfoProvEnt_ *link;
 } InfoProvEnt;
 
-extern InfoProvEnt * RTS_VAR(IPE_LIST);               // registered IP list
-
 void registerInfoProvList(InfoProvEnt **cc_list);
-InfoProvEnt * lookupIPE(StgInfoTable *info);
+InfoProvEnt *lookupIPE(StgInfoTable *info);