Add stack traces on crashes on Windows

Summary:
This patch adds the ability to generate stack traces on crashes for Windows.
When running in the interpreter this attempts to use symbol information from
the interpreter and information we know about the loaded object files to
resolve addresses to symbols.

When running compiled it doesn't have this information and then defaults
to using symbol information from PDB files. Which for now means only
files compiled with ICC or MSVC will show traces compiled.

But I have a future patch that may address this shortcoming.

Also since I don't know how to walk a pure haskell stack, I can for now
only show the last entry. I'm hoping to figure out how Apply.cmm works to
be able to walk the stalk and give more entries for pure haskell code.

In GHCi

```
$ echo main | inplace/bin/ghc-stage2.exe --interactive ./testsuite/tests/rts/derefnull.hs
GHCi, version 8.3.20170830: http://www.haskell.org/ghc/  :? for help
Ok, 1 module loaded.
Prelude Main>
Access violation in generated code when reading 0x0

 Attempting to reconstruct a stack trace...

   Frame        Code address
 * 0x77cde10    0xc370229 E:\..\base\dist-install\build\HSbase-4.10.0.0.o+0x190031
                 (base_ForeignziStorable_zdfStorableInt4_info+0x3f)
```

and compiled

```
Access violation in generated code when reading 0x0

 Attempting to reconstruct a stack trace...

   Frame        Code address
 * 0xf0dbd0     0x40bb01 E:\..\rts\derefnull.run\derefnull.exe+0xbb01
```

Test Plan: ./validate

Reviewers: austin, hvr, bgamari, erikd, simonmar

Reviewed By: bgamari

Subscribers: rwbarton, thomie

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

2 files changed, 93 insertions, 4 deletions

diff --git a/rts/win32/veh_excn.c b/rts/win32/veh_excn.c
index 5105d7676f..3ac008d780 100644
--- a/rts/win32/veh_excn.c
+++ b/rts/win32/veh_excn.c
@@ -9,8 +9,12 @@
 #include "Rts.h"
 #include "ghcconfig.h"
 #include "veh_excn.h"
+#include "LinkerInternals.h"
 #include <assert.h>
 #include <stdbool.h>
+#include <dbghelp.h>
+#include <shellapi.h>
+#include <shlobj.h>
 #include <wchar.h>
 #include <windows.h>
 #include <stdio.h>
@@ -117,9 +121,14 @@ long WINAPI __hs_exception_handler(struct _EXCEPTION_POINTERS *exception_data)
             case EXCEPTION_ACCESS_VIOLATION:
                 what = exception_data->ExceptionRecord->ExceptionInformation[0];
                 fprintf(stdout, "Access violation in generated code"
-                                " when %s %p\n"
-                                , what == 0 ? "reading" : what == 1 ? "writing" : what == 8 ? "executing data at" : "?"
-                                , (void*) exception_data->ExceptionRecord->ExceptionInformation[1]
+                                " when %s 0x%" PRIxPTR "\n"
+                                , what == 0 ? "reading"
+                                : what == 1 ? "writing"
+                                : what == 8 ? "executing data at"
+                                :             "?"
+                                , (uintptr_t) exception_data
+                                                ->ExceptionRecord
+                                                ->ExceptionInformation[1]
                                 );
                 action = EXCEPTION_CONTINUE_EXECUTION;
                 break;
@@ -132,6 +141,7 @@ long WINAPI __hs_exception_handler(struct _EXCEPTION_POINTERS *exception_data)
         if (EXCEPTION_CONTINUE_EXECUTION == action)
         {
             fflush(stdout);
+            generateStack (exception_data);
             generateDump (exception_data);
             stg_exit(EXIT_FAILURE);
         }
@@ -153,7 +163,6 @@ long WINAPI __hs_exception_filter(struct _EXCEPTION_POINTERS *exception_data)
     }
 
     crash_dump = true;
-
     return result;
 }
 
@@ -240,3 +249,82 @@ void generateDump (EXCEPTION_POINTERS* pExceptionPointers)
 
     fprintf (stdout, "Crash dump created. Dump written to:\n\t%ls", szFileName);
 }
+
+// Generate stack trace information, we can piggy back on information we know
+// about in the runtime linker to resolve symbols. So this is a good opportunity
+// to make the output more useful.
+void generateStack (EXCEPTION_POINTERS* pExceptionPointers)
+{
+    if (!RtsFlags.MiscFlags.generate_stack_trace)
+        return;
+
+    PCONTEXT context = pExceptionPointers->ContextRecord;
+    STACKFRAME64 stackFrame = {0};
+    DWORD machineType;
+
+#if defined(x86_64_HOST_ARCH)
+    machineType = IMAGE_FILE_MACHINE_AMD64;
+    stackFrame.AddrPC.Offset = context->Rip;
+    stackFrame.AddrPC.Mode = AddrModeFlat;
+
+    stackFrame.AddrFrame.Offset = context->Rbp;
+    stackFrame.AddrFrame.Mode = AddrModeFlat;
+
+    stackFrame.AddrStack.Offset = context->Rsp;
+    stackFrame.AddrStack.Mode = AddrModeFlat;
+#else
+    machineType = IMAGE_FILE_MACHINE_I386;
+    stackFrame.AddrPC.Offset = context->Eip;
+    stackFrame.AddrPC.Mode = AddrModeFlat;
+
+    stackFrame.AddrFrame.Offset = context->Ebp;
+    stackFrame.AddrFrame.Mode = AddrModeFlat;
+
+    stackFrame.AddrStack.Offset = context->Esp;
+    stackFrame.AddrStack.Mode = AddrModeFlat;
+#endif
+    fprintf (stdout, "\n Attempting to reconstruct a stack trace...\n\n");
+    if (!SymInitialize (GetCurrentProcess (), NULL, true))
+        fprintf (stdout, "  \nNOTE: Symbols could not be loaded. Addresses may"
+                         " be unresolved.\n\n");
+
+    /* Maximum amount of stack frames to show.  */
+    /* Phyx: I'm not sure if I should make this configurable or not. Would a
+       longer stack really be more useful? usually you only care about the top
+       few.  */
+    int max_frames = 35;
+
+    fprintf (stdout, "   Frame\tCode address\n");
+    DWORD64 lastBp = 0; /* Prevent loops with optimized stackframes.  */
+    while (StackWalk64 (machineType, GetCurrentProcess(), GetCurrentThread(),
+                        &stackFrame, context, NULL, SymFunctionTableAccess64,
+                        SymGetModuleBase64, NULL) && max_frames > 0)
+    {
+        if (stackFrame.AddrPC.Offset == 0)
+        {
+            fprintf (stdout, "Null address\n");
+            break;
+        }
+        wchar_t buffer[1024];
+        uintptr_t topSp = 0;
+        fprintf (stdout, " * 0x%" PRIxPTR "\t%ls\n",
+                 (uintptr_t)stackFrame.AddrFrame.Offset,
+                 resolveSymbolAddr ((wchar_t*)&buffer, 1024,
+                                   (SymbolAddr*)stackFrame.AddrPC.Offset,
+                                   &topSp));
+        if (lastBp >= stackFrame.AddrFrame.Offset)
+        {
+            fprintf (stdout, "Stack frame out of sequence...\n");
+            break;
+        }
+        lastBp = stackFrame.AddrFrame.Offset;
+
+        max_frames--;
+        if (max_frames ==0)
+        {
+            fprintf (stdout, "\n   ... (maximum recursion depth reached.)\n");
+        }
+    }
+    fprintf (stdout, "\n");
+    fflush(stdout);
+}
diff --git a/rts/win32/veh_excn.h b/rts/win32/veh_excn.h
index 4a2134861c..e0a11ade58 100644
--- a/rts/win32/veh_excn.h
+++ b/rts/win32/veh_excn.h
@@ -71,3 +71,4 @@ void __unregister_hs_exception_handler( void );
 
 // prototypes for dump methods.
 void generateDump(EXCEPTION_POINTERS* pExceptionPointers);
+void generateStack (EXCEPTION_POINTERS* pExceptionPointers);