summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/ghc.mk2
-rw-r--r--compiler/main/DynFlags.hs1
-rw-r--r--configure.ac3
-rw-r--r--distrib/configure.ac.in5
-rw-r--r--includes/Rts.h1
-rw-r--r--includes/rts/Libdw.h90
-rw-r--r--mk/config.mk.in3
-rw-r--r--rts/Libdw.c334
-rw-r--r--rts/Libdw.h58
-rw-r--r--rts/ghc.mk8
-rw-r--r--rts/package.conf.in4
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
View Lorry Controller Status