1 files changed, 81 insertions, 0 deletions
diff --git a/rts/IPE.c b/rts/IPE.c
new file mode 100644
index 0000000000..d881682e7d
--- /dev/null
+++ b/rts/IPE.c
@@ -0,0 +1,81 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2000
+ *
+ * Support for mapping info table pointers to source locations
+ *
+ * ---------------------------------------------------------------------------*/
+
+
+#include "PosixSource.h"
+#include "Rts.h"
+
+#include "RtsUtils.h"
+#include "Profiling.h"
+#include "Arena.h"
+#include "IPE.h"
+#include "Printer.h"
+#include "Capability.h"
+
+#include <fs_rts.h>
+#include <string.h>
+
+
+#if defined(TRACING)
+#include "Trace.h"
+#endif
+
+InfoProvEnt *IPE_LIST = NULL;
+
+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);
+    }
+#endif
+    return;
+}
+
+
+/* -----------------------------------------------------------------------------
+   Registering IPEs
+
+   Registering a IPE consists of linking it onto the list of registered 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.
+ -------------------------------------------------------------------------- */
+
+static void
+registerInfoProvEnt(InfoProvEnt *ipe)
+{
+        ASSERT(ipe->link == NULL);
+        ipe->link = IPE_LIST;
+        IPE_LIST = ipe;
+}
+
+void registerInfoProvList(InfoProvEnt **ent_list)
+{
+    for (InfoProvEnt **i = ent_list; *i != NULL; i++) {
+        registerInfoProvEnt(*i);
+    }
+}
+
+
+// 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;
+        }
+        next = ip->link;
+    }
+    return NULL;
+}