Add ability to produce crash dumps on Windows

It's often hard to debug things like segfaults on Windows,
mostly because gdb isn't always of use and users don't know
how to effectively use it.

This patch provides a way to create a crash drump by passing

`+RTS --generate-crash-dumps` as an option. If any unhandled
exception is triggered a dump is made that contains enough
information to be able to diagnose things successfully.

Currently the created dumps are a bit big because I include
all registers, code and threads information.

This looks like

```
$ testsuite/tests/rts/derefnull.run/derefnull.exe +RTS
--generate-crash-dumps

Access violation in generated code when reading 0000000000000000
Crash dump created. Dump written to:
        E:\msys64\tmp\ghc-20170901-220250-11216-16628.dmp
```

Test Plan: ./validate

Reviewers: austin, hvr, bgamari, erikd, simonmar

Reviewed By: bgamari, simonmar

Subscribers: rwbarton, thomie

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

docs/users_guide/8.4.1-notes.rst

@@ -170,6 +170,9 @@ Runtime system
   completely disable the runtime's handling of exceptions. See
   :ghc-ticket:`13911`, :ghc-ticket:`12110`.
 
+- The GHC runtime on Windows can now generate crash dumps on unhandled exceptions
+  using the RTS flag :rts-flag:`--generate-crash-dumps`.
+
 Template Haskell
 ~~~~~~~~~~~~~~~~
 

docs/users_guide/runtime_control.rst

@@ -228,6 +228,13 @@ Miscellaneous RTS options
     DLL, and don't want the RTS to ungracefully terminate your application on
     erros such as segfaults.
 
+.. rts-flag:: --generate-crash-dumps
+
+    If yes (the default), the RTS on Windows will generate a core dump on
+    any crash. These dumps can be inspected using debuggers such as WinDBG.
+    The dumps record all code, registers and threading information at the time
+    of the crash. Note that this implies `--install-seh-handlers=yes`.
+
 .. rts-flag:: -xm ⟨address⟩
 
     .. index::

includes/rts/Flags.h

@@ -190,6 +190,7 @@ typedef struct _MISC_FLAGS {
     Time    tickInterval;        /* units: TIME_RESOLUTION */
     bool install_signal_handlers;
     bool install_seh_handlers;
+    bool generate_dump_file;
     bool machineReadable;
     StgWord linkerMemBase;       /* address to ask the OS for memory
                                   * for the linker, NULL ==> off */

libraries/base/GHC/RTS/Flags.hsc

@@ -132,6 +132,7 @@ data MiscFlags = MiscFlags
     { tickInterval          :: RtsTime
     , installSignalHandlers :: Bool
     , installSEHHandlers    :: Bool
+    , generateCrashDumpFile :: Bool
     , machineReadable       :: Bool
     , linkerMemBase         :: Word
       -- ^ address to ask the OS for memory for the linker, 0 ==> off
@@ -406,6 +407,7 @@ getMiscFlags = do
   MiscFlags <$> #{peek MISC_FLAGS, tickInterval} ptr
             <*> #{peek MISC_FLAGS, install_signal_handlers} ptr
             <*> #{peek MISC_FLAGS, install_seh_handlers} ptr
+            <*> #{peek MISC_FLAGS, generate_dump_file} ptr
             <*> #{peek MISC_FLAGS, machineReadable} ptr
             <*> #{peek MISC_FLAGS, linkerMemBase} ptr
 

libraries/base/changelog.md

@@ -53,6 +53,9 @@
   * Add `installSEHHandlers` to `MiscFlags` in `GHC.RTS.Flags` to determine if
     exception handling is enabled.
 
+  * Add `generateCrashDumpFile` to `MiscFlags` in `GHC.RTS.Flags` to determine
+    if a core dump will be generated on crashes.
+
 ## 4.10.0.0 *July 2017*
   * Bundled with GHC 8.2.1
 

rts/RtsFlags.c

@@ -226,6 +226,7 @@ void initRtsFlagsDefaults(void)
 
     RtsFlags.MiscFlags.install_signal_handlers = true;
     RtsFlags.MiscFlags.install_seh_handlers    = true;
+    RtsFlags.MiscFlags.generate_dump_file      = false;
     RtsFlags.MiscFlags.machineReadable         = false;
     RtsFlags.MiscFlags.linkerMemBase           = 0;
 
@@ -430,6 +431,10 @@ usage_text[] = {
 #if defined(mingw32_HOST_OS)
 "  --install-seh-handlers=<yes|no>",
 "            Install exception handlers (default: yes)",
+"  --generate-crash-dumps",
+"            Generate Windows crash dumps, requires exception handlers",
+"            to be installed. Implies --install-signal-handlers=yes.",
+"            (default: no)",
 #endif
 #if defined(THREADED_RTS)
 "  -e<n>     Maximum number of outstanding local sparks (default: 4096)",
@@ -855,6 +860,11 @@ error = true;
                       OPTION_UNSAFE;
                       RtsFlags.MiscFlags.install_seh_handlers = false;
                   }
+                  else if (strequal("generate-crash-dumps",
+                              &rts_argv[arg][2])) {
+                      OPTION_UNSAFE;
+                      RtsFlags.MiscFlags.generate_dump_file = true;
+                  }
                   else if (strequal("machine-readable",
                                &rts_argv[arg][2])) {
                       OPTION_UNSAFE;
@@ -1608,6 +1618,11 @@ static void normaliseRtsOpts (void)
             RtsFlags.ParFlags.parGcLoadBalancingGen = 1;
         }
     }
+
+    // We can't generate dumps without signal handlers
+    if (RtsFlags.MiscFlags.generate_dump_file) {
+        RtsFlags.MiscFlags.install_seh_handlers = true;
+    }
 }
 
 static void errorUsage (void)

rts/package.conf.in

@@ -45,6 +45,7 @@ extra-libraries:
                               ,"wsock32"    /* for the linker */
                               ,"gdi32"      /* for the linker */
                               ,"winmm"      /* for the linker */
+                              ,"Dbghelp"    /* for crash dump */
 #endif
 #if NEED_PTHREAD_LIB
                               , "pthread"   /* for pthread_getthreadid_np, pthread_create, etc. */

rts/win32/veh_excn.c

@@ -5,11 +5,18 @@
 * Error Handling implementations for windows
 *
 * ---------------------------------------------------------------------------*/
-
+#define UNICODE 1
 #include "Rts.h"
 #include "ghcconfig.h"
 #include "veh_excn.h"
 #include <assert.h>
+#include <stdbool.h>
+#include <wchar.h>
+#include <windows.h>
+#include <stdio.h>
+#include <excpt.h>
+#include <inttypes.h>
+#include <Dbghelp.h>
 
 /////////////////////////////////
 // Exception / signal handlers.
@@ -80,11 +87,17 @@
 // Registered exception handler
 PVOID __hs_handle = NULL;
 LPTOP_LEVEL_EXCEPTION_FILTER oldTopFilter = NULL;
+bool crash_dump = false;
+bool filter_called = false;
 
 long WINAPI __hs_exception_handler(struct _EXCEPTION_POINTERS *exception_data)
 {
+    if (!crash_dump && filter_called)
+      return EXCEPTION_CONTINUE_EXECUTION;
+
     long action = EXCEPTION_CONTINUE_SEARCH;
     ULONG_PTR what;
+    fprintf (stdout, "\n");
 
     // When the system unwinds the VEH stack after having handled an excn,
     // return immediately.
@@ -119,6 +132,7 @@ long WINAPI __hs_exception_handler(struct _EXCEPTION_POINTERS *exception_data)
         if (EXCEPTION_CONTINUE_EXECUTION == action)
         {
             fflush(stdout);
+            generateDump (exception_data);
             stg_exit(EXIT_FAILURE);
         }
     }
@@ -128,6 +142,7 @@ long WINAPI __hs_exception_handler(struct _EXCEPTION_POINTERS *exception_data)
 
 long WINAPI __hs_exception_filter(struct _EXCEPTION_POINTERS *exception_data)
 {
+    filter_called = true;
     long result = EXCEPTION_CONTINUE_EXECUTION;
     if (oldTopFilter)
     {
@@ -137,6 +152,8 @@ long WINAPI __hs_exception_filter(struct _EXCEPTION_POINTERS *exception_data)
         return result;
     }
 
+    crash_dump = true;
+
     return result;
 }
 
@@ -184,3 +201,42 @@ void __unregister_hs_exception_handler( void )
     }
 }
 
+// Generate a crash dump, however in order for these to generate undecorated
+// names we really need to be able to generate PDB files.
+void generateDump (EXCEPTION_POINTERS* pExceptionPointers)
+{
+    if (!RtsFlags.MiscFlags.generate_dump_file)
+        return;
+
+    WCHAR szPath[MAX_PATH];
+    WCHAR szFileName[MAX_PATH];
+    WCHAR const *const szAppName = L"ghc";
+    WCHAR const *const szVersion = L"";
+    DWORD dwBufferSize = MAX_PATH;
+    HANDLE hDumpFile;
+    SYSTEMTIME stLocalTime;
+    MINIDUMP_EXCEPTION_INFORMATION ExpParam;
+
+    GetLocalTime (&stLocalTime);
+    GetTempPathW (dwBufferSize, szPath);
+
+    swprintf (szFileName, MAX_PATH,
+              L"%ls%ls%ls-%04d%02d%02d-%02d%02d%02d-%ld-%ld.dmp",
+              szPath, szAppName, szVersion,
+              stLocalTime.wYear, stLocalTime.wMonth, stLocalTime.wDay,
+              stLocalTime.wHour, stLocalTime.wMinute, stLocalTime.wSecond,
+              GetCurrentProcessId(), GetCurrentThreadId());
+    hDumpFile = CreateFileW (szFileName, GENERIC_READ|GENERIC_WRITE,
+                FILE_SHARE_WRITE|FILE_SHARE_READ, 0, CREATE_ALWAYS, 0, 0);
+
+    ExpParam.ThreadId          = GetCurrentThreadId();
+    ExpParam.ExceptionPointers = pExceptionPointers;
+    ExpParam.ClientPointers    = TRUE;
+
+    MiniDumpWriteDump(GetCurrentProcess(), GetCurrentProcessId(),
+                      hDumpFile, MiniDumpNormal | MiniDumpWithDataSegs |
+                                 MiniDumpWithThreadInfo | MiniDumpWithCodeSegs,
+                      &ExpParam, NULL, NULL);
+
+    fprintf (stdout, "Crash dump created. Dump written to:\n\t%ls", szFileName);
+}

rts/win32/veh_excn.h

@@ -68,3 +68,6 @@ long WINAPI __hs_exception_filter(struct _EXCEPTION_POINTERS *exception_data);
 // prototypes to the functions doing the registration and unregistration of the VEH handlers
 void __register_hs_exception_handler( void );
 void __unregister_hs_exception_handler( void );
+
+// prototypes for dump methods.
+void generateDump(EXCEPTION_POINTERS* pExceptionPointers);