Libdw: Add libdw-based stack unwinding

This adds basic support to the RTS for DWARF-assisted unwinding of the
Haskell and C stack via libdw. This only adds the infrastructure;
consumers of this functionality will be introduced in future diffs.

Currently we are carrying the initial register collection code in
Libdw.c but this will eventually make its way upstream to libdw.

Test Plan: See future patches

Reviewers: Tarrasch, scpmw, austin, simonmar

Reviewed By: austin, simonmar

Subscribers: simonmar, thomie, erikd

Differential Revision: https://phabricator.haskell.org/D1196

GHC Trac Issues: #10656

11 files changed, 509 insertions, 0 deletions

diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 6846ad7b97..5883b8a3c0 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -102,6 +102,8 @@ endif
 	@echo 'cGhcWithSMP           = "$(GhcWithSMP)"'                     >> $@
 	@echo 'cGhcRTSWays           :: String'                             >> $@
 	@echo 'cGhcRTSWays           = "$(GhcRTSWays)"'                     >> $@
+	@echo 'cGhcRtsWithLibdw      :: String'                             >> $@
+	@echo 'cGhcRtsWithLibdw      = "$(GhcRtsWithLibdw)"'                >> $@
 	@echo 'cGhcEnableTablesNextToCode :: String'                        >> $@
 	@echo 'cGhcEnableTablesNextToCode = "$(GhcEnableTablesNextToCode)"' >> $@
 	@echo 'cLeadingUnderscore    :: String'                             >> $@
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 3ecb1031a4..438586595e 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -4073,6 +4073,7 @@ compilerInfo dflags
        ("Support SMP",                 cGhcWithSMP),
        ("Tables next to code",         cGhcEnableTablesNextToCode),
        ("RTS ways",                    cGhcRTSWays),
+       ("RTS expects libdw",           cGhcRtsWithLibdw),
        ("Support dynamic-too",         if isWindows then "NO" else "YES"),
        ("Support parallel --make",     "YES"),
        ("Support reexported-modules",  "YES"),
diff --git a/configure.ac b/configure.ac
index aba71a3eb4..6b01076898 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1095,6 +1095,9 @@ if test "$use_large_address_space" = "yes" ; then
    AC_DEFINE([USE_LARGE_ADDRESS_SPACE], [1], [Enable single heap address space support])
 fi
 
+AC_CHECK_LIB(dw, dwfl_begin, [HaveLibdw=YES], [HaveLibdw=NO])
+AC_SUBST(HaveLibdw)
+
 if test -n "$SPHINXBUILD"; then
     BUILD_MAN=YES
     BUILD_SPHINX_HTML=YES
diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in
index 0fcd869491..0f68a52358 100644
--- a/distrib/configure.ac.in
+++ b/distrib/configure.ac.in
@@ -91,6 +91,11 @@ dnl --------------------------------------------------------------
 FIND_LD([LdCmd])
 AC_SUBST([LdCmd])
 
+dnl ** Have libdw?
+dnl --------------------------------------------------------------
+AC_CHECK_LIB(dw, dwfl_begin, [HaveLibdw=YES], [HaveLibdw=NO])
+AC_SUBST(HaveLibdw)
+
 FP_GCC_VERSION
 AC_PROG_CPP
 
diff --git a/includes/Rts.h b/includes/Rts.h
index e6e36f846e..955cd53d23 100644
--- a/includes/Rts.h
+++ b/includes/Rts.h
@@ -238,6 +238,7 @@ INLINE_HEADER Time fsecondsToTime (double t)
 #include "rts/PrimFloat.h"
 #include "rts/Main.h"
 #include "rts/StaticPtrTable.h"
+#include "rts/Libdw.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/Libdw.h b/includes/rts/Libdw.h
new file mode 100644
index 0000000000..b9b1db4236
--- /dev/null
+++ b/includes/rts/Libdw.h
@@ -0,0 +1,90 @@
+/* ---------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2014-2015
+ *
+ * Producing DWARF-based stacktraces with libdw.
+ *
+ * --------------------------------------------------------------------------*/
+
+#ifndef RTS_LIBDW_H
+#define RTS_LIBDW_H
+
+// Chunk capacity
+// This is rather arbitrary
+#define BACKTRACE_CHUNK_SZ 256
+
+/*
+ * Note [Chunked stack representation]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ * Consider the stack,
+ *     main                   calls                        (bottom of stack)
+ *       func1                which in turn calls
+ *         func2              which calls
+ *          func3             which calls
+ *            func4           which calls
+ *              func5         which calls
+ *                func6       which calls
+ *                  func7     which requests a backtrace   (top of stack)
+ *
+ * This would produce the Backtrace (using a smaller chunk size of three for
+ * illustrative purposes),
+ *
+ * Backtrace     /----> Chunk         /----> Chunk         /----> Chunk
+ * last --------/       next --------/       next --------/       next
+ * n_frames=8           n_frames=2           n_frames=3           n_frames=3
+ *                      ~~~~~~~~~~           ~~~~~~~~~~           ~~~~~~~~~~
+ *                      func1                func4                func7
+ *                      main                 func3                func6
+ *                                           func2                func5
+ *
+ */
+
+/* A chunk of code addresses from an execution stack
+ *
+ * The first address in this list corresponds to the stack frame
+ * nearest to the "top" of the stack.
+ */
+typedef struct BacktraceChunk_ {
+    StgWord n_frames;                      // number of frames in this chunk
+    struct BacktraceChunk_ *next;          // the chunk following this one
+    StgPtr frames[BACKTRACE_CHUNK_SZ];     // the code addresses from the
+                                           // frames
+} __attribute__((packed)) BacktraceChunk;
+
+/* A chunked list of code addresses from an execution stack
+ *
+ * This structure is optimized for append operations since we append O(stack
+ * depth) times yet typically only traverse the stack trace once. Consequently,
+ * the "top" stack frame (that is, the one where we started unwinding) can be
+ * found in the last chunk. Yes, this is a bit inconsistent with the ordering
+ * within a chunk. See Note [Chunked stack representation] for a depiction.
+ */
+typedef struct Backtrace_ {
+    StgWord n_frames;        // Total number of frames in the backtrace
+    BacktraceChunk *last;    // The first chunk of frames (corresponding to the
+                             // bottom of the stack)
+} Backtrace;
+
+/* Various information describing the location of an address */
+typedef struct Location_ {
+    const char *object_file;
+    const char *function;
+
+    // lineno and colno are only valid if source_file /= NULL
+    const char *source_file;
+    StgWord32 lineno;
+    StgWord32 colno;
+} __attribute__((packed)) Location;
+
+#ifdef USE_LIBDW
+
+void backtrace_free(Backtrace *bt);
+
+#else
+
+INLINE_HEADER void backtrace_free(Backtrace *bt STG_UNUSED) { }
+
+#endif /* USE_LIBDW */
+
+#endif /* RTS_LIBDW_H */
diff --git a/mk/config.mk.in b/mk/config.mk.in
index 67121b35a2..0a9f92b64d 100644
--- a/mk/config.mk.in
+++ b/mk/config.mk.in
@@ -341,6 +341,9 @@ FFILibDir=@FFILibDir@
 FFIIncludeDir=@FFIIncludeDir@
 
 
+# Include support for DWARF unwinding
+GhcRtsWithLibdw = @HaveLibdw@
+
 ################################################################################
 #
 #		Paths (see paths.mk)
diff --git a/rts/Libdw.c b/rts/Libdw.c
new file mode 100644
index 0000000000..86f07c3c5e
--- /dev/null
+++ b/rts/Libdw.c
@@ -0,0 +1,334 @@
+/* ---------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2014-2015
+ *
+ * Producing DWARF-based stacktraces with libdw.
+ *
+ * --------------------------------------------------------------------------*/
+
+#ifdef USE_LIBDW
+
+#include <elfutils/libdwfl.h>
+#include <dwarf.h>
+#include <unistd.h>
+
+#include "Rts.h"
+#include "Libdw.h"
+#include "RtsUtils.h"
+
+static BacktraceChunk *backtrace_alloc_chunk(BacktraceChunk *next) {
+    BacktraceChunk *chunk = stgMallocBytes(sizeof(BacktraceChunk),
+                                           "backtrace_alloc_chunk");
+    chunk->n_frames = 0;
+    chunk->next = next;
+    return chunk;
+}
+
+// Allocate a Backtrace
+static Backtrace *backtrace_alloc(void) {
+    Backtrace *bt = stgMallocBytes(sizeof(Backtrace), "backtrace_alloc");
+    bt->n_frames = 0;
+    bt->last = backtrace_alloc_chunk(NULL);
+    return bt;
+}
+
+static void backtrace_push(Backtrace *bt, StgPtr pc) {
+    // Is this chunk full?
+    if (bt->last->n_frames == BACKTRACE_CHUNK_SZ)
+        bt->last = backtrace_alloc_chunk(bt->last);
+
+    // Push the PC
+    bt->last->frames[bt->last->n_frames] = pc;
+    bt->last->n_frames++;
+    bt->n_frames++;
+}
+
+void backtrace_free(Backtrace *bt) {
+    if (bt == NULL)
+        return;
+    BacktraceChunk *chunk = bt->last;
+    while (chunk != NULL) {
+        BacktraceChunk *next = chunk->next;
+        stgFree(chunk);
+        chunk = next;
+    }
+    stgFree(bt);
+}
+
+struct LibDwSession_ {
+    Dwfl *dwfl;
+    Backtrace *cur_bt; // The current backtrace we are collecting (if any)
+};
+
+typedef struct LibDwSession_ LibDwSession;
+
+static const Dwfl_Thread_Callbacks thread_cbs;
+
+void libdw_free(LibDwSession *session) {
+    if (session == NULL)
+        return;
+    dwfl_end(session->dwfl);
+    stgFree(session);
+}
+
+// Create a libdw session with DWARF information for all loaded modules
+LibDwSession *libdw_init() {
+    LibDwSession *session = stgCallocBytes(1, sizeof(LibDwSession),
+                                           "libdw_init");
+    // Initialize ELF library
+    if (elf_version(EV_CURRENT) == EV_NONE) {
+        sysErrorBelch("libelf version too old!");
+        return NULL;
+    }
+
+    // Initialize a libdwfl session
+    static char *debuginfo_path;
+    static const Dwfl_Callbacks proc_callbacks =
+        {
+            .find_debuginfo = dwfl_standard_find_debuginfo,
+            .debuginfo_path = &debuginfo_path,
+            .find_elf = dwfl_linux_proc_find_elf,
+        };
+    session->dwfl = dwfl_begin (&proc_callbacks);
+    if (session->dwfl == NULL) {
+        sysErrorBelch("dwfl_begin failed: %s", dwfl_errmsg(dwfl_errno()));
+        free(session);
+        return NULL;
+    }
+
+    // Report the loaded modules
+    int ret = dwfl_linux_proc_report(session->dwfl, getpid());
+    if (ret < 0) {
+        sysErrorBelch("dwfl_linux_proc_report failed: %s",
+                      dwfl_errmsg(dwfl_errno()));
+        goto fail;
+    }
+    if (dwfl_report_end (session->dwfl, NULL, NULL) != 0) {
+        sysErrorBelch("dwfl_report_end failed: %s", dwfl_errmsg(dwfl_errno()));
+        goto fail;
+    }
+
+    pid_t pid = getpid();
+    if (! dwfl_attach_state(session->dwfl, NULL, pid, &thread_cbs, NULL)) {
+        sysErrorBelch("dwfl_attach_state failed: %s",
+                      dwfl_errmsg(dwfl_errno()));
+        goto fail;
+    }
+
+    return session;
+
+ fail:
+    dwfl_end(session->dwfl);
+    free(session);
+    return NULL;
+}
+
+int libdw_lookup_location(LibDwSession *session, Location *frame,
+                           StgPtr pc) {
+    // Find the module containing PC
+    Dwfl_Module *mod = dwfl_addrmodule(session->dwfl, (Dwarf_Addr) pc);
+    if (mod == NULL)
+        return 1;
+    dwfl_module_info(mod, NULL, NULL, NULL, NULL, NULL,
+                     &frame->object_file, NULL);
+
+    // Find function name
+    frame->function = dwfl_module_addrname(mod, (Dwarf_Addr) pc);
+
+    // Try looking up source location
+    Dwfl_Line *line = dwfl_module_getsrc(mod, (Dwarf_Addr) pc);
+    if (line != NULL) {
+        Dwarf_Addr addr;
+        int lineno, colno;
+        /* libdwfl owns the source_file buffer, don't free it */
+        frame->source_file = dwfl_lineinfo(line, &addr, &lineno,
+                                           &colno, NULL, NULL);
+        frame->lineno = lineno;
+        frame->colno = colno;
+    }
+
+    if (line == NULL || frame->source_file == NULL) {
+        frame->source_file = NULL;
+        frame->lineno = 0;
+        frame->colno = 0;
+    }
+    return 0;
+}
+
+int foreach_frame_outwards(Backtrace *bt,
+                           int (*cb)(StgPtr, void*),
+                           void *user_data)
+{
+    int n_chunks = bt->n_frames / BACKTRACE_CHUNK_SZ;
+    if (bt->n_frames % BACKTRACE_CHUNK_SZ != 0)
+        n_chunks++;
+
+    BacktraceChunk **chunks =
+        stgMallocBytes(n_chunks * sizeof(BacktraceChunk *),
+                       "foreach_frame_outwards");
+
+    // First build a list of chunks, ending with the inner-most chunk
+    int chunk_idx;
+    chunks[0] = bt->last;
+    for (chunk_idx = 1; chunk_idx < n_chunks; chunk_idx++) {
+        chunks[chunk_idx] = chunks[chunk_idx-1]->next;
+    }
+
+    // Now iterate back through the frames
+    int res = 0;
+    for (chunk_idx = n_chunks-1; chunk_idx >= 0 && res == 0; chunk_idx--) {
+        unsigned int i;
+        BacktraceChunk *chunk = chunks[chunk_idx];
+        for (i = 0; i < chunk->n_frames; i++) {
+            res = cb(chunk->frames[i], user_data);
+            if (res != 0) break;
+        }
+    }
+    free(chunks);
+    return res;
+}
+
+struct PrintData {
+    LibDwSession *session;
+    FILE *file;
+};
+
+static int print_frame(StgPtr pc, void *cbdata)
+{
+    struct PrintData *pd = (struct PrintData *) cbdata;
+    Location loc;
+    libdw_lookup_location(pd->session, &loc, pc);
+    fprintf(pd->file, "  %24p    %s ",
+            (void*) pc, loc.function);
+    if (loc.source_file)
+        fprintf(pd->file, "(%s:%d.%d)\n",
+                loc.source_file, loc.lineno, loc.colno);
+    else
+        fprintf(pd->file, "(%s)\n", loc.object_file);
+    return 0;
+}
+
+void libdw_print_backtrace(LibDwSession *session, FILE *file, Backtrace *bt) {
+    if (bt == NULL) {
+        fprintf(file, "Warning: tried to print failed backtrace\n");
+        return;
+    }
+
+    struct PrintData pd = { session, file };
+    foreach_frame_outwards(bt, print_frame, &pd);
+}
+
+// Remember that we are traversing from the inner-most to the outer-most frame
+static int frame_cb(Dwfl_Frame *frame, void *arg) {
+    LibDwSession *session = arg;
+    Dwarf_Addr pc;
+    bool is_activation;
+    if (! dwfl_frame_pc(frame, &pc, &is_activation)) {
+        // failed to find PC
+        backtrace_push(session->cur_bt, 0x0);
+    } else {
+        if (is_activation)
+            pc -= 1; // TODO: is this right?
+        backtrace_push(session->cur_bt, (StgPtr) pc);
+    }
+
+    if ((void *) pc == &stg_stop_thread_info)
+        return DWARF_CB_ABORT;
+    else
+        return DWARF_CB_OK;
+}
+
+Backtrace *libdw_get_backtrace(LibDwSession *session) {
+    if (session->cur_bt != NULL) {
+        sysErrorBelch("Already collecting backtrace. Uh oh.");
+        return NULL;
+    }
+
+    Backtrace *bt = backtrace_alloc();
+    session->cur_bt = bt;
+
+    int pid = getpid();
+    int ret = dwfl_getthread_frames(session->dwfl, pid, frame_cb, session);
+    if (ret == -1)
+        sysErrorBelch("Failed to get stack frames of current process: %s",
+                      dwfl_errmsg(dwfl_errno()));
+
+    session->cur_bt = NULL;
+    return bt;
+}
+
+static pid_t next_thread(Dwfl *dwfl, void *arg, void **thread_argp) {
+    /* there is only the current thread */
+    if (*thread_argp != NULL)
+        return 0;
+
+    *thread_argp = arg;
+    return dwfl_pid(dwfl);
+}
+
+static bool memory_read(Dwfl *dwfl STG_UNUSED, Dwarf_Addr addr,
+                        Dwarf_Word *result, void *arg STG_UNUSED) {
+    *result = *(Dwarf_Word *) addr;
+    return true;
+}
+
+static bool set_initial_registers(Dwfl_Thread *thread, void *arg);
+
+#ifdef x86_64_HOST_ARCH
+static bool set_initial_registers(Dwfl_Thread *thread,
+                                  void *arg STG_UNUSED) {
+    Dwarf_Word regs[17];
+    __asm__ ("movq %%rax, 0x00(%0)\n\t"
+             "movq %%rdx, 0x08(%0)\n\t"
+             "movq %%rcx, 0x10(%0)\n\t"
+             "movq %%rbx, 0x18(%0)\n\t"
+             "movq %%rsi, 0x20(%0)\n\t"
+             "movq %%rdi, 0x28(%0)\n\t"
+             "movq %%rbp, 0x30(%0)\n\t"
+             "movq %%rsp, 0x38(%0)\n\t"
+             "movq %%r8,  0x40(%0)\n\t"
+             "movq %%r9,  0x48(%0)\n\t"
+             "movq %%r10, 0x50(%0)\n\t"
+             "movq %%r11, 0x58(%0)\n\t"
+             "movq %%r12, 0x60(%0)\n\t"
+             "movq %%r13, 0x68(%0)\n\t"
+             "movq %%r14, 0x70(%0)\n\t"
+             "movq %%r15, 0x78(%0)\n\t"
+             "lea 0(%%rip), %%rax\n\t"
+             "movq %%rax, 0x80(%0)\n\t"
+             :                            /* no output */
+             :"r" (&regs[0])              /* input */
+             :"%rax"                      /* clobbered */
+        );
+    return dwfl_thread_state_registers(thread, 0, 17, regs);
+}
+#endif
+#ifdef i386_HOST_ARCH
+static bool set_initial_registers(Dwfl_Thread *thread,
+                                  void *arg STG_UNUSED) {
+    Dwarf_Word regs[9];
+    __asm__ ("movl %%eax, 0x00(%0)\n\t"
+             "movl %%ecx, 0x04(%0)\n\t"
+             "movl %%edx, 0x08(%0)\n\t"
+             "movl %%ebx, 0x0c(%0)\n\t"
+             "movl %%esp, 0x10(%0)\n\t"
+             "movl %%ebp, 0x14(%0)\n\t"
+             "movl %%esp, 0x18(%0)\n\t"
+             "movl %%edi, 0x1c(%0)\n\t"
+             "lea 0(%%eip), %%eax\n\t"
+             "movl %%eax, 0x20(%0)\n\t"
+             :                            /* no output */
+             :"r" (&regs[0])              /* input */
+             :"%eax"                      /* clobbered */
+        );
+    return dwfl_thread_state_registers(thread, 0, 9, regs);
+}
+#endif
+
+static const Dwfl_Thread_Callbacks thread_cbs = {
+    .next_thread = next_thread,
+    .memory_read = memory_read,
+    .set_initial_registers = set_initial_registers,
+};
+
+#endif /* USE_LIBDW */
diff --git a/rts/Libdw.h b/rts/Libdw.h
new file mode 100644
index 0000000000..8c5f1cadb8
--- /dev/null
+++ b/rts/Libdw.h
@@ -0,0 +1,58 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2014-2015
+ *
+ * Producing stacktraces with DWARF unwinding using libdw..
+ *
+ * Do not #include this file directly: #include "Rts.h" instead.
+ *
+ * To understand the structure of the RTS headers, see the wiki:
+ *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes
+ *
+ * -------------------------------------------------------------------------- */
+
+#ifndef LIBDW_H
+#define LIBDW_H
+
+#include "BeginPrivate.h"
+
+#ifdef USE_LIBDW
+
+struct LibDwSession_;
+typedef struct LibDwSession_ LibDwSession;
+
+/* Begin a libdw session. A session is tied to a particular capability */
+LibDwSession *libdw_init(void);
+
+/* Free a session */
+void libdw_free(LibDwSession *session);
+
+/* Request a backtrace of the current stack state */
+Backtrace *libdw_get_backtrace(LibDwSession *session);
+
+/* Lookup Location information for the given address.
+ * Returns 0 if successful, 1 if address could not be found. */
+int libdw_lookup_location(LibDwSession *session, Location *loc, StgPtr pc);
+
+/* Pretty-print a backtrace to std*/
+void libdw_print_backtrace(LibDwSession *session, FILE *file, Backtrace *bt);
+
+// Traverse backtrace in order of outer-most to inner-most frame
+#define FOREACH_FRAME_INWARDS(pc, bt)                                 \
+    BacktraceChunk *_chunk;                                           \
+    unsigned int _frame_idx;                                          \
+    for (_chunk = &bt->frames; _chunk != NULL; _chunk = _chunk->next) \
+        for (_frame_idx=0;                                            \
+             pc = _chunk->frames[_frame_idx], _frame_idx < _chunk->n_frames; \
+             _frame_idx++)
+
+// Traverse a backtrace in order of inner-most to outer-most frame
+int foreach_frame_outwards(Backtrace *bt,
+                           int (*cb)(StgPtr, void*),
+                           void *user_data);
+
+#endif /* USE_LIBDW */
+
+#include "EndPrivate.h"
+
+#endif /* LIBDW_H */
diff --git a/rts/ghc.mk b/rts/ghc.mk
index 84f1b761b9..4b7f28ad89 100644
--- a/rts/ghc.mk
+++ b/rts/ghc.mk
@@ -489,6 +489,14 @@ rts_PACKAGE_CPP_OPTS += '-DFFI_LIB="C$(LIBFFI_NAME)"'
 
 endif
 
+#-----------------------------------------------------------------------------
+# Add support for reading DWARF debugging information, if available
+
+ifeq "$(GhcRtsWithLibdw)" "YES"
+rts_CC_OPTS          += -DUSE_LIBDW
+rts_PACKAGE_CPP_OPTS += -DUSE_LIBDW
+endif
+
 # -----------------------------------------------------------------------------
 # dependencies
 
diff --git a/rts/package.conf.in b/rts/package.conf.in
index 0a096583c5..97cc4f98fa 100644
--- a/rts/package.conf.in
+++ b/rts/package.conf.in
@@ -56,6 +56,10 @@ extra-libraries:
 #if USE_PAPI
                              , "papi"
 #endif
+#ifdef USE_LIBDW
+                             , "elf"
+                             , "dw"             /* for backtraces */
+#endif
 
 #ifdef INSTALLING
 include-dirs:           INCLUDE_DIR PAPI_INCLUDE_DIR FFI_INCLUDE_DIR