Fix windows-th-dll build failures (#2091)

* Fix windows-th-dll build failures

48e391952c17ff7eab10b0b1456e3f2a2af28a9b, backported to 9.6
in 81873448d1c946d56f429da9d7e53ecaa55bdc71
introduced `SYM_TYPE_DUP_DISCARD` to the bitfield.

The linker however, failed to mask the `SYM_TYPE_DUP_DISCARD` value.
Thus `== SYM_TYPE_CODE` comparisons easily failed. This lead to us
relocating DATA lookups (GOT) into E8 (call) and E9 (jump) instructions.

---------

Co-authored-by: Hamish Mackenzie <Hamish.K.Mackenzie@gmail.com>

Author: angerman

overlays/bootstrap.nix

@@ -257,6 +257,7 @@ in {
                 ++ final.lib.optional (versionAtLeast "9.0"                             && final.stdenv.targetPlatform.isAarch64) ./patches/ghc/ghc-9.0-better-symbol-addr-debug.patch
                 ++ final.lib.optional (versionAtLeast "9.0"                             && final.stdenv.targetPlatform.isAarch64) ./patches/ghc/ghc-9.0-aarch64-handle-none-rela.patch
                 ++ final.lib.optional (versionAtLeast "9.6.3"  && versionLessThan "9.9" && final.stdenv.targetPlatform.isWindows) ./patches/ghc/ghc-9.6-hadrian-splitsections.patch
+                ++ final.lib.optional (versionAtLeast "9.4"                             && final.stdenv.targetPlatform.isWindows) ./patches/ghc/ghc-9.6-fix-code-symbol-jumps.patch
                 # this one is to allow linking extra symbols from iserv.
                 # ++ fromUntil "9.6.1" "9.10"                                                                                       ./patches/ghc/iserv-syms.patch
                 ;

overlays/patches/ghc/ghc-9.6-fix-code-symbol-jumps.patch

@@ -0,0 +1,59 @@
+diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c
+index ed77d18..347ba73 100644
+--- a/rts/linker/PEi386.c
++++ b/rts/linker/PEi386.c
+@@ -1939,29 +1939,32 @@ static size_t
+ makeSymbolExtra_PEi386( ObjectCode* oc, uint64_t index STG_UNUSED, size_t s, char* symbol STG_UNUSED, SymType type )
+ {
+     SymbolExtra *extra;
+-
+-    if (type == SYM_TYPE_CODE) {
+-        // jmp *-14(%rip)
+-        extra = m32_alloc(oc->rx_m32, sizeof(SymbolExtra), 8);
+-        CHECK(extra);
+-        extra->addr = (uint64_t)s;
+-        static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
+-        memcpy(extra->jumpIsland, jmp, 6);
+-        IF_DEBUG(linker_verbose, debugBelch("makeSymbolExtra(code): %s -> %p\n", symbol, &extra->jumpIsland));
+-        return (size_t)&extra->jumpIsland;
+-    } else if (type == SYM_TYPE_INDIRECT_DATA) {
+-        extra = m32_alloc(oc->rw_m32, sizeof(SymbolExtra), 8);
+-        CHECK(extra);
+-        void *v = *(void**) s;
+-        extra->addr = (uint64_t)v;
+-        IF_DEBUG(linker_verbose, debugBelch("makeSymbolExtra(data): %s -> %p\n", symbol, &extra->addr));
+-        return (size_t)&extra->addr;
+-    } else {
+-        extra = m32_alloc(oc->rw_m32, sizeof(SymbolExtra), 8);
+-        CHECK(extra);
+-        extra->addr = (uint64_t)s;
+-        IF_DEBUG(linker_verbose, debugBelch("makeSymbolExtra(indirect-data): %s -> %p\n", symbol, &extra->addr));
+-        return (size_t)&extra->addr;
++    switch(type & ~SYM_TYPE_DUP_DISCARD) {
++        case SYM_TYPE_CODE: {
++            // jmp *-14(%rip)
++            extra = m32_alloc(oc->rx_m32, sizeof(SymbolExtra), 8);
++            CHECK(extra);
++            extra->addr = (uint64_t)s;
++            static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
++            memcpy(extra->jumpIsland, jmp, 6);
++            IF_DEBUG(linker_verbose, debugBelch("makeSymbolExtra(code): %s -> %p\n", symbol, &extra->jumpIsland));
++            return (size_t)&extra->jumpIsland;
++        }
++        case SYM_TYPE_INDIRECT_DATA: {
++            extra = m32_alloc(oc->rw_m32, sizeof(SymbolExtra), 8);
++            CHECK(extra);
++            void *v = *(void**) s;
++            extra->addr = (uint64_t)v;
++            IF_DEBUG(linker_verbose, debugBelch("makeSymbolExtra(data): %s -> %p\n", symbol, &extra->addr));
++            return (size_t)&extra->addr;
++        }
++        default: {
++            extra = m32_alloc(oc->rw_m32, sizeof(SymbolExtra), 8);
++            CHECK(extra);
++            extra->addr = (uint64_t)s;
++            IF_DEBUG(linker_verbose, debugBelch("makeSymbolExtra(indirect-data): %s -> %p\n", symbol, &extra->addr));
++            return (size_t)&extra->addr;
++        }
+     }
+ }

test/th-dlls/default.nix

@@ -20,11 +20,9 @@ let
   compareGhc = builtins.compareVersions buildPackages.haskell-nix.compiler.${compiler-nix-name}.version;
 
 in recurseIntoAttrs {
-  meta.disabled = stdenv.hostPlatform.isGhcjs ||
+  meta.disabled = stdenv.hostPlatform.isGhcjs
     # On aarch64 this test also breaks form musl builds (including cross compiles on x86_64-linux)
-    (stdenv.hostPlatform.isAarch64 && stdenv.hostPlatform.isMusl) ||
-    # broken on ucrt64 windows
-    (stdenv.hostPlatform.libc == "ucrt")
+    || (stdenv.hostPlatform.isAarch64 && stdenv.hostPlatform.isMusl)
     ;
 
   ifdInputs = {