Fix incorrect calculated relocations on Windows x86_64

Summary:
See #12031 for analysis, but essentially what happens is:

To sum up the issue, the reason this seems to go wrong is because
of how we initialize the `.bss` section for Windows in the runtime linker.

The first issue is where we calculate the zero space for the section:

```
zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
```

Where
```
UInt32 PointerToRawData;
```

This means we're stuffing a `64-bit` value into a `32-bit` one. Also `zspace`
can be larger than `oc->image`. In which case it'll overflow and
then get truncated in the cast.

The address of a value in the `.bss` section is then calculated as:

```
addr = ((UChar*)(oc->image))
     + (sectabent->PointerToRawData
     + symtab_i->Value);
```

If it does truncate then this calculation won't be correct (which is what is happening).

We then later use the value of `addr` as the `S` (Symbol) value for the relocations

```
S = (size_t) lookupSymbol_( (char*)symbol );
```

Now the majority of the relocations are `R_X86_64_PC32` etc.
e.g. They are guaranteed to fit in a `32-bit` value.

The `R_X86_64_64` introduced for these pseudo-relocations so they can use
the full `48-bit` addressing space isn't as lucky.
As for why it sometimes work has to do on whether the value is truncated or not.

`PointerToRawData` can't be changed because it's size is fixed by the PE specification.

Instead just like with the other platforms, we now use `section` on Windows as well.
This gives us a `start` parameter of type `void*` which solves the issue.

This refactors the code to use `section.start` and to fix the issues.

Test Plan: ./validate and new test added T12031

Reviewers: RyanGlScott, erikd, bgamari, austin, simonmar

Reviewed By: simonmar

Subscribers: thomie, #ghc_windows_task_force

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

GHC Trac Issues: #12031, #11317

9 files changed, 97 insertions, 33 deletions

diff --git a/rts/Linker.c b/rts/Linker.c
index a1f72e5cca..ef909f0ad9 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -3497,6 +3497,26 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
    }
 #endif
 
+   /* .BSS Section is initialized in ocGetNames_PEi386
+      but we need the Sections array initialized here already. */
+   Section *sections;
+   sections = (Section*)stgCallocBytes(
+       sizeof(Section),
+       hdr->NumberOfSections + 1, /* +1 for the global BSS section see ocGetNames_PEi386 */
+       "ocVerifyImage_PEi386(sections)");
+   oc->sections = sections;
+   oc->n_sections = hdr->NumberOfSections + 1;
+
+   /* Initialize the Sections */
+   for (i = 0; i < hdr->NumberOfSections; i++) {
+       COFF_section* sectab_i
+           = (COFF_section*)
+           myindex(sizeof_COFF_section, sectab, i);
+
+       /* Calculate the start of the data section */
+       sections[i].start = oc->image + sectab_i->PointerToRawData;
+   }
+
    /* No further verification after this point; only debug printing. */
    i = 0;
    IF_DEBUG(linker, i=1);
@@ -3525,6 +3545,7 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
       COFF_section* sectab_i
          = (COFF_section*)
            myindex ( sizeof_COFF_section, sectab, i );
+      Section section = sections[i];
       debugBelch(
                 "\n"
                 "section %d\n"
@@ -3537,14 +3558,14 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
                 "    vsize %d\n"
                 "    vaddr %d\n"
                 "  data sz %d\n"
-                " data off %d\n"
+                " data off 0x%p\n"
                 "  num rel %d\n"
                 "  off rel %d\n"
                 "  ptr raw 0x%x\n",
                 sectab_i->VirtualSize,
                 sectab_i->VirtualAddress,
                 sectab_i->SizeOfRawData,
-                sectab_i->PointerToRawData,
+                section.start,
                 sectab_i->NumberOfRelocations,
                 sectab_i->PointerToRelocations,
                 sectab_i->PointerToRawData
@@ -3690,25 +3711,16 @@ ocGetNames_PEi386 ( ObjectCode* oc )
        * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
        */
       if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
-      /* This is a non-empty .bss section.  Allocate zeroed space for
-         it, and set its PointerToRawData field such that oc->image +
-         PointerToRawData == addr_of_zeroed_space.  */
+      /* This is a non-empty .bss section.
+         Allocate zeroed space for it */
       bss_sz = sectab_i->VirtualSize;
       if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
       zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
-      sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
+      oc->sections[i].start = zspace;
       addProddableBlock(oc, zspace, bss_sz);
       /* debugBelch("BSS anon section at 0x%x\n", zspace); */
    }
 
-   Section *sections;
-   sections = (Section*)stgCallocBytes(
-       sizeof(Section),
-       hdr->NumberOfSections + 1, /* +1 for the global BSS section see below */
-       "ocGetNames_PEi386(sections)");
-   oc->sections = sections;
-   oc->n_sections = hdr->NumberOfSections + 1;
-
    /* Copy section information into the ObjectCode. */
 
    for (i = 0; i < hdr->NumberOfSections; i++) {
@@ -3722,6 +3734,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       COFF_section* sectab_i
          = (COFF_section*)
            myindex ( sizeof_COFF_section, sectab, i );
+      Section section = oc->sections[i];
 
       char *secname = cstring_from_section_name(sectab_i->Name, strtab);
 
@@ -3748,11 +3761,11 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       sz = sectab_i->SizeOfRawData;
       if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
 
-      start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
+      start = section.start;
       end   = start + sz - 1;
 
       if (kind != SECTIONKIND_OTHER && end >= start) {
-          addSection(&sections[i], kind, SECTION_NOMEM, start, sz, 0, 0, 0);
+          addSection(&oc->sections[i], kind, SECTION_NOMEM, start, sz, 0, 0, 0);
           addProddableBlock(oc, start, sz);
       }
 
@@ -3784,13 +3797,13 @@ ocGetNames_PEi386 ( ObjectCode* oc )
    if (globalBssSize > 0) {
        bss = stgCallocBytes(1, globalBssSize,
                             "ocGetNames_PEi386(non-anonymous bss)");
-       addSection(&sections[oc->n_sections-1],
+       addSection(&oc->sections[oc->n_sections-1],
                   SECTIONKIND_RWDATA, SECTION_MALLOC,
                   bss, globalBssSize, 0, 0, 0);
        IF_DEBUG(linker, debugBelch("bss @ %p %" FMT_Word "\n", bss, globalBssSize));
        addProddableBlock(oc, bss, globalBssSize);
    } else {
-       addSection(&sections[oc->n_sections-1],
+       addSection(&oc->sections[oc->n_sections-1],
                   SECTIONKIND_OTHER, SECTION_NOMEM, NULL, 0, 0, 0, 0);
    }
 
@@ -3817,9 +3830,8 @@ ocGetNames_PEi386 ( ObjectCode* oc )
             || (   symtab_i->StorageClass == MYIMAGE_SYM_CLASS_STATIC
                 && sectabent->Characteristics & MYIMAGE_SCN_LNK_COMDAT)
             ) {
-                 addr = ((UChar*)(oc->image))
-                        + (sectabent->PointerToRawData
-                           + symtab_i->Value);
+                 addr = (void*)((size_t)oc->sections[symtab_i->SectionNumber-1].start
+                      + symtab_i->Value);
                  if (sectabent->Characteristics & MYIMAGE_SCN_LNK_COMDAT) {
                     isWeak = HS_BOOL_TRUE;
               }
@@ -3969,6 +3981,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
          = (COFF_reloc*) (
               ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
            );
+      Section section = oc->sections[i];
 
       char *secname = cstring_from_section_name(sectab_i->Name, strtab);
 
@@ -4020,11 +4033,10 @@ ocResolve_PEi386 ( ObjectCode* oc )
               myindex ( sizeof_COFF_reloc, reltab, j );
 
          /* the location to patch */
-         pP = (
-                 ((UChar*)(oc->image))
-                 + (sectab_i->PointerToRawData
-                    + reltab_j->VirtualAddress
-                    - sectab_i->VirtualAddress )
+         pP = (void*)(
+                   (size_t)section.start
+                 + reltab_j->VirtualAddress
+                 - sectab_i->VirtualAddress
               );
          /* the existing contents of pP */
          A = *(UInt32*)pP;
@@ -4043,10 +4055,8 @@ ocResolve_PEi386 ( ObjectCode* oc )
                             debugBelch("'\n" ));
 
          if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
-            COFF_section* section_sym
-              = (COFF_section*) myindex ( sizeof_COFF_section, sectab, sym->SectionNumber-1 );
-            S = ((size_t)(oc->image))
-              + ((size_t)(section_sym->PointerToRawData))
+            Section section = oc->sections[sym->SectionNumber-1];
+            S = ((size_t)(section.start))
               + ((size_t)(sym->Value));
          } else {
             copyName ( sym->Name, strtab, symbol, 1000-1 );
@@ -4201,9 +4211,10 @@ ocRunInit_PEi386 ( ObjectCode *oc )
         COFF_section* sectab_i
             = (COFF_section*)
                 myindex ( sizeof_COFF_section, sectab, i );
+        Section section = oc->sections[i];
         char *secname = cstring_from_section_name(sectab_i->Name, strtab);
         if (0 == strcmp(".ctors", (char*)secname)) {
-            UChar *init_startC = (UChar*)(oc->image) + sectab_i->PointerToRawData;
+            UChar *init_startC = section.start;
             init_t *init_start, *init_end, *init;
             init_start = (init_t*)init_startC;
             init_end = (init_t*)(init_startC + sectab_i->SizeOfRawData);
diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
index 815180c757..5686863cbb 100644
--- a/rts/LinkerInternals.h
+++ b/rts/LinkerInternals.h
@@ -43,8 +43,8 @@ typedef
 
 typedef
    struct _Section {
-      void* start;                /* actual start of section in memory */
-      StgWord size;               /* actual size of section in memory */
+      void*    start;              /* actual start of section in memory */
+      StgWord  size;               /* actual size of section in memory */
       SectionKind kind;
       SectionAlloc alloc;
 
diff --git a/testsuite/tests/rts/T12031/ExternBug.hs b/testsuite/tests/rts/T12031/ExternBug.hs
new file mode 100644
index 0000000000..5c28aede00
--- /dev/null
+++ b/testsuite/tests/rts/T12031/ExternBug.hs
@@ -0,0 +1,9 @@
+-- Copyright (c) 2016, Ryan Scott
+-- ExternBug.hs
+{-# LANGUAGE ForeignFunctionInterface #-}
+module ExternBug (bar) where
+
+{-# INCLUDE foo.h #-}
+
+foreign import ccall "bar"
+  bar :: IO ()
diff --git a/testsuite/tests/rts/T12031/Makefile b/testsuite/tests/rts/T12031/Makefile
new file mode 100644
index 0000000000..0a9420692a
--- /dev/null
+++ b/testsuite/tests/rts/T12031/Makefile
@@ -0,0 +1,8 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T12031:
+	'$(TEST_HC)' -c bar.c -o bar.o
+	'$(TEST_HC)' -c baz.c -o baz.o
+	echo bar | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) bar.o baz.o ExternBug.hs
diff --git a/testsuite/tests/rts/T12031/T12031.stdout b/testsuite/tests/rts/T12031/T12031.stdout
new file mode 100644
index 0000000000..e5cc126783
--- /dev/null
+++ b/testsuite/tests/rts/T12031/T12031.stdout
@@ -0,0 +1 @@
+The value of foo is 1
diff --git a/testsuite/tests/rts/T12031/all.T b/testsuite/tests/rts/T12031/all.T
new file mode 100644
index 0000000000..b051514109
--- /dev/null
+++ b/testsuite/tests/rts/T12031/all.T
@@ -0,0 +1,4 @@
+test('T12031', [ extra_clean(['bar.o', 'baz.o', 'ExternBug.o'])
+               , extra_files(['bar.c', 'baz.c', 'ExternBug.hs', 'foo.h'])
+               ],
+               run_command, ['$MAKE -s --no-print-directory T12031'])
diff --git a/testsuite/tests/rts/T12031/bar.c b/testsuite/tests/rts/T12031/bar.c
new file mode 100644
index 0000000000..257cc198f4
--- /dev/null
+++ b/testsuite/tests/rts/T12031/bar.c
@@ -0,0 +1,11 @@
+// Copyright (c) 2016, Ryan Scott
+// bar.c
+#include "foo.h"
+
+int foo = 0;
+
+void bar(void) {
+    foo = 1;
+
+    baz();
+}
diff --git a/testsuite/tests/rts/T12031/baz.c b/testsuite/tests/rts/T12031/baz.c
new file mode 100644
index 0000000000..d710148736
--- /dev/null
+++ b/testsuite/tests/rts/T12031/baz.c
@@ -0,0 +1,9 @@
+// Copyright (c) 2016, Ryan Scott
+// baz.c
+#include "foo.h"
+#include <stdio.h>
+
+void baz(void) {
+    printf("The value of foo is %d\n", foo); // Segfaults on this line
+    fflush(stdout);
+}
diff --git a/testsuite/tests/rts/T12031/foo.h b/testsuite/tests/rts/T12031/foo.h
new file mode 100644
index 0000000000..d3ca4aad2d
--- /dev/null
+++ b/testsuite/tests/rts/T12031/foo.h
@@ -0,0 +1,11 @@
+// Copyright (c) 2016, Ryan Scott
+// foo.h
+#ifndef FOO_H
+#define FOO_H
+
+extern int foo;
+
+void bar(void);
+void baz(void);
+
+#endif