rts: Add LibdwPool, a pool for libdw sessions

Differential Revision: https://phabricator.haskell.org/D1198#40948

4 files changed, 86 insertions, 1 deletions

diff --git a/rts/LibdwPool.c b/rts/LibdwPool.c
new file mode 100644
index 0000000000..f625c0f699
--- /dev/null
+++ b/rts/LibdwPool.c
@@ -0,0 +1,48 @@
+/* ---------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2014-2015
+ *
+ * A pool of libdw sessions
+ *
+ * --------------------------------------------------------------------------*/
+
+#include "Rts.h"
+#include "RtsUtils.h"
+#include "LibdwPool.h"
+
+#ifdef USE_LIBDW
+
+#include <unistd.h>
+
+#include "Pool.h"
+
+static Pool *pool = NULL;
+static nat pool_size = 10; // TODO
+
+void libdwPoolInit(void) {
+    pool = poolInit(pool_size, pool_size,
+                    (alloc_thing_fn) libdwInit,
+                    (free_thing_fn) libdwFree);
+}
+
+LibdwSession *libdwPoolTake(void) {
+    return poolTake(pool);
+}
+
+void libdwPoolRelease(LibdwSession *sess) {
+    poolRelease(pool, sess);
+}
+
+void libdwPoolClear(void) {
+    poolFlush(pool);
+}
+
+#else /* !USE_LIBDW */
+
+LibdwSession *libdwPoolTake(void) { return NULL; }
+
+void libdwPoolRelease(LibdwSession *sess STG_UNUSED) { }
+
+void libdwPoolClear(void) { }
+
+#endif /* USE_LIBDW */
diff --git a/rts/LibdwPool.h b/rts/LibdwPool.h
new file mode 100644
index 0000000000..a6b670e6f1
--- /dev/null
+++ b/rts/LibdwPool.h
@@ -0,0 +1,30 @@
+/* ---------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2015-2016
+ *
+ * A pool of libdw sessions
+ *
+ * --------------------------------------------------------------------------*/
+
+#ifndef LIBDW_POOL_H
+#define LIBDW_POOL_H
+
+#include "BeginPrivate.h"
+
+#include "Rts.h"
+#include "Libdw.h"
+
+#ifdef USE_LIBDW
+
+/* Initialize the pool */
+void libdwPoolInit(void);
+
+#else
+
+INLINE_HEADER void libdwPoolInit(void) {}
+
+#endif /* USE_LIBDW */
+
+#include "EndPrivate.h"
+
+#endif /* LIBDW_POOL_H */
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index ac4460e329..bd6a6ae14a 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -34,6 +34,7 @@
 #include "Globals.h"
 #include "FileLock.h"
 #include "LinkerInternals.h"
+#include "LibdwPool.h"
 
 #if defined(PROFILING)
 # include "ProfHeap.h"
@@ -164,6 +165,9 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
     initTracing();
 #endif
 
+    /* Initialise libdw session pool */
+    libdwPoolInit();
+
     /* initialise scheduler data structures (needs to be done before
      * initStorage()).
      */
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index bfcc3cd344..936dffca74 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -39,7 +39,10 @@
 #define RTS_LIBDW_SYMBOLS                       \
       SymE_HasProto(backtraceFree)              \
       SymE_HasProto(libdwGetBacktrace)          \
-      SymE_HasProto(libdwLookupLocation)
+      SymE_HasProto(libdwLookupLocation)        \
+      SymE_HasProto(libdwPoolTake)              \
+      SymE_HasProto(libdwPoolRelease)           \
+      SymE_HasProto(libdwPoolClear)
 #else
 #define RTS_LIBDW_SYMBOLS
 #endif /* USE_LIBDW */