summaryrefslogtreecommitdiff
path: root/rts
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2016-10-27 09:47:55 +0100
committerMatthew Pickering <matthewtpickering@gmail.com>2016-10-27 09:47:55 +0100
commitcc29eb54fc85c464e97a87e941231c6b1d114191 (patch)
tree3ebf86d2c2a75d14099b130d4349de0fa0c2b9a7 /rts
parent0eb893444cd6893e77dbfc5f6828827e02e5e55a (diff)
downloadhaskell-cc29eb54fc85c464e97a87e941231c6b1d114191.tar.gz
Revert "rts/linker: Move loadArchive to new source file"
This reverts commit 488a9ed3440fe882ae043ba7f44fed4e84e679ce.
Diffstat (limited to 'rts')
-rw-r--r--rts/Linker.c658
-rw-r--r--rts/LinkerInternals.h7
-rw-r--r--rts/linker/LoadArchive.c661
3 files changed, 655 insertions, 671 deletions
diff --git a/rts/Linker.c b/rts/Linker.c
index 45c787b1fc..7600ba824e 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -224,6 +224,13 @@ Mutex linker_unloaded_mutex;
/* Type of the initializer */
typedef void (*init_t) (int argc, char **argv, char **env);
+static HsInt isAlreadyLoaded( pathchar *path );
+static HsInt loadOc( ObjectCode* oc );
+static ObjectCode* mkOc( pathchar *path, char *image, int imageSize,
+ rtsBool mapped, char *archiveMemberName,
+ int misalignment
+ );
+
/* Generic wrapper function to try and Resolve and RunInit oc files */
int ocTryLoad( ObjectCode* oc );
@@ -1639,7 +1646,7 @@ static void setOcInitialStatus(ObjectCode* oc) {
}
}
-ObjectCode*
+static ObjectCode*
mkOc( pathchar *path, char *image, int imageSize,
rtsBool mapped, char *archiveMemberName, int misalignment ) {
ObjectCode* oc;
@@ -1696,7 +1703,8 @@ mkOc( pathchar *path, char *image, int imageSize,
*
* Returns: 1 if the path is already loaded, 0 otherwise.
*/
-HsInt isAlreadyLoaded( pathchar *path )
+static HsInt
+isAlreadyLoaded( pathchar *path )
{
ObjectCode *o;
for (o = objects; o; o = o->next) {
@@ -1707,6 +1715,522 @@ HsInt isAlreadyLoaded( pathchar *path )
return 0; /* not loaded yet */
}
+static HsInt loadArchive_ (pathchar *path)
+{
+ ObjectCode* oc;
+ char *image;
+ int memberSize;
+ FILE *f;
+ int n;
+ size_t thisFileNameSize;
+ char *fileName;
+ size_t fileNameSize;
+ int isObject, isGnuIndex, isThin, isImportLib;
+ char tmp[20];
+ char *gnuFileIndex;
+ int gnuFileIndexSize;
+#if defined(darwin_HOST_OS)
+ int i;
+ uint32_t nfat_arch, nfat_offset, cputype, cpusubtype;
+#if defined(i386_HOST_ARCH)
+ const uint32_t mycputype = CPU_TYPE_X86;
+ const uint32_t mycpusubtype = CPU_SUBTYPE_X86_ALL;
+#elif defined(x86_64_HOST_ARCH)
+ const uint32_t mycputype = CPU_TYPE_X86_64;
+ const uint32_t mycpusubtype = CPU_SUBTYPE_X86_64_ALL;
+#elif defined(powerpc_HOST_ARCH)
+ const uint32_t mycputype = CPU_TYPE_POWERPC;
+ const uint32_t mycpusubtype = CPU_SUBTYPE_POWERPC_ALL;
+#elif defined(powerpc64_HOST_ARCH)
+ const uint32_t mycputype = CPU_TYPE_POWERPC64;
+ const uint32_t mycpusubtype = CPU_SUBTYPE_POWERPC_ALL;
+#else
+#error Unknown Darwin architecture
+#endif
+#endif
+ int misalignment = 0;
+
+ /* TODO: don't call barf() on error, instead return an error code, freeing
+ * all resources correctly. This function is pretty complex, so it needs
+ * to be refactored to make this practical. */
+
+ IF_DEBUG(linker, debugBelch("loadArchive: start\n"));
+ IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%" PATH_FMT" '\n", path));
+
+ /* Check that we haven't already loaded this archive.
+ Ignore requests to load multiple times */
+ if (isAlreadyLoaded(path)) {
+ IF_DEBUG(linker,
+ debugBelch("ignoring repeated load of %" PATH_FMT "\n", path));
+ return 1; /* success */
+ }
+
+ gnuFileIndex = NULL;
+ gnuFileIndexSize = 0;
+
+ fileNameSize = 32;
+ fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)");
+
+ isThin = 0;
+ isImportLib = 0;
+
+ f = pathopen(path, WSTR("rb"));
+ if (!f)
+ barf("loadObj: can't read `%" PATH_FMT "'", path);
+
+ /* Check if this is an archive by looking for the magic "!<arch>\n"
+ * string. Usually, if this fails, we barf and quit. On Darwin however,
+ * we may have a fat archive, which contains archives for more than
+ * one architecture. Fat archives start with the magic number 0xcafebabe,
+ * always stored big endian. If we find a fat_header, we scan through
+ * the fat_arch structs, searching through for one for our host
+ * architecture. If a matching struct is found, we read the offset
+ * of our archive data (nfat_offset) and seek forward nfat_offset bytes
+ * from the start of the file.
+ *
+ * A subtlety is that all of the members of the fat_header and fat_arch
+ * structs are stored big endian, so we need to call byte order
+ * conversion functions.
+ *
+ * If we find the appropriate architecture in a fat archive, we gobble
+ * its magic "!<arch>\n" string and continue processing just as if
+ * we had a single architecture archive.
+ */
+
+ n = fread ( tmp, 1, 8, f );
+ if (n != 8)
+ barf("loadArchive: Failed reading header from `%" PATH_FMT "'", path);
+ if (strncmp(tmp, "!<arch>\n", 8) == 0) {}
+ /* Check if this is a thin archive by looking for the magic string "!<thin>\n"
+ *
+ * ar thin libraries have the exact same format as normal archives except they
+ * have a different magic string and they don't copy the object files into the
+ * archive.
+ *
+ * Instead each header entry points to the location of the object file on disk.
+ * This is useful when a library is only created to satisfy a compile time dependency
+ * instead of to be distributed. This saves the time required for copying.
+ *
+ * Thin archives are always flattened. They always only contain simple headers
+ * pointing to the object file and so we need not allocate more memory than needed
+ * to find the object file.
+ *
+ */
+ else if (strncmp(tmp, "!<thin>\n", 8) == 0) {
+ isThin = 1;
+ }
+#if defined(darwin_HOST_OS)
+ /* Not a standard archive, look for a fat archive magic number: */
+ else if (ntohl(*(uint32_t *)tmp) == FAT_MAGIC) {
+ nfat_arch = ntohl(*(uint32_t *)(tmp + 4));
+ IF_DEBUG(linker, debugBelch("loadArchive: found a fat archive containing %d architectures\n", nfat_arch));
+ nfat_offset = 0;
+
+ for (i = 0; i < (int)nfat_arch; i++) {
+ /* search for the right arch */
+ n = fread( tmp, 1, 20, f );
+ if (n != 8)
+ barf("loadArchive: Failed reading arch from `%s'", path);
+ cputype = ntohl(*(uint32_t *)tmp);
+ cpusubtype = ntohl(*(uint32_t *)(tmp + 4));
+
+ if (cputype == mycputype && cpusubtype == mycpusubtype) {
+ IF_DEBUG(linker, debugBelch("loadArchive: found my archive in a fat archive\n"));
+ nfat_offset = ntohl(*(uint32_t *)(tmp + 8));
+ break;
+ }
+ }
+
+ if (nfat_offset == 0) {
+ barf ("loadArchive: searched %d architectures, but no host arch found", (int)nfat_arch);
+ }
+ else {
+ n = fseek( f, nfat_offset, SEEK_SET );
+ if (n != 0)
+ barf("loadArchive: Failed to seek to arch in `%s'", path);
+ n = fread ( tmp, 1, 8, f );
+ if (n != 8)
+ barf("loadArchive: Failed reading header from `%s'", path);
+ if (strncmp(tmp, "!<arch>\n", 8) != 0) {
+ barf("loadArchive: couldn't find archive in `%s' at offset %d", path, nfat_offset);
+ }
+ }
+ }
+ else {
+ barf("loadArchive: Neither an archive, nor a fat archive: `%s'", path);
+ }
+#else
+ else {
+ barf("loadArchive: Not an archive: `%" PATH_FMT "'", path);
+ }
+#endif
+
+ IF_DEBUG(linker, debugBelch("loadArchive: loading archive contents\n"));
+
+ while (1) {
+ IF_DEBUG(linker, debugBelch("loadArchive: reading at %ld\n", ftell(f)));
+ n = fread ( fileName, 1, 16, f );
+ if (n != 16) {
+ if (feof(f)) {
+ IF_DEBUG(linker, debugBelch("loadArchive: EOF while reading from '%" PATH_FMT "'\n", path));
+ break;
+ }
+ else {
+ barf("loadArchive: Failed reading file name from `%" PATH_FMT "'", path);
+ }
+ }
+
+#if defined(darwin_HOST_OS)
+ if (strncmp(fileName, "!<arch>\n", 8) == 0) {
+ IF_DEBUG(linker, debugBelch("loadArchive: found the start of another archive, breaking\n"));
+ break;
+ }
+#endif
+
+ n = fread ( tmp, 1, 12, f );
+ if (n != 12)
+ barf("loadArchive: Failed reading mod time from `%" PATH_FMT "'", path);
+ n = fread ( tmp, 1, 6, f );
+ if (n != 6)
+ barf("loadArchive: Failed reading owner from `%" PATH_FMT "'", path);
+ n = fread ( tmp, 1, 6, f );
+ if (n != 6)
+ barf("loadArchive: Failed reading group from `%" PATH_FMT "'", path);
+ n = fread ( tmp, 1, 8, f );
+ if (n != 8)
+ barf("loadArchive: Failed reading mode from `%" PATH_FMT "'", path);
+ n = fread ( tmp, 1, 10, f );
+ if (n != 10)
+ barf("loadArchive: Failed reading size from `%" PATH_FMT "'", path);
+ tmp[10] = '\0';
+ for (n = 0; isdigit(tmp[n]); n++);
+ tmp[n] = '\0';
+ memberSize = atoi(tmp);
+
+ IF_DEBUG(linker, debugBelch("loadArchive: size of this archive member is %d\n", memberSize));
+ n = fread ( tmp, 1, 2, f );
+ if (n != 2)
+ barf("loadArchive: Failed reading magic from `%" PATH_FMT "'", path);
+ if (strncmp(tmp, "\x60\x0A", 2) != 0)
+ barf("loadArchive: Failed reading magic from `%" PATH_FMT "' at %ld. Got %c%c",
+ path, ftell(f), tmp[0], tmp[1]);
+
+ isGnuIndex = 0;
+ /* Check for BSD-variant large filenames */
+ if (0 == strncmp(fileName, "#1/", 3)) {
+ fileName[16] = '\0';
+ if (isdigit(fileName[3])) {
+ for (n = 4; isdigit(fileName[n]); n++);
+ fileName[n] = '\0';
+ thisFileNameSize = atoi(fileName + 3);
+ memberSize -= thisFileNameSize;
+ if (thisFileNameSize >= fileNameSize) {
+ /* Double it to avoid potentially continually
+ increasing it by 1 */
+ fileNameSize = thisFileNameSize * 2;
+ fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
+ }
+ n = fread ( fileName, 1, thisFileNameSize, f );
+ if (n != (int)thisFileNameSize) {
+ barf("loadArchive: Failed reading filename from `%" PATH_FMT "'",
+ path);
+ }
+ fileName[thisFileNameSize] = 0;
+
+ /* On OS X at least, thisFileNameSize is the size of the
+ fileName field, not the length of the fileName
+ itself. */
+ thisFileNameSize = strlen(fileName);
+ }
+ else {
+ barf("loadArchive: BSD-variant filename size not found while reading filename from `%s'", path);
+ }
+ }
+ /* Check for GNU file index file */
+ else if (0 == strncmp(fileName, "//", 2)) {
+ fileName[0] = '\0';
+ thisFileNameSize = 0;
+ isGnuIndex = 1;
+ }
+ /* Check for a file in the GNU file index */
+ else if (fileName[0] == '/') {
+ if (isdigit(fileName[1])) {
+ int i;
+
+ for (n = 2; isdigit(fileName[n]); n++);
+ fileName[n] = '\0';
+ n = atoi(fileName + 1);
+
+ if (gnuFileIndex == NULL) {
+ barf("loadArchive: GNU-variant filename without an index while reading from `%s'", path);
+ }
+ if (n < 0 || n > gnuFileIndexSize) {
+ barf("loadArchive: GNU-variant filename offset %d out of range [0..%d] while reading filename from `%s'", n, gnuFileIndexSize, path);
+ }
+ if (n != 0 && gnuFileIndex[n - 1] != '\n') {
+ barf("loadArchive: GNU-variant filename offset %d invalid (range [0..%d]) while reading filename from `%s'", n, gnuFileIndexSize, path);
+ }
+ for (i = n; gnuFileIndex[i] != '\n'; i++);
+ thisFileNameSize = i - n - 1;
+ if (thisFileNameSize >= fileNameSize) {
+ /* Double it to avoid potentially continually
+ increasing it by 1 */
+ fileNameSize = thisFileNameSize * 2;
+ fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
+ }
+ memcpy(fileName, gnuFileIndex + n, thisFileNameSize);
+ fileName[thisFileNameSize] = '\0';
+ }
+ else if (fileName[1] == ' ') {
+ fileName[0] = '\0';
+ thisFileNameSize = 0;
+ }
+ else {
+ barf("loadArchive: GNU-variant filename offset not found while reading filename from `%s'", path);
+ }
+ }
+ /* Finally, the case where the filename field actually contains
+ the filename */
+ else {
+ /* GNU ar terminates filenames with a '/', this allowing
+ spaces in filenames. So first look to see if there is a
+ terminating '/'. */
+ for (thisFileNameSize = 0;
+ thisFileNameSize < 16;
+ thisFileNameSize++) {
+ if (fileName[thisFileNameSize] == '/') {
+ fileName[thisFileNameSize] = '\0';
+ break;
+ }
+ }
+ /* If we didn't find a '/', then a space teminates the
+ filename. Note that if we don't find one, then
+ thisFileNameSize ends up as 16, and we already have the
+ '\0' at the end. */
+ if (thisFileNameSize == 16) {
+ for (thisFileNameSize = 0;
+ thisFileNameSize < 16;
+ thisFileNameSize++) {
+ if (fileName[thisFileNameSize] == ' ') {
+ fileName[thisFileNameSize] = '\0';
+ break;
+ }
+ }
+ }
+ }
+
+ IF_DEBUG(linker,
+ debugBelch("loadArchive: Found member file `%s'\n", fileName));
+
+ isObject = (thisFileNameSize >= 2 && strncmp(fileName + thisFileNameSize - 2, ".o" , 2) == 0)
+ || (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".p_o", 4) == 0);
+
+#if defined(OBJFORMAT_PEi386)
+ /*
+ * Note [MSVC import files (ext .lib)]
+ * MSVC compilers store the object files in
+ * the import libraries with extension .dll
+ * so on Windows we should look for those too.
+ * The PE COFF format doesn't specify any specific file name
+ * for sections. So on windows, just try to load it all.
+ *
+ * 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
+
+ IF_DEBUG(linker, debugBelch("loadArchive: \tthisFileNameSize = %d\n", (int)thisFileNameSize));
+ IF_DEBUG(linker, debugBelch("loadArchive: \tisObject = %d\n", isObject));
+
+ if (isObject) {
+ char *archiveMemberName;
+
+ IF_DEBUG(linker, debugBelch("loadArchive: Member is an object file...loading...\n"));
+
+#if defined(mingw32_HOST_OS)
+ // TODO: We would like to use allocateExec here, but allocateExec
+ // cannot currently allocate blocks large enough.
+ image = allocateImageAndTrampolines(path, fileName, f, memberSize,
+ isThin);
+#elif defined(darwin_HOST_OS)
+ if (RTS_LINKER_USE_MMAP)
+ image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1, 0);
+ else {
+ /* See loadObj() */
+ misalignment = machoGetMisalignment(f);
+ image = stgMallocBytes(memberSize + misalignment,
+ "loadArchive(image)");
+ image += misalignment;
+ }
+
+#else // not windows or darwin
+ image = stgMallocBytes(memberSize, "loadArchive(image)");
+#endif
+ if (isThin) {
+ FILE *member;
+ pathchar *pathCopy, *dirName, *memberPath, *objFileName;
+
+ /* Allocate and setup the dirname of the archive. We'll need
+ this to locate the thin member */
+ pathCopy = pathdup(path); // Convert the char* to a pathchar*
+ dirName = pathdir(pathCopy);
+
+ /* Append the relative member name to the dirname. This should be
+ be the full path to the actual thin member. */
+ int memberLen = pathlen(dirName) + 1 + strlen(fileName) + 1;
+ memberPath = stgMallocBytes(pathsize * memberLen, "loadArchive(file)");
+ objFileName = mkPath(fileName);
+ pathprintf(memberPath, memberLen, WSTR("%" PATH_FMT "%" PATH_FMT), dirName, objFileName);
+ stgFree(objFileName);
+ stgFree(dirName);
+
+ member = pathopen(memberPath, WSTR("rb"));
+ if (!member)
+ barf("loadObj: can't read thin archive `%" PATH_FMT "'", memberPath);
+
+ n = fread ( image, 1, memberSize, member );
+ if (n != memberSize) {
+ barf("loadArchive: error whilst reading `%s'", fileName);
+ }
+
+ fclose(member);
+ stgFree(memberPath);
+ stgFree(pathCopy);
+ }
+ else
+ {
+ n = fread ( image, 1, memberSize, f );
+ if (n != memberSize) {
+ barf("loadArchive: error whilst reading `%" PATH_FMT "'", path);
+ }
+ }
+
+ archiveMemberName = stgMallocBytes(pathlen(path) + thisFileNameSize + 3,
+ "loadArchive(file)");
+ sprintf(archiveMemberName, "%" PATH_FMT "(%.*s)",
+ path, (int)thisFileNameSize, fileName);
+
+ oc = mkOc(path, image, memberSize, rtsFalse, archiveMemberName
+ , misalignment);
+
+ stgFree(archiveMemberName);
+
+ if (0 == loadOc(oc)) {
+ stgFree(fileName);
+ 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
+ }
+ }
+ else if (isGnuIndex) {
+ if (gnuFileIndex != NULL) {
+ barf("loadArchive: GNU-variant index found, but already have an index, while reading filename from `%s'", path);
+ }
+ IF_DEBUG(linker, debugBelch("loadArchive: Found GNU-variant file index\n"));
+#if RTS_LINKER_USE_MMAP
+ gnuFileIndex = mmapForLinker(memberSize + 1, MAP_ANONYMOUS, -1, 0);
+#else
+ gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)");
+#endif
+ n = fread ( gnuFileIndex, 1, memberSize, f );
+ if (n != memberSize) {
+ barf("loadArchive: error whilst reading `%" PATH_FMT "'", path);
+ }
+ gnuFileIndex[memberSize] = '/';
+ gnuFileIndexSize = memberSize;
+ }
+ else if (isImportLib) {
+#if defined(OBJFORMAT_PEi386)
+ if (checkAndLoadImportLibrary(path, fileName, f)) {
+ IF_DEBUG(linker, debugBelch("loadArchive: Member is an import file section... Corresponding DLL has been loaded...\n"));
+ }
+ else {
+ IF_DEBUG(linker, debugBelch("loadArchive: Member is not a valid import file section... Skipping...\n"));
+ n = fseek(f, memberSize, SEEK_CUR);
+ if (n != 0)
+ barf("loadArchive: error whilst seeking by %d in `%" PATH_FMT "'",
+ memberSize, path);
+ }
+#endif
+ }
+ else {
+ IF_DEBUG(linker, debugBelch("loadArchive: '%s' does not appear to be an object file\n", fileName));
+ if (!isThin || thisFileNameSize == 0) {
+ n = fseek(f, memberSize, SEEK_CUR);
+ if (n != 0)
+ barf("loadArchive: error whilst seeking by %d in `%" PATH_FMT "'",
+ memberSize, path);
+ }
+ }
+
+ /* .ar files are 2-byte aligned */
+ if (!(isThin && thisFileNameSize > 0) && memberSize % 2) {
+ IF_DEBUG(linker, debugBelch("loadArchive: trying to read one pad byte\n"));
+ n = fread ( tmp, 1, 1, f );
+ if (n != 1) {
+ if (feof(f)) {
+ IF_DEBUG(linker, debugBelch("loadArchive: found EOF while reading one pad byte\n"));
+ break;
+ }
+ else {
+ barf("loadArchive: Failed reading padding from `%" PATH_FMT "'", path);
+ }
+ }
+ IF_DEBUG(linker, debugBelch("loadArchive: successfully read one pad byte\n"));
+ }
+ IF_DEBUG(linker, debugBelch("loadArchive: reached end of archive loading while loop\n"));
+ }
+
+ fclose(f);
+
+ stgFree(fileName);
+ if (gnuFileIndex != NULL) {
+#if RTS_LINKER_USE_MMAP
+ munmap(gnuFileIndex, gnuFileIndexSize + 1);
+#else
+ stgFree(gnuFileIndex);
+#endif
+ }
+
+ if (RTS_LINKER_USE_MMAP)
+ m32_allocator_flush();
+
+ IF_DEBUG(linker, debugBelch("loadArchive: done\n"));
+ return 1;
+}
+
+HsInt loadArchive (pathchar *path)
+{
+ ACQUIRE_LOCK(&linker_mutex);
+ HsInt r = loadArchive_(path);
+ RELEASE_LOCK(&linker_mutex);
+ return r;
+}
+
//
// Load the object file into memory. This will not be its final resting place,
// as on 64-bit platforms we need to map its segments into the low 2Gb of the
@@ -1855,7 +2379,7 @@ HsInt loadObj (pathchar *path)
return r;
}
-HsInt loadOc (ObjectCode* oc)
+static HsInt loadOc (ObjectCode* oc)
{
int r;
@@ -2534,6 +3058,134 @@ allocateImageAndTrampolines (
return image + PEi386_IMAGE_OFFSET;
}
+static int findAndLoadImportLibrary(ObjectCode* oc)
+{
+ int i;
+
+ COFF_header* hdr;
+ COFF_section* sectab;
+ COFF_symbol* symtab;
+ UChar* strtab;
+
+ hdr = (COFF_header*)(oc->image);
+ sectab = (COFF_section*)(
+ ((UChar*)(oc->image))
+ + sizeof_COFF_header + hdr->SizeOfOptionalHeader
+ );
+
+ symtab = (COFF_symbol*)(
+ ((UChar*)(oc->image))
+ + hdr->PointerToSymbolTable
+ );
+
+ strtab = ((UChar*)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 0;
+ }
+
+ break;
+ }
+
+ stgFree(secname);
+ }
+
+ return 1;
+}
+
+static int checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f)
+{
+ char* image;
+ static HsBool load_dll_warn = HS_BOOL_FALSE;
+
+ if (load_dll_warn) { return 0; }
+
+ /* Based on Import Library specification. PE Spec section 7.1 */
+
+ COFF_import_header hdr;
+ size_t n;
+
+ n = fread(&hdr, 1, sizeof_COFF_import_Header, f);
+ if (n != sizeof(COFF_header)) {
+ errorBelch("getNumberOfSymbols: error whilst reading `%s' header in `%" PATH_FMT "'\n",
+ member_name, arch_name);
+ return 0;
+ }
+
+ if (hdr.Sig1 != 0x0 || hdr.Sig2 != 0xFFFF) {
+ fseek(f, -sizeof_COFF_import_Header, SEEK_CUR);
+ IF_DEBUG(linker, debugBelch("loadArchive: Object `%s` is not an import lib. Skipping...\n", member_name));
+ return 0;
+ }
+
+ IF_DEBUG(linker, debugBelch("loadArchive: reading %d bytes at %ld\n", hdr.SizeOfData, ftell(f)));
+
+ image = malloc(hdr.SizeOfData);
+ n = fread(image, 1, hdr.SizeOfData, f);
+ if (n != hdr.SizeOfData) {
+ errorBelch("loadArchive: error whilst reading `%s' header in `%" PATH_FMT "'. Did not read enough bytes.\n",
+ member_name, arch_name);
+ }
+
+ char* symbol = strtok(image, "\0");
+ int symLen = strlen(symbol) + 1;
+ int nameLen = n - symLen;
+ char* dllName = malloc(sizeof(char) * nameLen);
+ dllName = strncpy(dllName, image + symLen, nameLen);
+ pathchar* dll = malloc(sizeof(wchar_t) * nameLen);
+ mbstowcs(dll, dllName, nameLen);
+ free(dllName);
+
+ IF_DEBUG(linker, debugBelch("loadArchive: read symbol %s from lib `%ls'\n", symbol, dll));
+ const char* result = addDLL(dll);
+
+ free(image);
+
+ if (result != NULL) {
+ errorBelch("Could not load `%ls'. Reason: %s\n", dll, result);
+ load_dll_warn = HS_BOOL_TRUE;
+
+ free(dll);
+ fseek(f, -(n + sizeof_COFF_import_Header), SEEK_CUR);
+ return 0;
+ }
+
+ free(dll);
+ return 1;
+}
+
/* We use myindex to calculate array addresses, rather than
simply doing the normal subscript thing. That's because
some of the above structs have sizes which are not
diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
index ffbb9096de..729cf1d792 100644
--- a/rts/LinkerInternals.h
+++ b/rts/LinkerInternals.h
@@ -301,11 +301,4 @@ getting, here. */
#endif /* OBJFORMAT_PEi386 */
-HsInt isAlreadyLoaded( pathchar *path );
-HsInt loadOc( ObjectCode* oc );
-ObjectCode* mkOc( pathchar *path, char *image, int imageSize,
- rtsBool mapped, char *archiveMemberName,
- int misalignment
- );
-
#endif /* LINKERINTERNALS_H */
diff --git a/rts/linker/LoadArchive.c b/rts/linker/LoadArchive.c
deleted file mode 100644
index e1aebe5b9c..0000000000
--- a/rts/linker/LoadArchive.c
+++ /dev/null
@@ -1,661 +0,0 @@
-#include <string.h>
-#include <stddef.h>
-
-#include <Rts.h>
-
-#include "sm/Storage.h"
-#include "sm/OSMem.h"
-#include "RtsUtils.h"
-#include "PathUtils.h"
-#include "LinkerInternals.h"
-#include "linker/M32Alloc.h"
-
-#include <ctype.h>
-
-static HsInt loadArchive_ (pathchar *path)
-{
- ObjectCode* oc;
- char *image;
- int memberSize;
- FILE *f;
- int n;
- size_t thisFileNameSize;
- char *fileName;
- size_t fileNameSize;
- int isObject, isGnuIndex, isThin, isImportLib;
- char tmp[20];
- char *gnuFileIndex;
- int gnuFileIndexSize;
-#if defined(darwin_HOST_OS)
- int i;
- uint32_t nfat_arch, nfat_offset, cputype, cpusubtype;
-#if defined(i386_HOST_ARCH)
- const uint32_t mycputype = CPU_TYPE_X86;
- const uint32_t mycpusubtype = CPU_SUBTYPE_X86_ALL;
-#elif defined(x86_64_HOST_ARCH)
- const uint32_t mycputype = CPU_TYPE_X86_64;
- const uint32_t mycpusubtype = CPU_SUBTYPE_X86_64_ALL;
-#elif defined(powerpc_HOST_ARCH)
- const uint32_t mycputype = CPU_TYPE_POWERPC;
- const uint32_t mycpusubtype = CPU_SUBTYPE_POWERPC_ALL;
-#elif defined(powerpc64_HOST_ARCH)
- const uint32_t mycputype = CPU_TYPE_POWERPC64;
- const uint32_t mycpusubtype = CPU_SUBTYPE_POWERPC_ALL;
-#else
-#error Unknown Darwin architecture
-#endif
-#endif
- int misalignment = 0;
-
- /* TODO: don't call barf() on error, instead return an error code, freeing
- * all resources correctly. This function is pretty complex, so it needs
- * to be refactored to make this practical. */
-
- IF_DEBUG(linker, debugBelch("loadArchive: start\n"));
- IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%" PATH_FMT" '\n", path));
-
- /* Check that we haven't already loaded this archive.
- Ignore requests to load multiple times */
- if (isAlreadyLoaded(path)) {
- IF_DEBUG(linker,
- debugBelch("ignoring repeated load of %" PATH_FMT "\n", path));
- return 1; /* success */
- }
-
- gnuFileIndex = NULL;
- gnuFileIndexSize = 0;
-
- fileNameSize = 32;
- fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)");
-
- isThin = 0;
- isImportLib = 0;
-
- f = pathopen(path, WSTR("rb"));
- if (!f)
- barf("loadObj: can't read `%" PATH_FMT "'", path);
-
- /* Check if this is an archive by looking for the magic "!<arch>\n"
- * string. Usually, if this fails, we barf and quit. On Darwin however,
- * we may have a fat archive, which contains archives for more than
- * one architecture. Fat archives start with the magic number 0xcafebabe,
- * always stored big endian. If we find a fat_header, we scan through
- * the fat_arch structs, searching through for one for our host
- * architecture. If a matching struct is found, we read the offset
- * of our archive data (nfat_offset) and seek forward nfat_offset bytes
- * from the start of the file.
- *
- * A subtlety is that all of the members of the fat_header and fat_arch
- * structs are stored big endian, so we need to call byte order
- * conversion functions.
- *
- * If we find the appropriate architecture in a fat archive, we gobble
- * its magic "!<arch>\n" string and continue processing just as if
- * we had a single architecture archive.
- */
-
- n = fread ( tmp, 1, 8, f );
- if (n != 8)
- barf("loadArchive: Failed reading header from `%" PATH_FMT "'", path);
- if (strncmp(tmp, "!<arch>\n", 8) == 0) {}
- /* Check if this is a thin archive by looking for the magic string "!<thin>\n"
- *
- * ar thin libraries have the exact same format as normal archives except they
- * have a different magic string and they don't copy the object files into the
- * archive.
- *
- * Instead each header entry points to the location of the object file on disk.
- * This is useful when a library is only created to satisfy a compile time dependency
- * instead of to be distributed. This saves the time required for copying.
- *
- * Thin archives are always flattened. They always only contain simple headers
- * pointing to the object file and so we need not allocate more memory than needed
- * to find the object file.
- *
- */
- else if (strncmp(tmp, "!<thin>\n", 8) == 0) {
- isThin = 1;
- }
-#if defined(darwin_HOST_OS)
- /* Not a standard archive, look for a fat archive magic number: */
- else if (ntohl(*(uint32_t *)tmp) == FAT_MAGIC) {
- nfat_arch = ntohl(*(uint32_t *)(tmp + 4));
- IF_DEBUG(linker, debugBelch("loadArchive: found a fat archive containing %d architectures\n", nfat_arch));
- nfat_offset = 0;
-
- for (i = 0; i < (int)nfat_arch; i++) {
- /* search for the right arch */
- n = fread( tmp, 1, 20, f );
- if (n != 8)
- barf("loadArchive: Failed reading arch from `%s'", path);
- cputype = ntohl(*(uint32_t *)tmp);
- cpusubtype = ntohl(*(uint32_t *)(tmp + 4));
-
- if (cputype == mycputype && cpusubtype == mycpusubtype) {
- IF_DEBUG(linker, debugBelch("loadArchive: found my archive in a fat archive\n"));
- nfat_offset = ntohl(*(uint32_t *)(tmp + 8));
- break;
- }
- }
-
- if (nfat_offset == 0) {
- barf ("loadArchive: searched %d architectures, but no host arch found", (int)nfat_arch);
- }
- else {
- n = fseek( f, nfat_offset, SEEK_SET );
- if (n != 0)
- barf("loadArchive: Failed to seek to arch in `%s'", path);
- n = fread ( tmp, 1, 8, f );
- if (n != 8)
- barf("loadArchive: Failed reading header from `%s'", path);
- if (strncmp(tmp, "!<arch>\n", 8) != 0) {
- barf("loadArchive: couldn't find archive in `%s' at offset %d", path, nfat_offset);
- }
- }
- }
- else {
- barf("loadArchive: Neither an archive, nor a fat archive: `%s'", path);
- }
-#else
- else {
- barf("loadArchive: Not an archive: `%" PATH_FMT "'", path);
- }
-#endif
-
- IF_DEBUG(linker, debugBelch("loadArchive: loading archive contents\n"));
-
- while (1) {
- IF_DEBUG(linker, debugBelch("loadArchive: reading at %ld\n", ftell(f)));
- n = fread ( fileName, 1, 16, f );
- if (n != 16) {
- if (feof(f)) {
- IF_DEBUG(linker, debugBelch("loadArchive: EOF while reading from '%" PATH_FMT "'\n", path));
- break;
- }
- else {
- barf("loadArchive: Failed reading file name from `%" PATH_FMT "'", path);
- }
- }
-
-#if defined(darwin_HOST_OS)
- if (strncmp(fileName, "!<arch>\n", 8) == 0) {
- IF_DEBUG(linker, debugBelch("loadArchive: found the start of another archive, breaking\n"));
- break;
- }
-#endif
-
- n = fread ( tmp, 1, 12, f );
- if (n != 12)
- barf("loadArchive: Failed reading mod time from `%" PATH_FMT "'", path);
- n = fread ( tmp, 1, 6, f );
- if (n != 6)
- barf("loadArchive: Failed reading owner from `%" PATH_FMT "'", path);
- n = fread ( tmp, 1, 6, f );
- if (n != 6)
- barf("loadArchive: Failed reading group from `%" PATH_FMT "'", path);
- n = fread ( tmp, 1, 8, f );
- if (n != 8)
- barf("loadArchive: Failed reading mode from `%" PATH_FMT "'", path);
- n = fread ( tmp, 1, 10, f );
- if (n != 10)
- barf("loadArchive: Failed reading size from `%" PATH_FMT "'", path);
- tmp[10] = '\0';
- for (n = 0; isdigit(tmp[n]); n++);
- tmp[n] = '\0';
- memberSize = atoi(tmp);
-
- IF_DEBUG(linker, debugBelch("loadArchive: size of this archive member is %d\n", memberSize));
- n = fread ( tmp, 1, 2, f );
- if (n != 2)
- barf("loadArchive: Failed reading magic from `%" PATH_FMT "'", path);
- if (strncmp(tmp, "\x60\x0A", 2) != 0)
- barf("loadArchive: Failed reading magic from `%" PATH_FMT "' at %ld. Got %c%c",
- path, ftell(f), tmp[0], tmp[1]);
-
- isGnuIndex = 0;
- /* Check for BSD-variant large filenames */
- if (0 == strncmp(fileName, "#1/", 3)) {
- fileName[16] = '\0';
- if (isdigit(fileName[3])) {
- for (n = 4; isdigit(fileName[n]); n++);
- fileName[n] = '\0';
- thisFileNameSize = atoi(fileName + 3);
- memberSize -= thisFileNameSize;
- if (thisFileNameSize >= fileNameSize) {
- /* Double it to avoid potentially continually
- increasing it by 1 */
- fileNameSize = thisFileNameSize * 2;
- fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
- }
- n = fread ( fileName, 1, thisFileNameSize, f );
- if (n != (int)thisFileNameSize) {
- barf("loadArchive: Failed reading filename from `%" PATH_FMT "'",
- path);
- }
- fileName[thisFileNameSize] = 0;
-
- /* On OS X at least, thisFileNameSize is the size of the
- fileName field, not the length of the fileName
- itself. */
- thisFileNameSize = strlen(fileName);
- }
- else {
- barf("loadArchive: BSD-variant filename size not found while reading filename from `%s'", path);
- }
- }
- /* Check for GNU file index file */
- else if (0 == strncmp(fileName, "//", 2)) {
- fileName[0] = '\0';
- thisFileNameSize = 0;
- isGnuIndex = 1;
- }
- /* Check for a file in the GNU file index */
- else if (fileName[0] == '/') {
- if (isdigit(fileName[1])) {
- int i;
-
- for (n = 2; isdigit(fileName[n]); n++);
- fileName[n] = '\0';
- n = atoi(fileName + 1);
-
- if (gnuFileIndex == NULL) {
- barf("loadArchive: GNU-variant filename without an index while reading from `%s'", path);
- }
- if (n < 0 || n > gnuFileIndexSize) {
- barf("loadArchive: GNU-variant filename offset %d out of range [0..%d] while reading filename from `%s'", n, gnuFileIndexSize, path);
- }
- if (n != 0 && gnuFileIndex[n - 1] != '\n') {
- barf("loadArchive: GNU-variant filename offset %d invalid (range [0..%d]) while reading filename from `%s'", n, gnuFileIndexSize, path);
- }
- for (i = n; gnuFileIndex[i] != '\n'; i++);
- thisFileNameSize = i - n - 1;
- if (thisFileNameSize >= fileNameSize) {
- /* Double it to avoid potentially continually
- increasing it by 1 */
- fileNameSize = thisFileNameSize * 2;
- fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
- }
- memcpy(fileName, gnuFileIndex + n, thisFileNameSize);
- fileName[thisFileNameSize] = '\0';
- }
- else if (fileName[1] == ' ') {
- fileName[0] = '\0';
- thisFileNameSize = 0;
- }
- else {
- barf("loadArchive: GNU-variant filename offset not found while reading filename from `%s'", path);
- }
- }
- /* Finally, the case where the filename field actually contains
- the filename */
- else {
- /* GNU ar terminates filenames with a '/', this allowing
- spaces in filenames. So first look to see if there is a
- terminating '/'. */
- for (thisFileNameSize = 0;
- thisFileNameSize < 16;
- thisFileNameSize++) {
- if (fileName[thisFileNameSize] == '/') {
- fileName[thisFileNameSize] = '\0';
- break;
- }
- }
- /* If we didn't find a '/', then a space teminates the
- filename. Note that if we don't find one, then
- thisFileNameSize ends up as 16, and we already have the
- '\0' at the end. */
- if (thisFileNameSize == 16) {
- for (thisFileNameSize = 0;
- thisFileNameSize < 16;
- thisFileNameSize++) {
- if (fileName[thisFileNameSize] == ' ') {
- fileName[thisFileNameSize] = '\0';
- break;
- }
- }
- }
- }
-
- IF_DEBUG(linker,
- debugBelch("loadArchive: Found member file `%s'\n", fileName));
-
- isObject = (thisFileNameSize >= 2 && strncmp(fileName + thisFileNameSize - 2, ".o" , 2) == 0)
- || (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".p_o", 4) == 0);
-
-#if defined(OBJFORMAT_PEi386)
- /*
- * Note [MSVC import files (ext .lib)]
- * MSVC compilers store the object files in
- * the import libraries with extension .dll
- * so on Windows we should look for those too.
- * The PE COFF format doesn't specify any specific file name
- * for sections. So on windows, just try to load it all.
- *
- * 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
-
- IF_DEBUG(linker, debugBelch("loadArchive: \tthisFileNameSize = %d\n", (int)thisFileNameSize));
- IF_DEBUG(linker, debugBelch("loadArchive: \tisObject = %d\n", isObject));
-
- if (isObject) {
- char *archiveMemberName;
-
- IF_DEBUG(linker, debugBelch("loadArchive: Member is an object file...loading...\n"));
-
-#if defined(mingw32_HOST_OS)
- // TODO: We would like to use allocateExec here, but allocateExec
- // cannot currently allocate blocks large enough.
- image = allocateImageAndTrampolines(path, fileName, f, memberSize,
- isThin);
-#elif defined(darwin_HOST_OS)
- if (RTS_LINKER_USE_MMAP)
- image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1, 0);
- else {
- /* See loadObj() */
- misalignment = machoGetMisalignment(f);
- image = stgMallocBytes(memberSize + misalignment,
- "loadArchive(image)");
- image += misalignment;
- }
-
-#else // not windows or darwin
- image = stgMallocBytes(memberSize, "loadArchive(image)");
-#endif
- if (isThin) {
- FILE *member;
- pathchar *pathCopy, *dirName, *memberPath, *objFileName;
-
- /* Allocate and setup the dirname of the archive. We'll need
- this to locate the thin member */
- pathCopy = pathdup(path); // Convert the char* to a pathchar*
- dirName = pathdir(pathCopy);
-
- /* Append the relative member name to the dirname. This should be
- be the full path to the actual thin member. */
- int memberLen = pathlen(dirName) + 1 + strlen(fileName) + 1;
- memberPath = stgMallocBytes(pathsize * memberLen, "loadArchive(file)");
- objFileName = mkPath(fileName);
- pathprintf(memberPath, memberLen, WSTR("%" PATH_FMT "%" PATH_FMT), dirName, objFileName);
- stgFree(objFileName);
- stgFree(dirName);
-
- member = pathopen(memberPath, WSTR("rb"));
- if (!member)
- barf("loadObj: can't read thin archive `%" PATH_FMT "'", memberPath);
-
- n = fread ( image, 1, memberSize, member );
- if (n != memberSize) {
- barf("loadArchive: error whilst reading `%s'", fileName);
- }
-
- fclose(member);
- stgFree(memberPath);
- stgFree(pathCopy);
- }
- else
- {
- n = fread ( image, 1, memberSize, f );
- if (n != memberSize) {
- barf("loadArchive: error whilst reading `%" PATH_FMT "'", path);
- }
- }
-
- archiveMemberName = stgMallocBytes(pathlen(path) + thisFileNameSize + 3,
- "loadArchive(file)");
- sprintf(archiveMemberName, "%" PATH_FMT "(%.*s)",
- path, (int)thisFileNameSize, fileName);
-
- oc = mkOc(path, image, memberSize, rtsFalse, archiveMemberName
- , misalignment);
-
- stgFree(archiveMemberName);
-
- if (0 == loadOc(oc)) {
- stgFree(fileName);
- 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
- }
- }
- else if (isGnuIndex) {
- if (gnuFileIndex != NULL) {
- barf("loadArchive: GNU-variant index found, but already have an index, while reading filename from `%s'", path);
- }
- IF_DEBUG(linker, debugBelch("loadArchive: Found GNU-variant file index\n"));
-#if RTS_LINKER_USE_MMAP
- gnuFileIndex = mmapForLinker(memberSize + 1, MAP_ANONYMOUS, -1, 0);
-#else
- gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)");
-#endif
- n = fread ( gnuFileIndex, 1, memberSize, f );
- if (n != memberSize) {
- barf("loadArchive: error whilst reading `%" PATH_FMT "'", path);
- }
- gnuFileIndex[memberSize] = '/';
- gnuFileIndexSize = memberSize;
- }
- else if (isImportLib) {
-#if defined(OBJFORMAT_PEi386)
- if (checkAndLoadImportLibrary(path, fileName, f)) {
- IF_DEBUG(linker, debugBelch("loadArchive: Member is an import file section... Corresponding DLL has been loaded...\n"));
- }
- else {
- IF_DEBUG(linker, debugBelch("loadArchive: Member is not a valid import file section... Skipping...\n"));
- n = fseek(f, memberSize, SEEK_CUR);
- if (n != 0)
- barf("loadArchive: error whilst seeking by %d in `%" PATH_FMT "'",
- memberSize, path);
- }
-#endif
- }
- else {
- IF_DEBUG(linker, debugBelch("loadArchive: '%s' does not appear to be an object file\n", fileName));
- if (!isThin || thisFileNameSize == 0) {
- n = fseek(f, memberSize, SEEK_CUR);
- if (n != 0)
- barf("loadArchive: error whilst seeking by %d in `%" PATH_FMT "'",
- memberSize, path);
- }
- }
-
- /* .ar files are 2-byte aligned */
- if (!(isThin && thisFileNameSize > 0) && memberSize % 2) {
- IF_DEBUG(linker, debugBelch("loadArchive: trying to read one pad byte\n"));
- n = fread ( tmp, 1, 1, f );
- if (n != 1) {
- if (feof(f)) {
- IF_DEBUG(linker, debugBelch("loadArchive: found EOF while reading one pad byte\n"));
- break;
- }
- else {
- barf("loadArchive: Failed reading padding from `%" PATH_FMT "'", path);
- }
- }
- IF_DEBUG(linker, debugBelch("loadArchive: successfully read one pad byte\n"));
- }
- IF_DEBUG(linker, debugBelch("loadArchive: reached end of archive loading while loop\n"));
- }
-
- fclose(f);
-
- stgFree(fileName);
- if (gnuFileIndex != NULL) {
-#if RTS_LINKER_USE_MMAP
- munmap(gnuFileIndex, gnuFileIndexSize + 1);
-#else
- stgFree(gnuFileIndex);
-#endif
- }
-
- if (RTS_LINKER_USE_MMAP)
- m32_allocator_flush();
-
- IF_DEBUG(linker, debugBelch("loadArchive: done\n"));
- return 1;
-}
-
-HsInt loadArchive (pathchar *path)
-{
- ACQUIRE_LOCK(&linker_mutex);
- HsInt r = loadArchive_(path);
- RELEASE_LOCK(&linker_mutex);
- return r;
-}
-
-#if defined(OBJFORMAT_PEi386)
-
-static int findAndLoadImportLibrary(ObjectCode* oc)
-{
- int i;
-
- COFF_header* hdr;
- COFF_section* sectab;
- COFF_symbol* symtab;
- UChar* strtab;
-
- hdr = (COFF_header*)(oc->image);
- sectab = (COFF_section*)(
- ((UChar*)(oc->image))
- + sizeof_COFF_header + hdr->SizeOfOptionalHeader
- );
-
- symtab = (COFF_symbol*)(
- ((UChar*)(oc->image))
- + hdr->PointerToSymbolTable
- );
-
- strtab = ((UChar*)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 0;
- }
-
- break;
- }
-
- stgFree(secname);
- }
-
- return 1;
-}
-
-static int checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f)
-{
- char* image;
- static HsBool load_dll_warn = HS_BOOL_FALSE;
-
- if (load_dll_warn) { return 0; }
-
- /* Based on Import Library specification. PE Spec section 7.1 */
-
- COFF_import_header hdr;
- size_t n;
-
- n = fread(&hdr, 1, sizeof_COFF_import_Header, f);
- if (n != sizeof(COFF_header)) {
- errorBelch("getNumberOfSymbols: error whilst reading `%s' header in `%" PATH_FMT "'\n",
- member_name, arch_name);
- return 0;
- }
-
- if (hdr.Sig1 != 0x0 || hdr.Sig2 != 0xFFFF) {
- fseek(f, -sizeof_COFF_import_Header, SEEK_CUR);
- IF_DEBUG(linker, debugBelch("loadArchive: Object `%s` is not an import lib. Skipping...\n", member_name));
- return 0;
- }
-
- IF_DEBUG(linker, debugBelch("loadArchive: reading %d bytes at %ld\n", hdr.SizeOfData, ftell(f)));
-
- image = malloc(hdr.SizeOfData);
- n = fread(image, 1, hdr.SizeOfData, f);
- if (n != hdr.SizeOfData) {
- errorBelch("loadArchive: error whilst reading `%s' header in `%" PATH_FMT "'. Did not read enough bytes.\n",
- member_name, arch_name);
- }
-
- char* symbol = strtok(image, "\0");
- int symLen = strlen(symbol) + 1;
- int nameLen = n - symLen;
- char* dllName = malloc(sizeof(char) * nameLen);
- dllName = strncpy(dllName, image + symLen, nameLen);
- pathchar* dll = malloc(sizeof(wchar_t) * nameLen);
- mbstowcs(dll, dllName, nameLen);
- free(dllName);
-
- IF_DEBUG(linker, debugBelch("loadArchive: read symbol %s from lib `%ls'\n", symbol, dll));
- const char* result = addDLL(dll);
-
- free(image);
-
- if (result != NULL) {
- errorBelch("Could not load `%ls'. Reason: %s\n", dll, result);
- load_dll_warn = HS_BOOL_TRUE;
-
- free(dll);
- fseek(f, -(n + sizeof_COFF_import_Header), SEEK_CUR);
- return 0;
- }
-
- free(dll);
- return 1;
-}
-
-#endif /* OBJFORMAT_PEi386 */