Better import library support for Windows
authorTamar Christina <tamar@zhox.com>
Fri, 2 Jun 2017 15:47:57 +0000 (11:47 -0400)
committerBen Gamari <ben@smart-cactus.org>
Fri, 2 Jun 2017 16:27:45 +0000 (12:27 -0400)
The import library support added for 7.10.3 was only a partial one.
This support was predicated on using file extensions to determine
whether or not a library was an import library. It also couldn't handle
libraries with multiple dll pointers.

This is a rewrite of that patch and fully integrating it into the normal
archive parsing and loading routines. This solves a host of issues,
among others allowing us to finally use `-lgcc_s`.

This also fixes a problem with our previous implementation, where we
just loaded the DLL and moved on. Doing this had the potential of using
the wrong symbol at resolve time. Say a DLL already loaded (A.dll) has
symbol a exported (dependency of another dll perhaps).

We find an import library `B.lib` explicitly defining an export of `a`.
we load `B.dll` but this gets put after `A.dll`, at resolve time we
would use the value from `A` instead of `B` which is what we wanted.

Test Plan: ./valide and make test TEST=13606

Reviewers: austin, bgamari, erikd, simonmar

Reviewed By: bgamari

Subscribers: rwbarton, RyanGlScott, thomie, #ghc_windows_task_force

GHC Trac Issues: #13606, #12499, #12498

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

13 files changed:
docs/users_guide/8.4.1-notes.rst
rts/Linker.c
rts/LinkerInternals.h
rts/RtsSymbolInfo.c
rts/RtsSymbolInfo.h
rts/linker/LoadArchive.c
rts/linker/PEi386.c
rts/linker/PEi386.h
testsuite/tests/ghci/linking/dyn/Makefile
testsuite/tests/ghci/linking/dyn/T13606.hs [new file with mode: 0644]
testsuite/tests/ghci/linking/dyn/T13606.stdout [new file with mode: 0644]
testsuite/tests/ghci/linking/dyn/Triangle.fx [new file with mode: 0644]
testsuite/tests/ghci/linking/dyn/all.T

index 62173d5..72d6901 100644 (file)
@@ -84,6 +84,10 @@ Runtime system
 
 - Function ``hs_add_root()`` was removed. It was a no-op since GHC-7.2.1
   where module initialisation stopped requiring a call to ``hs_add_root()``.
+  
+- Proper import library support added to GHC which can handle all of the libraries produced
+  by dlltool. The limitation of them needing to be named with the suffix .dll.a is also removed.
+  See :ghc-ticket:`13606`, :ghc-ticket:`12499`, :ghc-ticket:`12498`
 
 Template Haskell
 ~~~~~~~~~~~~~~~~
index 65caf89..6e710a1 100644 (file)
@@ -230,6 +230,9 @@ static void ghciRemoveSymbolTable(HashTable *table, const SymbolName* key,
     RtsSymbolInfo *pinfo = lookupStrHashTable(table, key);
     if (!pinfo || owner != pinfo->owner) return;
     removeStrHashTable(table, key, NULL);
+    if (isSymbolImport (owner, key))
+      stgFree(pinfo->value);
+
     stgFree(pinfo);
 }
 
@@ -731,7 +734,7 @@ addDLL( pathchar *dll_name )
    return errmsg;
 
 #  elif defined(OBJFORMAT_PEi386)
-   return addDLL_PEi386(dll_name);
+   return addDLL_PEi386(dll_name, NULL);
 
 #  else
    barf("addDLL: not implemented on this platform");
index b8c411d..48c43eb 100644 (file)
@@ -32,13 +32,23 @@ typedef enum {
 /* Indication of section kinds for loaded objects.  Needed by
    the GC for deciding whether or not a pointer on the stack
    is a code pointer.
+   See Note [BFD import libraries].
 */
 typedef
-   enum { SECTIONKIND_CODE_OR_RODATA,
+   enum { /* Section is code or readonly. e.g. .text or .r(o)data.  */
+          SECTIONKIND_CODE_OR_RODATA,
+          /* Section contains read/write data. e.g. .data.  */
           SECTIONKIND_RWDATA,
+          /* Static initializer section. e.g. .ctors.  */
           SECTIONKIND_INIT_ARRAY,
+          /* We don't know what the section is and don't care.  */
           SECTIONKIND_OTHER,
-          SECTIONKIND_NOINFOAVAIL }
+          /* Section belongs to an import section group. e.g. .idata$.  */
+          SECTIONKIND_IMPORT,
+          /* Section defines an import library entry, e.g. idata$7.  */
+          SECTIONKIND_IMPORT_LIBRARY,
+          SECTIONKIND_NOINFOAVAIL
+        }
    SectionKind;
 
 typedef
index 6688d9c..0553308 100644 (file)
 #include "Hash.h"
 #include "RtsUtils.h"
 
-typedef struct _SymbolInfo {
-    /* Determines if the
-       symbol is weak */
-    HsBool isWeak;
+#include <stdbool.h>
 
-} SymbolInfo;
+/* Generic function to update any extra info fields.  */
+void setSymbolInfo(ObjectCode *owner, const void *label, symbolUpdater updater)
+{
+    SymbolInfo *info;
+    if (owner && label)
+    {
+        info = NULL;
+        if (!owner->extraInfos)
+            owner->extraInfos = allocStrHashTable();
+        else
+            info = lookupStrHashTable(owner->extraInfos, label);
+
+        if (!info)
+        {
+            info = stgMallocBytes(sizeof(SymbolInfo), "setSymbolInfo");
+            info->kind = 0;
+        }
+
+        updater(info);
+        insertStrHashTable(owner->extraInfos, label, info);
+    }
+}
 
 /* -----------------------------------------------------------------------------
 * Performs a check to see if the symbol at the given address
 * is a weak symbol or not.
 *
-* Returns: HS_BOOL_TRUE on symbol being weak, else HS_BOOL_FALSE
+* Returns: true on symbol being weak, else false
 */
-HsBool isSymbolWeak(ObjectCode *owner, void *label)
+bool isSymbolWeak(ObjectCode *owner, const void *label)
 {
     SymbolInfo *info;
-    if (owner
+    return owner
         && label
         && owner->extraInfos
-        && (info = lookupStrHashTable(owner->extraInfos, label)) != NULL)
-    {
-        return info->isWeak;
-    }
+        && (info = lookupStrHashTable(owner->extraInfos, label)) != NULL
+        && (info->kind & KIND_WEAK) == KIND_WEAK;
+}
 
-    return HS_BOOL_FALSE;
+/* -----------------------------------------------------------------------------
+* Performs a check to see if the symbol at the given address
+* is an import symbol or not.
+*
+* Returns: true on symbol being weak, else false
+*/
+bool isSymbolImport(ObjectCode *owner, const void *label)
+{
+    SymbolInfo *info;
+    return owner
+        && label
+        && owner->extraInfos
+        && (info = lookupStrHashTable(owner->extraInfos, label)) != NULL
+        && (info->kind & KIND_IMPORT) == KIND_IMPORT;
+}
+
+static void markWeak(SymbolInfo* info)
+{
+    if(info)
+      info->kind |= KIND_WEAK;
+}
+
+static void markImport(SymbolInfo* info)
+{
+    if(info)
+      info->kind |= KIND_IMPORT;
+}
+
+static void unmarkImport(SymbolInfo* info)
+{
+    if(info)
+      info->kind &= ~KIND_IMPORT;
 }
 
 /* -----------------------------------------------------------------------------
@@ -47,26 +95,27 @@ HsBool isSymbolWeak(ObjectCode *owner, void *label)
 * If the extra symbol infos table has not been initialized
 * yet this will create and allocate a new Hashtable
 */
-void setWeakSymbol(ObjectCode *owner, void *label)
+void setWeakSymbol(ObjectCode *owner, const void *label)
 {
-    SymbolInfo *info;
-    if (owner && label)
-    {
-        info = NULL;
-        if (!owner->extraInfos)
-        {
-            owner->extraInfos = allocStrHashTable();
-        }
-        else {
-            info = lookupStrHashTable(owner->extraInfos, label);
-        }
-
-        if (!info){
-            info = stgMallocBytes(sizeof(SymbolInfo), "setWeakSymbol");
-        }
+    setSymbolInfo (owner, label, &markWeak);
+}
 
-        info->isWeak = HS_BOOL_TRUE;
+/* -----------------------------------------------------------------------------
+* Marks the symbol at the given address as import or not.
+* If the extra symbol infos table has not been initialized
+* yet this will create and allocate a new Hashtable
+*/
+void setImportSymbol(ObjectCode *owner, const void *label)
+{
+    setSymbolInfo (owner, label, &markImport);
+}
 
-        insertStrHashTable(owner->extraInfos, label, info);
-    }
+/* -----------------------------------------------------------------------------
+* Clear the import symbol flag.
+* If the extra symbol infos table has not been initialized
+* yet this will create and allocate a new Hashtable
+*/
+void clearImportSymbol(ObjectCode *owner, const void *label)
+{
+    setSymbolInfo (owner, label, &unmarkImport);
 }
index 1f3d35e..9873ff3 100644 (file)
@@ -9,6 +9,25 @@
 #pragma once
 
 #include "LinkerInternals.h"
+#include <stdbool.h>
 
-HsBool isSymbolWeak(ObjectCode *owner, void *label);
-void setWeakSymbol(ObjectCode *owner, void *label);
+/* See Note [BFD Import libraries].  */
+typedef enum _SymbolKind {
+    KIND_NORMAL = 0x01,
+    KIND_WEAK   = 0x02,
+    KIND_IMPORT = 0x04
+} SymbolKind;
+
+typedef struct _SymbolInfo {
+    /* Determines what kind of symbol we are storing.  */
+    SymbolKind kind;
+} SymbolInfo;
+
+bool isSymbolWeak(ObjectCode *owner, const void *label);
+bool isSymbolImport(ObjectCode *owner, const void *label);
+void setWeakSymbol(ObjectCode *owner, const void *label);
+void setImportSymbol(ObjectCode *owner, const void *label);
+void clearImportSymbol(ObjectCode *owner, const void *label);
+
+typedef void (*symbolUpdater)(SymbolInfo*);
+void setSymbolInfo(ObjectCode *owner, const void *label, symbolUpdater updater);
index 06a143e..3c4bd44 100644 (file)
@@ -479,16 +479,6 @@ static HsInt loadArchive_ (pathchar *path)
         * Linker members (e.g. filename / are skipped since they are not needed)
         */
         isImportLib = thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".dll", 4) == 0;
-
-        /*
-         * Note [GCC import files (ext .dll.a)]
-         * GCC stores import information in the same binary format
-         * as the object file normally has. The only difference is that
-         * all the information are put in .idata sections. The only real
-         * way to tell if we're dealing with an import lib is by looking
-         * at the file extension.
-         */
-        isImportLib = isImportLib || endsWithPath(path, WSTR(".dll.a"));
 #endif // windows
 
         DEBUG_LOG("\tthisFileNameSize = %d\n", (int)thisFileNameSize);
@@ -553,20 +543,8 @@ static HsInt loadArchive_ (pathchar *path)
                 fclose(f);
                 return 0;
             } else {
-#if defined(OBJFORMAT_PEi386)
-                if (isImportLib)
-                {
-                    findAndLoadImportLibrary(oc);
-                    stgFree(oc);
-                    oc = NULL;
-                    break;
-                } else {
-#endif
-                    oc->next = objects;
-                    objects = oc;
-#if defined(OBJFORMAT_PEi386)
-                }
-#endif
+                oc->next = objects;
+                objects = oc;
             }
         }
         else if (isGnuIndex) {
index 8098400..5301eb1 100644 (file)
    http://www.x86-64.org/documentation/abi.pdf
 
    The current code is based on version 0.99.6 - October 2013
+
+   Note [BFD import library]
+
+   On Windows, compilers don't link directly to dynamic libraries.
+   The reason for this is that the exports are not always by symbol, the
+   Import Address Table (IAT) also allows exports by ordinal number
+   or raw addresses.
+
+   So to solve the linking issue, import libraries were added. Import libraries
+   can be seen as a specification of how to link implicitly against a dynamic
+   library. As a side note, import libraries are also the mechanism which
+   can be used to break mutual dependencies between shared libraries and to
+   implement delay loading or override the location of a shared library at
+   startup.
+
+   Linkers use these import libraries to populate the IAT of the resulting
+   binary. At startup the system dynamic loader processes the IAT entries
+   and populates the symbols with the correct addresses.
+
+   Anyway, the Windows PE format specifies a simple and efficient format for
+   this: It's essentially a list, saying these X symbols can be found in DLL y.
+   Commonly, y is a versioned name. e.g. liby_43.dll. This is an artifact of
+   the days when Windows did not support side-by-side assemblies. So the
+   solution was to version the DLLs by renaming them to include explicit
+   version numbers, and to then use the import libraries to point to the right
+   version, having the linker do the leg work.
+
+   The format in the PE specification is commonly named using the suffix .lib.
+   Unfortunately, GCC/binutils decided not to implement this format, and instead
+   have created their own format. This format is either named using the suffix
+   .dll.a or .a depending on the tool that makes them. This format is
+   undocumented. However the source of dlltool.c in binutils is pretty handy to
+   understant it.
+
+   To understand the implementation in GHC, this is what is important:
+
+   the .idata section group is used to hold this information. An import library
+   object file will always have these section groups, but the specific
+   configuration depends on what the purpose of the file is. They will also
+   never have a CODE or DATA section, though depending on the tool that creates
+   them they may have the section headers, which will mostly be empty.
+
+   You have to different possible configuration:
+
+   1) Those that define a redirection. In this case the .idata$7 section will
+      contain the name of the actual dll to load. This will be the only content
+      of the section. In the symbol table, the last symbol will be the name
+      used to refer to the dll in the relocation tables. This name will always
+      be in the format "symbol_name_iname", however when refered to, the format
+      "_head_symbol_name" is used.
+
+      We record this symbol early on during GetNames and load the dll and use
+      the module handle as the symbol address.
+
+   2) Symbol definitions. In this case .idata$6 will contain the symbol to load.
+      This is stored in the fixed format of 2-byte ordinals followed by a null
+      terminated string with the symbol name. The ordinal is to be used when
+      the dll does not export symbols by name. (NOTE: We don't currently
+      support this in the runtime linker, but it's easy to add should it be
+      needed). The last symbol in the symbol table of the section will contain
+      the name symbol which contains the dll name to use to resolve the
+      reference.
+
+   As a technicality, this also means that the GCC format will allow us to use
+   one library to store references to multiple dlls. This can't be produced by
+   dlltool, but it can be combined using ar. This is an important feature
+   required for dynamic linking support for GHC. So the runtime linker now
+   supports this too.
 */
 
 #include "Rts.h"
@@ -176,16 +244,21 @@ static void addDLLHandle(pathchar* dll_name, HINSTANCE instance) {
     } while (imports->Name);
 }
 
-static bool checkIfDllLoaded(HINSTANCE instance)
+static OpenedDLL* findLoadedDll(HINSTANCE instance)
 {
     for (OpenedDLL* o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
         if (o_dll->instance == instance)
         {
-            return true;
+            return o_dll;
         }
     }
 
-    return false;
+    return NULL;
+}
+
+static bool checkIfDllLoaded(HINSTANCE instance)
+{
+    return findLoadedDll (instance) != NULL;
 }
 
 void freePreloadObjectFile_PEi386(ObjectCode *oc)
@@ -202,8 +275,11 @@ void freePreloadObjectFile_PEi386(ObjectCode *oc)
     indirects = NULL;
 }
 
+/* Loads the DLL specified by DLL_NAME, and if successful
+   adds the DLL to the internal linker map and returns the instance handle
+   of the loaded dll in LOADED if LOADED is not NULL. */
 const char *
-addDLL_PEi386( pathchar *dll_name )
+addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded )
 {
    /* ------------------- Win32 DLL loader ------------------- */
 
@@ -244,8 +320,7 @@ addDLL_PEi386( pathchar *dll_name )
         {
             snwprintf(buf, bufsize, formats[cFormat], dll_name);
             instance = LoadLibraryExW(buf, NULL, flags[cFlag]);
-            if (instance == NULL)
-            {
+            if (instance == NULL) {
                 if (GetLastError() != ERROR_MOD_NOT_FOUND)
                 {
                     goto error;
@@ -264,6 +339,9 @@ addDLL_PEi386( pathchar *dll_name )
     }
 
     addDLLHandle(buf, instance);
+    if (loaded) {
+        *loaded = instance;
+    }
     stgFree(buf);
 
     return NULL;
@@ -451,73 +529,6 @@ allocateImageAndTrampolines (
    return image + PEi386_IMAGE_OFFSET;
 }
 
-bool findAndLoadImportLibrary(ObjectCode* oc)
-{
-    int i;
-
-    COFF_header*  hdr;
-    COFF_section* sectab;
-    COFF_symbol*  symtab;
-    uint8_t*      strtab;
-
-    hdr = (COFF_header*)(oc->image);
-    sectab = (COFF_section*)(
-        ((uint8_t*)(oc->image))
-        + sizeof_COFF_header + hdr->SizeOfOptionalHeader
-        );
-
-    symtab = (COFF_symbol*)(
-        ((uint8_t*)(oc->image))
-        + hdr->PointerToSymbolTable
-        );
-
-    strtab = ((uint8_t*)symtab)
-        + hdr->NumberOfSymbols * sizeof_COFF_symbol;
-
-    for (i = 0; i < oc->n_sections; i++)
-    {
-        COFF_section* sectab_i
-            = (COFF_section*)myindex(sizeof_COFF_section, sectab, i);
-
-        char *secname = cstring_from_section_name(sectab_i->Name, strtab);
-
-        // Find the first entry containing a valid .idata$7 section.
-        if (strcmp(secname, ".idata$7") == 0) {
-            /* First load the containing DLL if not loaded. */
-            Section section = oc->sections[i];
-
-            pathchar* dirName = pathdir(oc->fileName);
-            HsPtr token       = addLibrarySearchPath(dirName);
-            stgFree(dirName);
-            char* dllName = (char*)section.start;
-
-            if (strlen(dllName) == 0 || dllName[0] == ' ')
-            {
-                continue;
-            }
-
-            IF_DEBUG(linker, debugBelch("lookupSymbol: on-demand '%ls' => `%s'\n", oc->fileName, dllName));
-
-            pathchar* dll = mkPath(dllName);
-            removeLibrarySearchPath(token);
-
-            const char* result = addDLL(dll);
-            stgFree(dll);
-
-            if (result != NULL) {
-                errorBelch("Could not load `%s'. Reason: %s\n", (char*)dllName, result);
-                return false;
-            }
-
-            break;
-        }
-
-        stgFree(secname);
-    }
-
-    return true;
-}
-
 bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f )
 {
     char* image;
@@ -970,6 +981,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
    COFF_section* sectab;
    COFF_symbol*  symtab;
    uint8_t*        strtab;
+   bool          has_code_section = false;
 
    uint8_t*     sname;
    SymbolAddr* addr;
@@ -1053,21 +1065,57 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       IF_DEBUG(linker, debugBelch("section name = %s\n", secname ));
 
       /* The PE file section flag indicates whether the section contains code or data. */
-      if (sectab_i->Characteristics & IMAGE_SCN_CNT_CODE ||
-          sectab_i->Characteristics & IMAGE_SCN_CNT_INITIALIZED_DATA)
-         kind = SECTIONKIND_CODE_OR_RODATA;
+      if (sectab_i->Characteristics & IMAGE_SCN_CNT_CODE) {
+          has_code_section = has_code_section || sectab_i->SizeOfRawData > 0;
+          kind = SECTIONKIND_CODE_OR_RODATA;
+       }
+
+       if (sectab_i->Characteristics & IMAGE_SCN_CNT_INITIALIZED_DATA)
+           kind = SECTIONKIND_CODE_OR_RODATA;
 
       /* Check next if it contains any uninitialized data */
       if (sectab_i->Characteristics & IMAGE_SCN_CNT_UNINITIALIZED_DATA)
-         kind = SECTIONKIND_RWDATA;
+          kind = SECTIONKIND_RWDATA;
 
       /* Finally check if it can be discarded. This will also ignore .debug sections */
       if (sectab_i->Characteristics & IMAGE_SCN_MEM_DISCARDABLE ||
           sectab_i->Characteristics & IMAGE_SCN_LNK_REMOVE)
           kind = SECTIONKIND_OTHER;
 
-      if (0==strcmp(".ctors", (char*)secname))
-         kind = SECTIONKIND_INIT_ARRAY;
+      if (0==strncmp(".ctors", (char*)secname, 6))
+          kind = SECTIONKIND_INIT_ARRAY;
+
+      if (0==strncmp(".idata", (char*)secname, 6))
+          kind = SECTIONKIND_IMPORT;
+
+      /* See Note [BFD import library].  */
+      if (0==strncmp(".idata$7", (char*)secname, 8))
+          kind = SECTIONKIND_IMPORT_LIBRARY;
+
+      if (0==strncmp(".idata$6", (char*)secname, 8)) {
+          /* The first two bytes contain the ordinal of the function
+             in the format of lowpart highpart. The two bytes combined
+             for the total range of 16 bits which is the function export limit
+             of DLLs.  */
+          sname = ((uint8_t*)section.start)+2;
+          COFF_symbol* symtab_i = (COFF_symbol*)
+                myindex ( sizeof_COFF_symbol, symtab, hdr->NumberOfSymbols-1 );
+          addr = (char*)cstring_from_COFF_symbol_name(symtab_i->N.ShortName,
+                                                      strtab);
+
+          IF_DEBUG(linker,
+                   debugBelch("addImportSymbol `%s' => `%s'\n",
+                              sname, (char*)addr));
+          if (!ghciInsertSymbolTable(oc->fileName, symhash, (SymbolName*)sname,
+                                     addr, false, oc))
+             return false;
+          setImportSymbol (oc, sname);
+
+          /* Don't process this oc any futher. Just exit.  */
+          oc->n_symbols = 0;
+          oc->symbols   = NULL;
+          return true;
+      }
 
       ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->Misc.VirtualSize == 0);
       sz = sectab_i->SizeOfRawData;
@@ -1126,8 +1174,15 @@ ocGetNames_PEi386 ( ObjectCode* oc )
 
       addr = NULL;
       bool isWeak = false;
+      Section *section = symtab_i->SectionNumber > 0
+                       ? &oc->sections[symtab_i->SectionNumber-1]
+                       : NULL;
+      sname = cstring_from_COFF_symbol_name(symtab_i->N.ShortName, strtab);
+
       if (   symtab_i->SectionNumber != IMAGE_SYM_UNDEFINED
-          && symtab_i->SectionNumber > 0) {
+          && symtab_i->SectionNumber > 0
+          && section
+          && section->kind != SECTIONKIND_IMPORT_LIBRARY) {
          /* This symbol is global and defined, viz, exported */
          /* for IMAGE_SYMCLASS_EXTERNAL
                 && !IMAGE_SYM_UNDEFINED,
@@ -1140,9 +1195,10 @@ ocGetNames_PEi386 ( ObjectCode* oc )
                                         symtab_i->SectionNumber-1 );
          if (symtab_i->StorageClass == IMAGE_SYM_CLASS_EXTERNAL
             || (   symtab_i->StorageClass == IMAGE_SYM_CLASS_STATIC
-                && sectabent->Characteristics & IMAGE_SCN_LNK_COMDAT)
+                && sectabent->Characteristics & IMAGE_SCN_LNK_COMDAT
+                && section)
             ) {
-                 addr = (void*)((size_t)oc->sections[symtab_i->SectionNumber-1].start
+                 addr = (void*)((size_t)section->start
                       + symtab_i->Value);
                  if (sectabent->Characteristics & IMAGE_SCN_LNK_COMDAT) {
                     isWeak = true;
@@ -1160,10 +1216,73 @@ ocGetNames_PEi386 ( ObjectCode* oc )
           bss = (SymbolAddr*)((StgWord)bss + (StgWord)symtab_i->Value);
           IF_DEBUG(linker, debugBelch("bss symbol @ %p %lu\n", addr, symtab_i->Value));
       }
+      else if (symtab_i->SectionNumber > 0
+               && section
+               && section->kind == SECTIONKIND_IMPORT_LIBRARY) {
+          /* This is an import section. We should load the dll and lookup
+             the symbols.
+             See Note [BFD import library].  */
+          char* dllName = (char*)section->start;
+          if (strlen(dllName) == 0 || dllName[0] == 0 || has_code_section)
+              continue;
+
+          pathchar* dirName = pathdir(oc->fileName);
+          HsPtr token       = addLibrarySearchPath(dirName);
+          stgFree(dirName);
+
+          symtab_i = (COFF_symbol*)
+                 myindex ( sizeof_COFF_symbol, symtab, oc->n_symbols-1 );
+          sname = cstring_from_COFF_symbol_name(symtab_i->N.ShortName, strtab);
+
+          IF_DEBUG(linker,
+                   debugBelch("loading symbol `%s' from dll: '%ls' => `%s'\n",
+                              sname, oc->fileName, dllName));
+
+          pathchar* dll = mkPath(dllName);
+          HINSTANCE dllInstance = 0;
+          const char* result = addDLL_PEi386(dll, &dllInstance);
+          removeLibrarySearchPath(token);
+          stgFree(dll);
+
+          if (result != NULL || dllInstance == 0) {
+              errorBelch("Could not load `%s'. Reason: %s\n",
+                         (char*)dllName, result);
+              return false;
+          }
+
+          /* Set the _dll_iname symbol to the dll's handle.  */
+          addr = (SymbolAddr*)dllInstance;
+
+          /* the symbols are named <name>_iname when defined, but are named
+             _head_<name> when looked up. (Ugh. thanks GCC.) So correct it when
+             stored so we don't have to correct it each time when retrieved.  */
+          int size = strlen((char*)sname)+1;
+          char *tmp = stgMallocBytes(size*sizeof(char),
+                                     "ocGetNames_PEi386");
+          strncpy(tmp, (char*)sname, size);
+          char *pos = strstr(tmp, "_iname");
+          /* drop anything after the name. There are some inconsistencies with
+             whitespaces trailing the name.  */
+          if (pos) pos[0] = '\0';
+          int start = 0;
+
+          /* msys2 project's import lib builder has some inconsistent name
+             manglings. Their names start with _ or __ yet they drop this when
+             making the _head_ symbol. So do the same.  */
+          while (tmp[start]=='_')
+            start++;
+
+          snprintf((char*)sname, size, "_head_%s", tmp+start);
+          sname[size-start]='\0';
+          stgFree(tmp);
+          if (!ghciInsertSymbolTable(oc->fileName, symhash, (SymbolName*)sname,
+                                     addr, false, oc))
+               return false;
+          break;
+      }
 
-      sname = cstring_from_COFF_symbol_name(symtab_i->N.ShortName, strtab);
-      if (addr != NULL || isWeak) {
-
+      if ((addr != NULL || isWeak)
+         && (!section || (section && section->kind != SECTIONKIND_IMPORT))) {
          /* debugBelch("addSymbol %p `%s' Weak:%lld \n", addr, sname, isWeak); */
          IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname));
          ASSERT(i >= 0 && i < oc->n_symbols);
@@ -1381,7 +1500,6 @@ ocResolve_PEi386 ( ObjectCode* oc )
             copyName ( sym->N.ShortName, strtab, symbol, 1000-1 );
             S = (size_t) lookupSymbol_( (char*)symbol );
             if ((void*)S == NULL) {
-
                 errorBelch(" | %" PATH_FMT ": unknown symbol `%s'", oc->fileName, symbol);
                 return false;
             }
@@ -1574,6 +1692,26 @@ SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl)
             sprintf(symBuffer, "_%s", lbl);
             pinfo->value = GetProcAddress(GetModuleHandle("msvcrt"), symBuffer);
         }
+        else if (pinfo && pinfo->owner && isSymbolImport (pinfo->owner, lbl))
+        {
+            /* See Note [BFD import library].  */
+            HINSTANCE dllInstance = (HINSTANCE)lookupSymbol(pinfo->value);
+            if (!dllInstance && pinfo->value)
+               return pinfo->value;
+
+            if (!dllInstance)
+            {
+               errorBelch("Unable to load import dll symbol `%s'. "
+                          "No _iname symbol.", lbl);
+               return NULL;
+            }
+            IF_DEBUG(linker,
+               debugBelch("indexing import %s => %s using dll instance %p\n",
+                   lbl, (char*)pinfo->value, dllInstance));
+            pinfo->value = GetProcAddress((HMODULE)dllInstance, lbl);
+            clearImportSymbol (pinfo->owner, lbl);
+            return pinfo->value;
+        }
 #endif
         return loadSymbol(lbl, pinfo);
     }
index 29ef6ec..44f280f 100644 (file)
 #endif
 
 void initLinker_PEi386( void );
-const char * addDLL_PEi386( pathchar *dll_name );
+const char * addDLL_PEi386( pathchar *dll_name, HINSTANCE *instance  );
 void freePreloadObjectFile_PEi386( ObjectCode *oc );
 
-bool findAndLoadImportLibrary( ObjectCode* oc );
 bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f);
 
 pathchar* findSystemLibrary_PEi386( pathchar* dll_name );
@@ -31,7 +30,7 @@ bool ocGetNames_PEi386    ( ObjectCode* oc );
 bool ocVerifyImage_PEi386 ( ObjectCode* oc );
 SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl);
 bool ocAllocateSymbolExtras_PEi386 ( ObjectCode* oc );
-void *lookupSymbolInDLLs ( unsigned char *lbl );
+SymbolAddr *lookupSymbolInDLLs ( unsigned char *lbl );
 /* See Note [mingw-w64 name decoration scheme] */
 
 char *
index fd954bf..63b1690 100644 (file)
@@ -98,3 +98,7 @@ T1407:
 
 .PHONY: T3242
        echo ":q" | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) -lm
+
+.PHONY: T13606
+T13606:
+       echo "main" | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) -lD3DCompiler T13606.hs
diff --git a/testsuite/tests/ghci/linking/dyn/T13606.hs b/testsuite/tests/ghci/linking/dyn/T13606.hs
new file mode 100644 (file)
index 0000000..3bce51a
--- /dev/null
@@ -0,0 +1,128 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Main (main) where
+
+import Data.Bits (Bits(..))
+import Data.Int (Int32)
+import Data.Word (Word32)
+import Foreign.C.String (CString, peekCString, withCString, withCStringLen)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Ptr (Ptr, castPtr, nullPtr)
+import Foreign.Storable (Storable(..))
+import System.IO (IOMode(..), hGetContents, withFile)
+
+#if defined(i386_HOST_ARCH)
+# define WINDOWS_CCONV stdcall
+#elif defined(x86_64_HOST_ARCH)
+# define WINDOWS_CCONV ccall
+#else
+# error Unknown mingw32 arch
+#endif
+
+foreign import WINDOWS_CCONV "D3DCompile" c_d3dCompile
+ :: Ptr () -> Word32 -> CString ->
+    Ptr D3DShaderMacro -> Ptr ID3DInclude ->
+    CString -> CString -> D3DCompileFlag -> D3DCompileEffectFlag ->
+    Ptr (Ptr ID3DBlob) -> Ptr (Ptr ID3DBlob) -> IO HRESULT
+
+maybePoke :: (Storable a) => Maybe a -> (Ptr a -> IO b) -> IO b
+maybePoke Nothing proc = proc nullPtr
+maybePoke (Just m) proc = alloca $ \ptr -> do
+  poke ptr m
+  proc ptr
+
+maybeWithCString :: Maybe String -> (CString -> IO a) -> IO a
+maybeWithCString Nothing proc = proc nullPtr
+maybeWithCString (Just m) proc = withCString m proc
+
+type HRESULT = LONG
+data ID3DBlob = ID3DBlob
+data ID3DInclude = ID3DInclue
+type LONG = Int32
+
+data D3DShaderMacro = D3DShaderMacro
+  { _name :: String
+  , _definition :: String }
+
+instance Storable D3DShaderMacro where
+  sizeOf _ = 8
+  alignment _ = 8
+  peek ptr = do
+    n <- peekByteOff ptr 0
+    d <- peekByteOff ptr 4
+    n' <- peekCString n
+    d' <- peekCString d
+    return $ D3DShaderMacro n' d'
+  poke ptr (D3DShaderMacro n d) = do
+    withCString n $ \n' -> withCString d $ \d' -> do
+      pokeByteOff ptr 0 n'
+      pokeByteOff ptr 4 d'
+
+type D3DCompileFlag = Word32
+type D3DCompileEffectFlag = Word32
+
+d3dCompileEnableStrictness :: D3DCompileFlag
+d3dCompileEnableStrictness = shift 1 11
+
+d3dCompile
+  :: String -> Maybe String ->
+     Maybe D3DShaderMacro -> Ptr ID3DInclude ->
+     Maybe String -> String ->
+     [D3DCompileFlag] -> [D3DCompileEffectFlag] ->
+     IO (Either (HRESULT, Ptr ID3DBlob) (Ptr ID3DBlob))
+d3dCompile source sourceName defines pInclude entryPoint target compileFlags effectFlags = do
+  withCStringLen source $ \(csource, len) -> withCString target $ \pTarget ->
+    maybeWithCString sourceName $ \pSourceName -> maybePoke defines $ \pDefines ->
+      maybeWithCString entryPoint $ \pEntryPoint -> alloca $ \ppCode -> alloca $ \ppErrorMsgs -> do
+        let sFlag = foldl (.|.) 0 compileFlags
+        let eFlag = foldl (.|.) 0 effectFlags
+        putStrLn "Before d3dCompile"
+        hr <- c_d3dCompile
+                (castPtr csource)
+                (fromIntegral len)
+                pSourceName
+                pDefines
+                pInclude
+                pEntryPoint
+                pTarget
+                sFlag
+                eFlag
+                ppCode
+                ppErrorMsgs
+        putStrLn "After d3dCompile"
+        if hr < 0
+        then do
+          pErrorMsgs <- peek ppErrorMsgs
+          return $ Left (hr, pErrorMsgs)
+        else do
+          pCode <- peek ppCode
+          return $ Right pCode
+
+d3dCompileFromFile
+  :: String -> Maybe String ->
+     Maybe D3DShaderMacro -> Ptr ID3DInclude ->
+     Maybe String -> String ->
+     [D3DCompileFlag] -> [D3DCompileEffectFlag] ->
+     IO (Either (HRESULT, Ptr ID3DBlob) (Ptr ID3DBlob))
+d3dCompileFromFile fileName sourceName defines pInclude entryPoint target compileFlags effectFlags =
+  withFile fileName ReadMode $ \handle -> do
+    contents <- hGetContents handle
+    d3dCompile contents sourceName defines pInclude entryPoint target compileFlags effectFlags
+
+main :: IO ()
+main = do
+  _vb <- compileShaderFromFile "Triangle.fx" "VS" "vs_4_0"
+  return ()
+
+compileShaderFromFile :: String -> String -> String -> IO (Ptr ID3DBlob)
+compileShaderFromFile fileName entryPoint shaderModel = do
+  Right res <- d3dCompileFromFile
+      fileName
+      Nothing
+      Nothing
+      nullPtr
+      (Just entryPoint)
+      shaderModel
+      [d3dCompileEnableStrictness]
+      []
+  return res
diff --git a/testsuite/tests/ghci/linking/dyn/T13606.stdout b/testsuite/tests/ghci/linking/dyn/T13606.stdout
new file mode 100644 (file)
index 0000000..baf6b87
--- /dev/null
@@ -0,0 +1,2 @@
+Before d3dCompile
+After d3dCompile
diff --git a/testsuite/tests/ghci/linking/dyn/Triangle.fx b/testsuite/tests/ghci/linking/dyn/Triangle.fx
new file mode 100644 (file)
index 0000000..0cef7a1
--- /dev/null
@@ -0,0 +1,10 @@
+float4 VS( float4 Pos : POSITION ) : SV_POSITION
+{
+    return Pos;
+}
+
+float4 PS( float4 Pos : SV_POSITION ) : SV_Target
+{
+    return float4( 1.0f, 1.0f, 0.0f, 1.0f );    // Yellow, with Alpha = 1
+}
+
index 4710959..5da2d61 100644 (file)
@@ -38,3 +38,7 @@ test('T11072gcc', [extra_files(['A.c', 'T11072.hs']),
 test('T11072msvc', [extra_files(['A.c', 'T11072.hs', 'libAS.def', 'i686/', 'x86_64/']),
                     unless(doing_ghci, skip), unless(opsys('mingw32'), skip)],
      run_command, ['$MAKE -s --no-print-directory compile_libAS_impl_msvc'])
+
+test('T13606', [extra_files(['Triangle.fx']),
+                    unless(doing_ghci, skip), unless(opsys('mingw32'), skip)],
+     run_command, ['$MAKE -s --no-print-directory T13606'])