[commit: ghc] master: rts: Add LibdwPool, a pool for libdw sessions (6fbf22d)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/6fbf22da47a18145daf59c8f262f46af2cb8cefb/ghc

>---------------------------------------------------------------

commit 6fbf22da47a18145daf59c8f262f46af2cb8cefb
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Thu Oct 22 22:17:11 2015 +0200

    rts: Add LibdwPool, a pool for libdw sessions
    
    Differential Revision: https://phabricator.haskell.org/D1198#40948


>---------------------------------------------------------------

6fbf22da47a18145daf59c8f262f46af2cb8cefb
 includes/Rts.h           |  1 +
 includes/rts/LibdwPool.h | 22 ++++++++++++++++++++++
 rts/LibdwPool.c          | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 rts/LibdwPool.h          | 30 ++++++++++++++++++++++++++++++
 rts/RtsStartup.c         |  4 ++++
 rts/RtsSymbols.c         |  5 ++++-
 6 files changed, 109 insertions(+), 1 deletion(-)

diff --git a/includes/Rts.h b/includes/Rts.h
index 955cd53..6f4f33e 100644
--- a/includes/Rts.h
+++ b/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 */
diff --git a/includes/rts/LibdwPool.h b/includes/rts/LibdwPool.h
new file mode 100644
index 0000000..3360192
--- /dev/null
+++ b/includes/rts/LibdwPool.h
@@ -0,0 +1,22 @@
+/* ---------------------------------------------------------------------------
+ *
+ * (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 */
diff --git a/rts/LibdwPool.c b/rts/LibdwPool.c
new file mode 100644
index 0000000..f625c0f
--- /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 0000000..a6b670e
--- /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 ac4460e..bd6a6ae 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 bfcc3cd..936dffc 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 */