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, 198 insertions, 0 deletions

diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c
index 4378a0a61d..3dcf8c4281 100644
--- a/rts/linker/PEi386.c
+++ b/rts/linker/PEi386.c
@@ -153,6 +153,10 @@
 static uint8_t* cstring_from_COFF_symbol_name(
     uint8_t* name,
     uint8_t* strtab);
+#include <inttypes.h>
+#include <dbghelp.h>
+#include <stdlib.h>
+#include <Psapi.h>
 
 #if defined(x86_64_HOST_ARCH)
 static size_t makeSymbolExtra_PEi386(
@@ -2059,4 +2063,196 @@ SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl)
     }
 }
 
+/* -----------------------------------------------------------------------------
+ * Debugging operations.
+ */
+
+pathchar*
+resolveSymbolAddr_PEi386 (pathchar* buffer, int size,
+                          SymbolAddr* symbol, uintptr_t* top ){
+    SYMBOL_INFO sym;
+    ZeroMemory (&sym, sizeof(SYMBOL_INFO));
+    sym.MaxNameLen = sizeof(char) * 1024;
+
+    DWORD64 uDisplacement = 0;
+    HANDLE hProcess = GetCurrentProcess();
+    ObjectCode* obj = NULL;
+    uintptr_t start, end;
+    *top = 0;
+
+    pathprintf (buffer, size, WSTR("0x%" PRIxPTR), symbol);
+
+    if (SymFromAddr (hProcess, (uintptr_t)symbol, &uDisplacement, &sym))
+    {
+      /* Try using Windows symbols.  */
+      wcscat (buffer, WSTR(" "));
+      pathchar* name = mkPath (sym.Name);
+      wcscat (buffer, name);
+      stgFree (name);
+      if (uDisplacement != 0)
+      {
+        int64_t displacement = (int64_t)uDisplacement;
+        pathchar s_disp[50];
+        if (displacement < 0)
+          pathprintf ((pathchar*)s_disp, 50, WSTR("-%ld"), -displacement);
+        else
+          pathprintf ((pathchar*)s_disp, 50, WSTR("+%ld"), displacement);
+
+        wcscat (buffer, s_disp);
+      }
+    }
+    else
+    {
+      /* Try to calculate from information inside the rts.  */
+      uintptr_t loc = (uintptr_t)symbol;
+      for (ObjectCode* oc = objects; oc; oc = oc->next) {
+          for (int i = 0; i < oc->n_sections; i++) {
+              Section section = oc->sections[i];
+              start = (uintptr_t)section.start;
+              end   = start + section.size;
+              if (loc > start && loc <= end)
+              {
+                  wcscat (buffer, WSTR(" "));
+                  if (oc->archiveMemberName)
+                  {
+                      pathchar* name = mkPath (oc->archiveMemberName);
+                      wcscat (buffer, name);
+                      stgFree (name);
+                  }
+                  else
+                  {
+                      wcscat (buffer, oc->fileName);
+                  }
+                  pathchar s_disp[50];
+                  pathprintf (s_disp, 50, WSTR("+0x%" PRIxPTR), loc - start);
+                  wcscat (buffer, s_disp);
+                  obj = oc;
+                  goto exit_loop;
+              }
+          }
+      }
+
+      /* If we managed to make it here, we must not have any symbols nor be
+         dealing with code we've linked. The only thing left is an internal
+         segfault or one in a dynamic library. So let's enumerate the module
+         address space.  */
+      HMODULE *hMods = NULL;
+      DWORD cbNeeded;
+      EnumProcessModules (hProcess, hMods, 0, &cbNeeded);
+      hMods = stgMallocBytes (cbNeeded, "resolveSymbolAddr_PEi386");
+      if (EnumProcessModules (hProcess, hMods, cbNeeded, &cbNeeded))
+      {
+        uintptr_t loc = (uintptr_t)symbol;
+        MODULEINFO info;
+        for (uint32_t i = 0; i < cbNeeded / sizeof(HMODULE); i++) {
+           ZeroMemory (&info, sizeof (MODULEINFO));
+           if (GetModuleInformation (hProcess, hMods[i], &info,
+                                     sizeof(MODULEINFO)))
+           {
+             uintptr_t start = (uintptr_t)info.lpBaseOfDll;
+             uintptr_t end   = start + info.SizeOfImage;
+             if (loc >= start && loc < end)
+             {
+                /* Hoera, finally found some information.  */
+                pathchar tmp[MAX_PATH];
+                if (GetModuleFileNameExW (hProcess, hMods[i], tmp, MAX_PATH))
+                {
+                  wcscat (buffer, WSTR(" "));
+                  wcscat (buffer, tmp);
+                  pathprintf (tmp, MAX_PATH, WSTR("+0x%" PRIxPTR), loc - start);
+                  wcscat (buffer, tmp);
+                }
+                break;
+             }
+           }
+        }
+      }
+
+      stgFree(hMods);
+    }
+
+    /* Finally any file/line number.  */
+    IMAGEHLP_LINE64 lineInfo = {0};
+    DWORD dwDisplacement = 0;
+  exit_loop:
+    if (SymGetLineFromAddr64(hProcess, (uintptr_t)symbol, &dwDisplacement,
+                             &lineInfo))
+    {
+      /* Try using Windows symbols.  */
+      pathchar s_line[512];
+      pathprintf ((pathchar*) s_line, 512, WSTR("   %ls (%lu)"),
+                  lineInfo.FileName, lineInfo.LineNumber);
+      wcscat (buffer, s_line);
+      if (dwDisplacement != 0)
+      {
+        pathprintf ((pathchar*) s_line, 512, WSTR(" +%lu byte%s"),
+                    dwDisplacement,
+                    (dwDisplacement == 1 ? WSTR("") : WSTR("s")));
+      }
+      wcscat (buffer, s_line);
+    }
+    else if (obj)
+    {
+      /* Try to calculate from information inside the rts.  */
+      typedef struct _SymX { SymbolName* name; uintptr_t loc; } SymX;
+      SymX* locs = stgCallocBytes (sizeof(SymX), obj->n_symbols,
+                                   "resolveSymbolAddr");
+      int blanks = 0;
+      for (int i = 0; i < obj->n_symbols; i++) {
+          SymbolName* sym = obj->symbols[i];
+          if (sym == NULL)
+            {
+               blanks++;
+               continue;
+            }
+          RtsSymbolInfo* a = NULL;
+          ghciLookupSymbolInfo(symhash, sym, &a);
+          if (a) {
+              SymX sx = {0};
+              sx.name = sym;
+              sx.loc  = (uintptr_t)a->value;
+              locs[i] = sx;
+          }
+      }
+      int comp (const void * elem1, const void * elem2)
+      {
+          SymX f = *((SymX*)elem1);
+          SymX s = *((SymX*)elem2);
+          if (f.loc > s.loc) return  1;
+          if (f.loc < s.loc) return -1;
+          return 0;
+      }
+      qsort (locs, obj->n_symbols, sizeof (SymX), comp);
+      uintptr_t key  = (uintptr_t)symbol;
+      SymX* res = NULL;
+
+      for (int x = blanks; x < obj->n_symbols; x++) {
+          if (x < (obj->n_symbols -1)) {
+              if (locs[x].loc >= key && key < locs[x+1].loc) {
+                res = &locs[x];
+                break;
+              }
+          }
+          else
+          {
+              if (locs[x].loc >= key) {
+                  res = &locs[x];
+                  break;
+                }
+          }
+      }
+
+      if (res) {
+          pathchar s_disp[512];
+          *top = (uintptr_t)res->loc;
+          pathprintf ((pathchar*)s_disp, 512,
+                      WSTR("\n\t\t (%s+0x%" PRIxPTR ")"),
+                      res->name, res->loc - key);
+          wcscat (buffer, s_disp);
+      }
+      stgFree (locs);
+    }
+
+    return buffer;
+}
 #endif /* mingw32_HOST_OS */
diff --git a/rts/linker/PEi386.h b/rts/linker/PEi386.h
index e84e05232a..e6fef74af8 100644
--- a/rts/linker/PEi386.h
+++ b/rts/linker/PEi386.h
@@ -57,6 +57,8 @@ SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl);
 bool ocAllocateSymbolExtras_PEi386 ( ObjectCode* oc );
 SymbolAddr *lookupSymbolInDLLs ( unsigned char *lbl );
 /* See Note [mingw-w64 name decoration scheme] */
+pathchar* resolveSymbolAddr_PEi386 ( pathchar* buffer, int size,
+                                     SymbolAddr* symbol, uintptr_t* top );
 
 char *
 allocateImageAndTrampolines (