linker: Initial Windows C++ exception unwinding support

8 files changed, 175 insertions, 3 deletions

diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
index b2eaafb23d..158f90990e 100644
--- a/rts/LinkerInternals.h
+++ b/rts/LinkerInternals.h
@@ -82,6 +82,10 @@ typedef
           SECTIONKIND_OTHER,
           /* Section contains debug information. e.g. .debug$.  */
           SECTIONKIND_DEBUG,
+          /* Section contains exception table. e.g. .pdata.  */
+          SECTIONKIND_EXCEPTION_TABLE,
+          /* Section contains unwind info. e.g. .xdata.  */
+          SECTIONKIND_EXCEPTION_UNWIND,
           /* Section belongs to an import section group. e.g. .idata$.  */
           SECTIONKIND_IMPORT,
           /* Section defines an import library entry, e.g. idata$7.  */
diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c
index 684b02ac5b..57b762e60a 100644
--- a/rts/linker/PEi386.c
+++ b/rts/linker/PEi386.c
@@ -429,6 +429,16 @@ void freePreloadObjectFile_PEi386(ObjectCode *oc)
             HeapFree(code_heap, 0, oc->info->image);
             oc->info->image = NULL;
         }
+
+        /* Release the unwinder information.
+           See Note [Exception Unwinding].  */
+        if (oc->info->xdata) {
+            if (!RtlDeleteFunctionTable (oc->info->xdata->start))
+              debugBelch ("Unable to remove Exception handlers for %" PATH_FMT,
+                          oc->fileName);
+            oc->info->xdata = NULL;
+            oc->info->pdata = NULL;
+        }
         if (oc->info->ch_info)
            stgFree (oc->info->ch_info);
         stgFree (oc->info);
@@ -1438,12 +1448,22 @@ ocGetNames_PEi386 ( ObjectCode* oc )
 
       if (   0 == strncmp(".stab"     , section.info->name, 5 )
           || 0 == strncmp(".stabstr"  , section.info->name, 8 )
-          || 0 == strncmp(".pdata"    , section.info->name, 6 )
-          || 0 == strncmp(".xdata"    , section.info->name, 6 )
           || 0 == strncmp(".debug"    , section.info->name, 6 )
           || 0 == strncmp(".rdata$zzz", section.info->name, 10))
           kind = SECTIONKIND_DEBUG;
 
+      /* Exception Unwind information. See Note [Exception Unwinding].  */
+      if (0 == strncmp(".xdata"    , section.info->name, 6 )) {
+          kind = SECTIONKIND_EXCEPTION_UNWIND;
+          oc->info->xdata = &oc->sections[i];
+      }
+
+      /* Exception handler tables, See Note [Exception Unwinding].  */
+      if (0 == strncmp(".pdata"    , section.info->name, 6 )) {
+          kind = SECTIONKIND_EXCEPTION_TABLE;
+          oc->info->pdata = &oc->sections[i];
+      }
+
       if (0==strncmp(".idata", section.info->name, 6))
           kind = SECTIONKIND_IMPORT;
 
@@ -1786,7 +1806,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
 
       /* Ignore sections called which contain stabs debugging information. */
       if (section.kind == SECTIONKIND_DEBUG)
-           continue;
+        continue;
 
       noRelocs = section.info->noRelocs;
       for (j = 0; j < noRelocs; j++) {
@@ -1924,6 +1944,27 @@ ocResolve_PEi386 ( ObjectCode* oc )
          }
 
       }
+
+      /* Register the exceptions inside this OC.
+         See Note [Exception Unwinding].  */
+      if (section.kind == SECTIONKIND_EXCEPTION_TABLE) {
+#if defined(x86_64_HOST_ARCH)
+          unsigned numEntries = section.size / sizeof(RUNTIME_FUNCTION);
+          if (numEntries == 0)
+            continue;
+
+          /* Now register the exception handler for the range and point it
+             to the unwind data.  */
+          if (!RtlAddFunctionTable (section.start, numEntries, (uintptr_t)__image_base)) {
+            sysErrorBelch("Unable to register Exception handler for %p for "
+                          "section %s in %" PATH_FMT " (Win32 error %lu)",
+                          section.start, section.info->name, oc->fileName,
+                          GetLastError());
+            releaseOcInfo (oc);
+            return false;
+          }
+#endif /* x86_64_HOST_ARCH.  */
+      }
    }
 
    IF_DEBUG(linker, debugBelch("completed %" PATH_FMT "\n", oc->fileName));
@@ -1945,6 +1986,77 @@ ocResolve_PEi386 ( ObjectCode* oc )
   See #9907
 */
 
+/*
+  Note [Exception Unwinding]
+  ~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+  Exception Unwinding on Windows is handle using two named sections.
+
+  .pdata: Exception registration tables.
+
+  The .pdata section contains an array of function table entries that are used
+  for exception handling.  The entries must be sorted according to the
+  function addresses (the first field in each structure) before being emitted
+  into the final image.  It is pointed to by the exception table entry in the
+  image data directory. For x64 each entry contains:
+
+  Offset    Size    Field              Description
+  0         4       Begin Address      The RVA of the corresponding function.
+  4         4       End Address        The RVA of the end of the function.
+  8         4       Unwind Information The RVA of the unwind information.
+
+  Note that these are RVAs even after being resolved by the linker, they are
+  however ImageBase relative rather than PC relative.  These are typically
+  filled in by an ADDR32NB relocation.  On disk the section looks like:
+
+    Function Table #6 (4)
+
+            Begin     End       Info
+
+    00000000 00000000  000001A1  00000000
+    0000000C 000001A1  000001BF  00000034
+    00000018 000001BF  00000201  00000040
+    00000024 00000201  0000021F  0000004C
+
+    RELOCATIONS #6
+                                                    Symbol    Symbol
+    Offset    Type              Applied To         Index     Name
+    --------  ----------------  -----------------  --------  ------
+    00000000  ADDR32NB                   00000000         E  .text
+    00000004  ADDR32NB                   000001A1         E  .text
+    00000008  ADDR32NB                   00000000        16  .xdata
+    0000000C  ADDR32NB                   000001A1         E  .text
+    00000010  ADDR32NB                   000001BF         E  .text
+    00000014  ADDR32NB                   00000034        16  .xdata
+    00000018  ADDR32NB                   000001BF         E  .text
+    0000001C  ADDR32NB                   00000201         E  .text
+    00000020  ADDR32NB                   00000040        16  .xdata
+    00000024  ADDR32NB                   00000201         E  .text
+    00000028  ADDR32NB                   0000021F         E  .text
+    0000002C  ADDR32NB                   0000004C        16  .xdata
+
+  This means that if we leave it up to the relocation processing to
+  do the work we don't need to do anything special here. Note that
+  every single function will have an entry in this table regardless
+  whether they have an unwind code or not.  The reason for this is
+  that unwind handlers can be chained, and such another function
+  may have registered an overlapping region.
+
+  .xdata: Exception unwind codes.
+
+  This section contains an array of entries telling the unwinder how
+  to do unwinding.  They are pointed to by the .pdata table enteries
+  from the Info field.  Each entry is very complicated but for now
+  what is important is that the addresses are resolved by the relocs
+  for us.
+
+  Once we have resolved .pdata and .xdata we can simply pass the
+  content of .pdata on to RtlAddFunctionTable and the OS will do
+  the rest.  When we're unloading the object we have to unregister
+  them using RtlDeleteFunctionTable.
+
+*/
+
 bool
 ocRunInit_PEi386 ( ObjectCode *oc )
 {
diff --git a/rts/linker/PEi386Types.h b/rts/linker/PEi386Types.h
index ec53ec800b..9ad2103f92 100644
--- a/rts/linker/PEi386Types.h
+++ b/rts/linker/PEi386Types.h
@@ -23,6 +23,8 @@ struct ObjectCodeFormatInfo {
     size_t trampoline;
     Section* init;
     Section* finit;
+    Section* pdata;
+    Section* xdata;
     COFF_HEADER_INFO* ch_info;
     char* str_tab;
     COFF_symbol* symbols;
diff --git a/testsuite/tests/rts/linker/Makefile b/testsuite/tests/rts/linker/Makefile
index eac2b90b07..35e0c2765c 100644
--- a/testsuite/tests/rts/linker/Makefile
+++ b/testsuite/tests/rts/linker/Makefile
@@ -119,3 +119,8 @@ T7072:
 	"$(TEST_HC)" -c T7072-main.c -o T7072-main.o
 	"$(TEST_HC)" T7072-main.c -o T7072-main -no-hs-main -debug
 	./T7072-main T7072-obj.o
+
+.PHONY: T20918
+T20918:
+	"$(TEST_CC)" -c T20918_v.cc -o T20918_v.o
+	echo hello | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) T20918_v.o T20918.hs -lstdc++
diff --git a/testsuite/tests/rts/linker/T20918.hs b/testsuite/tests/rts/linker/T20918.hs
new file mode 100644
index 0000000000..7a50c691e5
--- /dev/null
+++ b/testsuite/tests/rts/linker/T20918.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module ThrowTest where
+
+import Foreign.C.Types
+import Data.Int()
+
+foreign import ccall "test_error_throwing.h equivalent_to_id"
+  equivalentToId :: CDouble -> IO CDouble
+
+hello :: IO ()
+hello = do
+  print "Hi"
+  shouldBe88 <- equivalentToId 88
+  print $ show shouldBe88
+  print "Bye"
+
diff --git a/testsuite/tests/rts/linker/T20918.stdout b/testsuite/tests/rts/linker/T20918.stdout
new file mode 100644
index 0000000000..5d1f019d13
--- /dev/null
+++ b/testsuite/tests/rts/linker/T20918.stdout
@@ -0,0 +1,5 @@
+"Hi"
+equivalent_to_id test-throw 1
+equivalent_to_id test-throw caught 20
+"88.0"
+"Bye"
diff --git a/testsuite/tests/rts/linker/T20918_v.cc b/testsuite/tests/rts/linker/T20918_v.cc
new file mode 100644
index 0000000000..39760deb75
--- /dev/null
+++ b/testsuite/tests/rts/linker/T20918_v.cc
@@ -0,0 +1,19 @@
+#include <stdlib.h>
+#include <string>
+#include <iostream>
+
+extern "C"
+{
+
+  double equivalent_to_id(double my_double)
+  {
+    try {
+      std::cout << "equivalent_to_id test-throw 1" << std::endl;
+      throw 20;
+    } catch(int my_error)
+    {
+      std::cout << "equivalent_to_id test-throw caught " << my_error << std::endl;
+    }
+    return my_double;
+  }
+}
diff --git a/testsuite/tests/rts/linker/all.T b/testsuite/tests/rts/linker/all.T
index 8e70ee8646..5191c4b0aa 100644
--- a/testsuite/tests/rts/linker/all.T
+++ b/testsuite/tests/rts/linker/all.T
@@ -119,3 +119,11 @@ test('T7072',
 		unless(opsys('linux'), skip), 
 		req_rts_linker], 
 	makefile_test, ['T7072'])
+
+
+test('T20918',
+	[extra_files(['T20918_v.cc']),
+		unless(opsys('mingw32'), skip),
+		req_rts_linker],
+	makefile_test, ['T20918'])
+