rts/linker/PEi386: Add finalization support

This implements #20494 for the PEi386 linker.

Happily, this also appears to fix `T9405`, resolving #21361.

4 files changed, 51 insertions, 6 deletions

diff --git a/rts/Linker.c b/rts/Linker.c
index cd469b4f2d..7bbeb49f9c 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -1143,6 +1143,8 @@ void freeObjectCode (ObjectCode *oc)
         // happens when we resolve the object.
 #if defined(OBJFORMAT_ELF)
         ocRunFini_ELF(oc);
+#elif defined(OBJFORMAT_PEi386)
+        ocRunFini_PEi386(oc);
 #endif
     }
 
diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c
index f7fa4eff93..5b93b57ece 100644
--- a/rts/linker/PEi386.c
+++ b/rts/linker/PEi386.c
@@ -2111,6 +2111,28 @@ ocResolve_PEi386 ( ObjectCode* oc )
 
 */
 
+/*
+ * Note [Initializers and finalizers (PEi386)]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * COFF/PE allows an object to define initializers and finalizers to be run
+ * at load/unload time, respectively. These are listed in the `.ctors` and
+ * `.dtors` sections. Moreover, these section names may be sufficed with an
+ * integer priority (e.g. `.ctors.1234`). Sections are run in order of
+ * increasing priority. Sections without a priority (e.g. `.ctors`) are run
+ * last.
+ *
+ * A `.ctors`/`.dtors` section contains an array of pointers to
+ * `init_t`/`fini_t` functions, respectively. Note that `.ctors` must be run in
+ * reverse order.
+ *
+ * For more about how the code generator emits initializers and finalizers see
+ * Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini.
+ */
+
+
+// Run the constructors/initializers of an ObjectCode.
+// Returns 1 on success.
+// See Note [Initializers and finalizers (PEi386)].
 bool
 ocRunInit_PEi386 ( ObjectCode *oc )
 {
@@ -2131,7 +2153,7 @@ ocRunInit_PEi386 ( ObjectCode *oc )
   init_t *init_start   = (init_t*)init_startC;
   init_t *init_end     = (init_t*)(init_startC + section.size);
 
-  // ctors are run *backwards*!
+  // ctors are run in reverse order.
   for (init_t *init = init_end - 1; init >= init_start; init--)
       (*init)(argc, argv, envv);
 
@@ -2139,6 +2161,29 @@ ocRunInit_PEi386 ( ObjectCode *oc )
   return true;
 }
 
+// Run the finalizers of an ObjectCode.
+// Returns 1 on success.
+// See Note [Initializers and finalizers (PEi386)].
+bool ocRunFini_PEi386( ObjectCode *oc )
+{
+  if (!oc || !oc->info || !oc->info->fini) {
+    return true;
+  }
+
+  Section section = *oc->info->fini;
+  CHECK(SECTIONKIND_FINIT_ARRAY == section.kind);
+
+  uint8_t *fini_startC = section.start;
+  fini_t *fini_start   = (fini_t*)fini_startC;
+  fini_t *fini_end     = (fini_t*)(fini_startC + section.size);
+
+  // dtors are run in forward order.
+  for (fini_t *fini = fini_end - 1; fini >= fini_start; fini--)
+      (*fini)();
+
+   return true;
+}
+
 SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type)
 {
     RtsSymbolInfo *pinfo;
diff --git a/rts/linker/PEi386.h b/rts/linker/PEi386.h
index cde5974d54..6bb15256c9 100644
--- a/rts/linker/PEi386.h
+++ b/rts/linker/PEi386.h
@@ -56,6 +56,7 @@ bool removeLibrarySearchPath_PEi386( HsPtr dll_path_index );
 
 bool ocResolve_PEi386     ( ObjectCode* oc );
 bool ocRunInit_PEi386     ( ObjectCode *oc );
+bool ocRunFini_PEi386     ( ObjectCode *oc );
 bool ocGetNames_PEi386    ( ObjectCode* oc );
 bool ocVerifyImage_PEi386 ( ObjectCode* oc );
 SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl, ObjectCode *dependent, SymType *type);
diff --git a/testsuite/tests/rts/linker/all.T b/testsuite/tests/rts/linker/all.T
index b7a9eda203..65fa8e0362 100644
--- a/testsuite/tests/rts/linker/all.T
+++ b/testsuite/tests/rts/linker/all.T
@@ -118,11 +118,8 @@ test('T7072',
 		req_rts_linker], 
 	makefile_test, ['T7072'])
 
-test('T20494',
-     [req_rts_linker,
-      # The PEi386 linker doesn't yet support finalizers
-      when(opsys('mingw32'), expect_broken(20494))],
-    makefile_test, ['T20494'])
+test('T20494', [req_rts_linker],
+     makefile_test, ['T20494'])
 
 test('T20918',
      [extra_files(['T20918_v.cc']),