rts: Add LibdwPool, a pool for libdw sessions

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

includes/Rts.h

@@ -239,6 +239,7 @@ INLINE_HEADER Time fsecondsToTime (double t)
 #include "rts/Main.h"
 #include "rts/StaticPtrTable.h"
 #include "rts/Libdw.h"
+#include "rts/LibdwPool.h"
 
 /* Misc stuff without a home */
 DLL_IMPORT_RTS extern char **prog_argv; /* so we can get at these from Haskell */

includes/rts/LibdwPool.h

+/* ---------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2015-2016
+ *
+ * A pool of libdw sessions
+ *
+ * --------------------------------------------------------------------------*/
+
+#ifndef RTS_LIBDW_POOL_H
+#define RTS_LIBDW_POOL_H
+
+/* Claim a session from the pool */
+LibdwSession *libdwPoolTake(void);
+
+/* Return a session to the pool */
+void libdwPoolRelease(LibdwSession *sess);
+
+/* Free any sessions in the pool forcing a reload of any loaded debug
+ * information */
+void libdwPoolClear(void);
+
+#endif /* RTS_LIBDW_POOL_H */

rts/LibdwPool.c

+/* ---------------------------------------------------------------------------
+ *
+ * (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 */

rts/LibdwPool.h

+/* ---------------------------------------------------------------------------
+ *
+ * (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 */

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()).
      */

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 */