summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTamar Christina <tamar@zhox.com>2017-06-02 11:47:57 -0400
committerBen Gamari <ben@smart-cactus.org>2017-06-02 12:27:45 -0400
commit93489cd3b4c1b0d17506a12a9b964c0082ddb7a8 (patch)
tree3255cbf5caa2c71e094e9e8655c9f38d5da734c5
parent5164cce20bc6f09f55cf5c4d1797b72b7e85b176 (diff)
downloadhaskell-93489cd3b4c1b0d17506a12a9b964c0082ddb7a8.tar.gz
Better import library support for Windows
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
-rw-r--r--docs/users_guide/8.4.1-notes.rst4
-rw-r--r--rts/Linker.c5
-rw-r--r--rts/LinkerInternals.h14
-rw-r--r--rts/RtsSymbolInfo.c113
-rw-r--r--rts/RtsSymbolInfo.h23
-rw-r--r--rts/linker/LoadArchive.c26
-rw-r--r--rts/linker/PEi386.c310
-rw-r--r--rts/linker/PEi386.h5
-rw-r--r--testsuite/tests/ghci/linking/dyn/Makefile4
-rw-r--r--testsuite/tests/ghci/linking/dyn/T13606.hs128
-rw-r--r--testsuite/tests/ghci/linking/dyn/T13606.stdout2
-rw-r--r--testsuite/tests/ghci/linking/dyn/Triangle.fx10
-rw-r--r--testsuite/tests/ghci/linking/dyn/all.T4
13 files changed, 498 insertions, 150 deletions
diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst
index 62173d547c..72d6901d18 100644
--- a/docs/users_guide/8.4.1-notes.rst
+++ b/docs/users_guide/8.4.1-notes.rst
@@ -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
~~~~~~~~~~~~~~~~
diff --git a/rts/Linker.c b/rts/Linker.c
index 65caf89f6e..6e710a1431 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -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");
diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
index b8c411d22a..48c43ebbbe 100644
--- a/rts/LinkerInternals.h
+++ b/rts/LinkerInternals.h
@@ -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
diff --git a/rts/RtsSymbolInfo.c b/rts/RtsSymbolInfo.c
index 6688d9c9ba..0553308f36 100644
--- a/rts/RtsSymbolInfo.c
+++ b/rts/RtsSymbolInfo.c
@@ -15,31 +15,79 @@
#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);
}
diff --git a/rts/RtsSymbolInfo.h b/rts/RtsSymbolInfo.h
index 1f3d35e5ef..9873ff3481 100644
--- a/rts/RtsSymbolInfo.h
+++ b/rts/RtsSymbolInfo.h
@@ -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);
diff --git a/rts/linker/LoadArchive.c b/rts/linker/LoadArchive.c
index 06a143e056..3c4bd44a28 100644
--- a/rts/linker/LoadArchive.c
+++ b/rts/linker/LoadArchive.c
@@ -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) {
diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c
index 809840028e..5301eb1964 100644
--- a/rts/linker/PEi386.c
+++ b/rts/linker/PEi386.c
@@ -41,6 +41,74 @@
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);
}
diff --git a/rts/linker/PEi386.h b/rts/linker/PEi386.h
index 29ef6ec906..44f280fdb3 100644
--- a/rts/linker/PEi386.h
+++ b/rts/linker/PEi386.h
@@ -15,10 +15,9 @@
#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 *
diff --git a/testsuite/tests/ghci/linking/dyn/Makefile b/testsuite/tests/ghci/linking/dyn/Makefile
index fd954bfa55..63b16905c9 100644
--- a/testsuite/tests/ghci/linking/dyn/Makefile
+++ b/testsuite/tests/ghci/linking/dyn/Makefile
@@ -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
index 0000000000..3bce51a761
--- /dev/null
+++ b/testsuite/tests/ghci/linking/dyn/T13606.hs
@@ -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
index 0000000000..baf6b87f26
--- /dev/null
+++ b/testsuite/tests/ghci/linking/dyn/T13606.stdout
@@ -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
index 0000000000..0cef7a1e0f
--- /dev/null
+++ b/testsuite/tests/ghci/linking/dyn/Triangle.fx
@@ -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
+}
+
diff --git a/testsuite/tests/ghci/linking/dyn/all.T b/testsuite/tests/ghci/linking/dyn/all.T
index 4710959d0f..5da2d61927 100644
--- a/testsuite/tests/ghci/linking/dyn/all.T
+++ b/testsuite/tests/ghci/linking/dyn/all.T
@@ -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'])