rts: Add LibdwPool, a pool for libdw sessions

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

1 files changed, 48 insertions, 0 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 */