Switch VEH to VCH and allow disabling of SEH completely.

Exception handling on Windows is unfortunately a bit complicated.
But essentially the VEH Handlers we currently have are running too
early.

This was a problem as it ran so early it also swallowed C++ exceptions
and other software exceptions which the system could have very well
recovered from.

So instead we use a sequence of chains to for the exception handlers to
run as late as possible. You really can't get any later than this.

Please read the comment in the patch for more details.

I'm also providing a switch to allow people to turn off the exception
handling entirely. In case it does present a problem with their code.

(Reverted and recommitted to fix authorship information)

Test Plan: ./validate

Reviewers: austin, hvr, bgamari, erikd, simonmar

Reviewed By: bgamari

Subscribers: rwbarton, thomie

GHC Trac Issues: #13911, #12110

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

4 files changed, 106 insertions, 12 deletions

diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 4194aa0eec..5a5abb0d19 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -225,8 +225,9 @@ void initRtsFlagsDefaults(void)
     RtsFlags.ConcFlags.ctxtSwitchTime   = USToTime(20000); // 20ms
 
     RtsFlags.MiscFlags.install_signal_handlers = true;
-    RtsFlags.MiscFlags.machineReadable = false;
-    RtsFlags.MiscFlags.linkerMemBase    = 0;
+    RtsFlags.MiscFlags.install_seh_handlers    = true;
+    RtsFlags.MiscFlags.machineReadable         = false;
+    RtsFlags.MiscFlags.linkerMemBase           = 0;
 
 #if defined(THREADED_RTS)
     RtsFlags.ParFlags.nCapabilities     = 1;
@@ -426,6 +427,10 @@ usage_text[] = {
 #endif
 "  --install-signal-handlers=<yes|no>",
 "            Install signal handlers (default: yes)",
+#if defined(mingw32_HOST_OS)
+"  --install-seh-handlers=<yes|no>",
+"            Install exception handlers (default: yes)",
+#endif
 #if defined(THREADED_RTS)
 "  -e<n>     Maximum number of outstanding local sparks (default: 4096)",
 #endif
@@ -840,6 +845,16 @@ error = true;
                       OPTION_UNSAFE;
                       RtsFlags.MiscFlags.install_signal_handlers = false;
                   }
+                  else if (strequal("install-seh-handlers=yes",
+                              &rts_argv[arg][2])) {
+                      OPTION_UNSAFE;
+                      RtsFlags.MiscFlags.install_seh_handlers = true;
+                  }
+                  else if (strequal("install-seh-handlers=no",
+                              &rts_argv[arg][2])) {
+                      OPTION_UNSAFE;
+                      RtsFlags.MiscFlags.install_seh_handlers = false;
+                  }
                   else if (strequal("machine-readable",
                                &rts_argv[arg][2])) {
                       OPTION_UNSAFE;
diff --git a/rts/RtsMain.c b/rts/RtsMain.c
index c73002f63e..21b8577cca 100644
--- a/rts/RtsMain.c
+++ b/rts/RtsMain.c
@@ -44,8 +44,6 @@ int hs_main ( int argc, char *argv[],       // program args
               RtsConfig rts_config)         // RTS configuration
 
 {
-    BEGIN_WINDOWS_VEH_HANDLER
-
     int exit_status;
     SchedulerStatus status;
 
@@ -56,11 +54,10 @@ int hs_main ( int argc, char *argv[],       // program args
     }
     #endif
 
-
-
-
     hs_init_ghc(&argc, &argv, rts_config);
 
+    BEGIN_WINDOWS_VEH_HANDLER
+
     // kick off the computation by creating the main thread with a pointer
     // to mainIO_closure representing the computation of the overall program;
     // then enter the scheduler with this thread and off we go;
diff --git a/rts/win32/veh_excn.c b/rts/win32/veh_excn.c
index d925ad8919..e45ea2b49c 100644
--- a/rts/win32/veh_excn.c
+++ b/rts/win32/veh_excn.c
@@ -15,6 +15,57 @@
 // Exception / signal handlers.
 /////////////////////////////////
 
+/*
+  SEH (Structured Error Handler) on Windows is quite tricky. On x86 SEHs are
+  stack based and are stored in FS[0] of each thread. Which means every time we
+  spawn an OS thread we'd have to set up the error handling. However on x64 it's
+  table based and memory region based. e.g. you register a handler for a
+  particular memory range. This means that we'd have to register handlers for
+  each block of code we load externally or generate internally ourselves.
+
+  In Windows XP VEH (Vectored Exception Handler) and VCH (Vectored Continue
+  Handler) were added. Both of these are global/process wide handlers, the
+  former handling all exceptions and the latter handling only exceptions which
+  we're trying to recover from, e.g. a handler returned
+  EXCEPTION_CONTINUE_EXECUTION.
+
+  And lastly you have top level exception filters, which are also process global
+  but the problem here is that you can only have one, and setting this removes
+  the previous ones. The chain of exception handling looks like
+
+                    [  Vectored Exception Handler  ]
+                                |
+                    [ Structured Exception Handler ]
+                                |
+                    [      Exception Filters       ]
+                                |
+                    [  Vectored Continue Handler   ]
+
+  To make things more tricky, the exception handlers handle both hardware and
+  software exceptions Which means previously when we registered VEH handlers
+  we would also trap software exceptions. Which means when haskell code was
+  loaded in a C++ or C# context we would swallow exceptions and terminate in
+  contexes that normally the runtime should be able to continue on, e.g. you
+  could be handling the segfault in your C++ code, or the div by 0.
+
+  We could not handle these exceptions, but GHCi would just die a horrible death
+  then on normal Haskell only code when such an exception occurs.
+
+  So instead, we'll move to Continue handler, to run as late as possible, and
+  also register a filter which calls any existing filter, and then runs the
+  continue handlers, we then also only run as the last continue handler so we
+  don't supercede any other VCH handlers.
+
+  Lastly we'll also provide a way for users to disable the exception handling
+  entirely so even if the new approach doesn't solve the issue they can work
+  around it. After all, I don't expect any interpreted code if you are running
+  a haskell dll.
+
+  For a detailed analysis see
+  https://reverseengineering.stackexchange.com/questions/14992/what-are-the-vectored-continue-handlers
+  and https://www.gamekiller.net/threads/vectored-exception-handler.3237343/
+  */
+
 // Define some values for the ordering of VEH Handlers:
 // - CALL_FIRST means call this exception handler first
 // - CALL_LAST means call this exception handler last
@@ -28,6 +79,7 @@
 
 // Registered exception handler
 PVOID __hs_handle = NULL;
+LPTOP_LEVEL_EXCEPTION_FILTER oldTopFilter = NULL;
 
 long WINAPI __hs_exception_handler(struct _EXCEPTION_POINTERS *exception_data)
 {
@@ -74,32 +126,61 @@ long WINAPI __hs_exception_handler(struct _EXCEPTION_POINTERS *exception_data)
     return action;
 }
 
+long WINAPI __hs_exception_filter(struct _EXCEPTION_POINTERS *exception_data)
+{
+    long result = EXCEPTION_CONTINUE_EXECUTION;
+    if (oldTopFilter)
+    {
+        result = (*oldTopFilter)(exception_data);
+        if (EXCEPTION_CONTINUE_SEARCH == result)
+            result = EXCEPTION_CONTINUE_EXECUTION;
+        return result;
+    }
+
+    return result;
+}
+
 void __register_hs_exception_handler( void )
 {
-    // Allow the VEH handler to be registered only once.
+    if (!RtsFlags.MiscFlags.install_seh_handlers)
+        return;
+
+    // Allow the VCH handler to be registered only once.
     if (NULL == __hs_handle)
     {
-        __hs_handle = AddVectoredExceptionHandler(CALL_FIRST, __hs_exception_handler);
+        // Be the last one to run, We can then be sure we didn't interfere with
+        // anything else.
+        __hs_handle = AddVectoredContinueHandler(CALL_LAST,
+                                                 __hs_exception_handler);
         // should the handler not be registered this will return a null.
         assert(__hs_handle);
+
+        // Register for an exception filter to ensure the continue handler gets
+        // hit if no one handled the exception.
+        oldTopFilter = SetUnhandledExceptionFilter (__hs_exception_filter);
     }
     else
     {
-        errorBelch("There is no need to call __register_hs_exception_handler() twice, VEH handlers are global per process.");
+        errorBelch("There is no need to call __register_hs_exception_handler()"
+                   " twice, VEH handlers are global per process.");
     }
 }
 
 void __unregister_hs_exception_handler( void )
 {
+    if (!RtsFlags.MiscFlags.install_seh_handlers)
+        return;
+
     if (__hs_handle != NULL)
     {
         // Should the return value be checked? we're terminating anyway.
-        RemoveVectoredExceptionHandler(__hs_handle);
+        RemoveVectoredContinueHandler(__hs_handle);
         __hs_handle = NULL;
     }
     else
     {
-        errorBelch("__unregister_hs_exception_handler() called without having called __register_hs_exception_handler() first.");
+        errorBelch("__unregister_hs_exception_handler() called without having"
+                   "called __register_hs_exception_handler() first.");
     }
 }
 
diff --git a/rts/win32/veh_excn.h b/rts/win32/veh_excn.h
index fda837f1f1..72a9967afd 100644
--- a/rts/win32/veh_excn.h
+++ b/rts/win32/veh_excn.h
@@ -63,6 +63,7 @@
 // See https://msdn.microsoft.com/en-us/library/windows/desktop/ms681419(v=vs.85).aspx
 //
 long WINAPI __hs_exception_handler( struct _EXCEPTION_POINTERS *exception_data );
+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 );