/* -------------------------------------------------------------------------- * PEi386(+) specifics (Win32 targets) * ------------------------------------------------------------------------*/ /* The information for this linker comes from Microsoft Portable Executable and Common Object File Format Specification revision 8.3 February 2013 It can be found online at: https://msdn.microsoft.com/en-us/windows/hardware/gg463119.aspx Things move, so if that fails, try searching for it via http://www.google.com/search?q=PE+COFF+specification The ultimate reference for the PE format is the Winnt.h header file that comes with the Platform SDKs; as always, implementations will drift wrt their documentation. A good background article on the PE format is Matt Pietrek's March 1994 article in Microsoft System Journal (MSJ) (Vol.9, No. 3): "Peering Inside the PE: A Tour of the Win32 Portable Executable File Format." The info in there has recently been updated in a two part article in MSDN magazine, issues Feb and March 2002, "Inside Windows: An In-Depth Look into the Win32 Portable Executable File Format" John Levine's book "Linkers and Loaders" contains useful info on PE too. The PE specification doesn't specify how to do the actual relocations. For this reason, and because both PE and ELF are based on COFF, the relocations for the PEi386+ code is based on the ELF relocations for the equivalent relocation type. The ELF ABI can be found at http://www.x86-64.org/documentation/abi.pdf The current code is based on version 0.99.6 - October 2013 The current GHCi linker supports the following four object file formats: * PE/PE+ obj - The normal COFF_ANON_OBJ format which is generated by default from Windows compilers * PE/PE+ big-obj - The big object format COFF_ANON_BIG_OBJ which extends the number of sections to 2^31 and the number of symbols in each section. This requires a flag but all Windows compilers can produce it. * PE Import format - The import library format defined in the PE standard COFF_IMPORT_LIB and commonly has the file extension .lib * GNU BFD import format - The import library format defined and used by GNU tools. See note below. 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 referred 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. Note [Memory allocation] ~~~~~~~~~~~~~~~~~~~~~~~~ Previously on Windows we would use VirtualAlloc to allocate enough space for loading the entire object file into memory and keep it there for the duration until the entire object file has been unloaded. This has a couple of problems, first of, VirtualAlloc and the other Virtual functions interact directly with the memory manager. Requesting memory from VirtualAlloc will always return whole pages (32k), aligned on a 4k boundary. This means for an object file of size N kbytes, we're always wasting 32-N kbytes of memory. Nothing else can access this memory. Because of this we're now using HeapAlloc and other heap function to create a private heap. Another solution would have been to write our own memory manager to keep track of where we have free memory, but the private heap solution is simpler. The private heap is created with full rights just as the pages we used to get from VirtualAlloc (e.g. READ/WRITE/EXECUTE). In the end we end up using memory much more efficiently than before. The downside is that heap memory is always Allocated AND Committed, thus when the heap resizes the new size is committed. It becomes harder to see how much we're actually using. This makes it seem like for small programs that we're using more memory than before. Certainly a clean GHCi startup will have a slightly higher commit count. The second major change in how we allocate memory is that we no longer need the entire object file. We now allocate the object file using normal malloc and instead read bits from it. All tables are stored in the Object file info table and are discarded as soon as they are no longer needed, e.g. after relocation is finished. Only section data is kept around, but this data is copied into the private heap. The major knock on effect of this is that we have more memory to use in the sub 2GB range, which means that Template Haskell should fail a lot less as we will violate the small memory model much less than before. Note [Section alignment] ~~~~~~~~~~~~~~~~~~~~~~~~ The Windows linker aligns memory to it's section alignment requirement by aligning it during the copying to the private heap. We also ensure that the trampoline "region" we reserve is 8 bytes aligned. */ #include "Rts.h" #if defined(x86_64_HOST_ARCH) #define USED_IF_x86_64_HOST_ARCH /* Nothing */ #else #define USED_IF_x86_64_HOST_ARCH STG_UNUSED #endif #if defined(mingw32_HOST_OS) #include "RtsUtils.h" #include "RtsSymbolInfo.h" #include "GetEnv.h" #include "CheckUnload.h" #include "linker/PEi386.h" #include "linker/PEi386Types.h" #include "linker/SymbolExtras.h" #include "LinkerInternals.h" #include #include /* SHGetFolderPathW */ #include #include #include #include #include #include #include #include #if defined(x86_64_HOST_ARCH) static size_t makeSymbolExtra_PEi386( ObjectCode* oc, uint64_t index, size_t s, SymbolName* symbol); #endif static void addDLLHandle( pathchar* dll_name, HINSTANCE instance); static bool verifyCOFFHeader( uint16_t machine, IMAGE_FILE_HEADER *hdr, pathchar *fileName); static bool checkIfDllLoaded( HINSTANCE instance); static uint32_t getSectionAlignment( Section section); static uint8_t* getAlignedMemory( uint8_t* value, Section section); static size_t getAlignedValue( size_t value, Section section); static void addCopySection( ObjectCode *oc, Section *s, SectionKind kind, SectionAlloc alloc, void* start, StgWord size); static void releaseOcInfo( ObjectCode* oc); /* Add ld symbol for PE image base. */ #if defined(__GNUC__) #define __ImageBase __MINGW_LSYMBOL(_image_base__) #endif /* Get the base of the module. */ /* This symbol is defined by ld. */ extern IMAGE_DOS_HEADER __ImageBase; #define __image_base (void*)((HINSTANCE)&__ImageBase) const Alignments pe_alignments[] = { { IMAGE_SCN_ALIGN_1BYTES , 1 }, { IMAGE_SCN_ALIGN_2BYTES , 2 }, { IMAGE_SCN_ALIGN_4BYTES , 4 }, { IMAGE_SCN_ALIGN_8BYTES , 8 }, { IMAGE_SCN_ALIGN_16BYTES , 16 }, { IMAGE_SCN_ALIGN_32BYTES , 32 }, { IMAGE_SCN_ALIGN_64BYTES , 64 }, { IMAGE_SCN_ALIGN_128BYTES , 128 }, { IMAGE_SCN_ALIGN_256BYTES , 256 }, { IMAGE_SCN_ALIGN_512BYTES , 512 }, { IMAGE_SCN_ALIGN_1024BYTES, 1024}, { IMAGE_SCN_ALIGN_2048BYTES, 2048}, { IMAGE_SCN_ALIGN_4096BYTES, 4096}, { IMAGE_SCN_ALIGN_8192BYTES, 8192}, }; const int pe_alignments_cnt = sizeof (pe_alignments) / sizeof (Alignments); const int default_alignment = 8; const int initHeapSizeMB = 15; static HANDLE code_heap = NULL; /* See Note [_iob_func symbol] In order to emulate __iob_func the memory location needs to point the location of the I/O structures in memory. As such we need RODATA to contain the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; /* Low Fragmentation Heap, try to prevent heap from increasing in size when space can simply be reclaimed. These are enums missing from mingw-w64's headers. */ #define HEAP_LFH 2 #define HeapOptimizeResources 3 void initLinker_PEi386() { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), symhash, "__image_base__", __image_base, HS_BOOL_TRUE, NULL)) { barf("ghciInsertSymbolTable failed"); } #if defined(mingw32_HOST_OS) addDLLHandle(WSTR("*.exe"), GetModuleHandle(NULL)); /* * Most of these are included by base, but GCC always includes them * So lets make sure we always have them too. * * In most cases they would have been loaded by the * addDLLHandle above. */ addDLL(WSTR("msvcrt")); addDLL(WSTR("kernel32")); addDLL(WSTR("advapi32")); addDLL(WSTR("shell32")); addDLL(WSTR("user32")); #endif /* See Note [Memory allocation]. */ /* Create a private heap which we will use to store all code and data. */ SYSTEM_INFO sSysInfo; GetSystemInfo(&sSysInfo); code_heap = HeapCreate (HEAP_CREATE_ENABLE_EXECUTE, initHeapSizeMB * sSysInfo.dwPageSize , 0); if (!code_heap) barf ("Could not create private heap during initialization. Aborting."); /* Set some flags for the new code heap. */ HeapSetInformation(code_heap, HeapEnableTerminationOnCorruption, NULL, 0); unsigned long HeapInformation = HEAP_LFH; HeapSetInformation(code_heap, HeapEnableTerminationOnCorruption, &HeapInformation, sizeof(HeapInformation)); HeapSetInformation(code_heap, HeapOptimizeResources, NULL, 0); /* Register the cleanup routine as an exit handler, this gives other exit handlers a chance to run which may need linker information. Exit handlers are ran in reverse registration order so this needs to be before the linker loads anything. */ atexit (exitLinker_PEi386); } void exitLinker_PEi386() { /* See Note [Memory allocation]. */ if (code_heap) { HeapDestroy (code_heap); code_heap = NULL; } } /* A list thereof. */ static OpenedDLL* opened_dlls = NULL; /* A list thereof. */ static IndirectAddr* indirects = NULL; /* Adds a DLL instance to the list of DLLs in which to search for symbols. */ static void addDLLHandle(pathchar* dll_name, HINSTANCE instance) { /* At this point, we actually know what was loaded. So bail out if it's already been loaded. */ if (checkIfDllLoaded(instance)) { return; } OpenedDLL* o_dll; o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLLHandle" ); o_dll->name = dll_name ? pathdup(dll_name) : NULL; o_dll->instance = instance; o_dll->next = opened_dlls; opened_dlls = o_dll; /* Now discover the dependencies of dll_name that were just loaded in our process space. The reason is we have access to them without the user having to explicitly specify them. */ PIMAGE_NT_HEADERS header = (PIMAGE_NT_HEADERS)((BYTE *)instance + ((PIMAGE_DOS_HEADER)instance)->e_lfanew); PIMAGE_IMPORT_DESCRIPTOR imports = (PIMAGE_IMPORT_DESCRIPTOR)((BYTE *)instance + header-> OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress); bool importTableMissing = header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].Size == 0; if (importTableMissing) { return; } /* Ignore these compatibility shims. */ const pathchar* ms_dll = WSTR("api-ms-win-"); const int len = wcslen(ms_dll); do { pathchar* module = mkPath((char*)(BYTE *)instance + imports->Name); HINSTANCE module_instance = GetModuleHandleW(module); if (0 != wcsncmp(module, ms_dll, len) && module_instance && !checkIfDllLoaded(module_instance)) { IF_DEBUG(linker, debugBelch("Loading dependency %" PATH_FMT " -> %" PATH_FMT ".\n", dll_name, module)); /* Now recursively load dependencies too. */ addDLLHandle(module, module_instance); } stgFree(module); imports++; } while (imports->Name); } 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 o_dll; } } return NULL; } static bool checkIfDllLoaded(HINSTANCE instance) { return findLoadedDll (instance) != NULL; } void freePreloadObjectFile_PEi386(ObjectCode *oc) { if (oc->image) { stgFree (oc->image); oc->image = NULL; } if (oc->info) { if (oc->info->image) { HeapFree(code_heap, 0, oc->info->image); oc->info->image = NULL; } if (oc->info->ch_info) stgFree (oc->info->ch_info); stgFree (oc->info); oc->info = NULL; } IndirectAddr *ia, *ia_next; ia = indirects; while (ia != NULL) { ia_next = ia->next; stgFree(ia); ia = ia_next; } indirects = NULL; } static void releaseOcInfo(ObjectCode* oc) { if (!oc) return; if (oc->info) { stgFree (oc->info->ch_info); stgFree (oc->info->str_tab); stgFree (oc->info->symbols); stgFree (oc->info); oc->info = NULL; } for (int i = 0; i < oc->n_sections; i++){ Section *section = &oc->sections[i]; if (section->info) { stgFree (section->info->name); if (section->info->relocs) { stgFree (section->info->relocs); section->info->relocs = NULL; } stgFree (section->info); section->info = NULL; } } } /************* * This function determines what kind of COFF image we are dealing with. * This is needed in order to correctly load and verify objects and their * sections. *************/ COFF_OBJ_TYPE getObjectType ( char* image, pathchar* fileName ) { /* {D1BAA1C7-BAEE-4ba9-AF20-FAF66AA4DCB8} */ static const char header_bigobj_classid[16] = { 0xC7, 0xA1, 0xBA, 0xD1, 0xEE, 0xBA, 0xa9, 0x4b, 0xAF, 0x20, 0xFA, 0xF6, 0x6A, 0xA4, 0xDC, 0xB8 }; WORD machine; COFF_OBJ_TYPE ret = COFF_UNKNOWN; /* First check if we have an ANON_OBJECT_HEADER signature. */ ANON_OBJECT_HEADER* anon = (ANON_OBJECT_HEADER*)image; if ( anon->Sig1 == IMAGE_FILE_MACHINE_UNKNOWN && anon->Sig2 == IMPORT_OBJECT_HDR_SIG2) { machine = anon->Machine; if (verifyCOFFHeader (machine, NULL, fileName)) { switch (anon->Version) { case 0: ret = COFF_IMPORT_LIB; break; case 1: ret = COFF_ANON_OBJ; break; case 2: if (memcmp (&anon->ClassID, header_bigobj_classid, 16) == 0) ret = COFF_ANON_BIG_OBJ; break; default: break; } } } else { /* If it's not an ANON_OBJECT then try an image file. */ IMAGE_FILE_HEADER* img = (IMAGE_FILE_HEADER*)image; machine = img->Machine; if (verifyCOFFHeader (machine, img, fileName)) ret = COFF_IMAGE; } return ret; } /************* * Retrieve common header information *************/ COFF_HEADER_INFO* getHeaderInfo ( ObjectCode* oc ) { COFF_OBJ_TYPE coff_type = getObjectType (oc->image, oc->fileName); COFF_HEADER_INFO* info = stgMallocBytes (sizeof(COFF_HEADER_INFO), "getHeaderInfo"); memset (info, 0, sizeof(COFF_HEADER_INFO)); info->type = coff_type; switch (coff_type) { case COFF_IMAGE: { IMAGE_FILE_HEADER* hdr = (IMAGE_FILE_HEADER*)oc->image; info->sizeOfHeader = sizeof(IMAGE_FILE_HEADER); info->sizeOfOptionalHeader = hdr->SizeOfOptionalHeader; info->pointerToSymbolTable = hdr->PointerToSymbolTable; info->numberOfSymbols = hdr->NumberOfSymbols; info->numberOfSections = hdr->NumberOfSections; } break; case COFF_ANON_BIG_OBJ: { ANON_OBJECT_HEADER_BIGOBJ* hdr = (ANON_OBJECT_HEADER_BIGOBJ*)oc->image; info->sizeOfHeader = sizeof(ANON_OBJECT_HEADER_BIGOBJ); info->sizeOfOptionalHeader = 0; info->pointerToSymbolTable = hdr->PointerToSymbolTable; info->numberOfSymbols = hdr->NumberOfSymbols; info->numberOfSections = hdr->NumberOfSections; } break; default: { stgFree (info); info = NULL; errorBelch ("Unknown COFF %d type in getHeaderInfo.", coff_type); } break; } return info; } /************* * Symbol utility functions *************/ __attribute__ ((always_inline)) inline size_t getSymbolSize ( COFF_HEADER_INFO *info ) { ASSERT(info); switch (info->type) { case COFF_ANON_BIG_OBJ: return sizeof_COFF_symbol_ex; default: return sizeof_COFF_symbol_og; } } __attribute__ ((always_inline)) inline int32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { ASSERT(info); ASSERT(sym); switch (info->type) { case COFF_ANON_BIG_OBJ: return sym->ex.SectionNumber; default: return sym->og.SectionNumber; } } __attribute__ ((always_inline)) inline uint32_t getSymValue ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { ASSERT(info); ASSERT(sym); switch (info->type) { case COFF_ANON_BIG_OBJ: return sym->ex.Value; default: return sym->og.Value; } } __attribute__ ((always_inline)) inline uint8_t getSymStorageClass ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { ASSERT(info); ASSERT(sym); switch (info->type) { case COFF_ANON_BIG_OBJ: return sym->ex.StorageClass; default: return sym->og.StorageClass; } } __attribute__ ((always_inline)) inline uint8_t getSymNumberOfAuxSymbols ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { ASSERT(info); ASSERT(sym); switch (info->type) { case COFF_ANON_BIG_OBJ: return sym->ex.NumberOfAuxSymbols; default: return sym->og.NumberOfAuxSymbols; } } __attribute__ ((always_inline)) inline uint16_t getSymType ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { ASSERT(info); ASSERT(sym); switch (info->type) { case COFF_ANON_BIG_OBJ: return sym->ex.Type; default: return sym->og.Type; } } __attribute__ ((always_inline)) inline uint8_t* getSymShortName ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { ASSERT(info); ASSERT(sym); switch (info->type) { case COFF_ANON_BIG_OBJ: return sym->ex.N.ShortName; default: return sym->og.N.ShortName; } } const char * addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) { /* ------------------- Win32 DLL loader ------------------- */ pathchar* buf; HINSTANCE instance; IF_DEBUG(linker, debugBelch("addDLL; dll_name = `%" PATH_FMT "'\n", dll_name)); /* The file name has no suffix (yet) so that we can try both foo.dll and foo.drv The documentation for LoadLibrary says: If no file name extension is specified in the lpFileName parameter, the default library extension .dll is appended. However, the file name string can include a trailing point character (.) to indicate that the module name has no extension. */ size_t bufsize = pathlen(dll_name) + 10; buf = stgMallocBytes(bufsize * sizeof(wchar_t), "addDLL"); /* These are ordered by probability of success and order we'd like them. */ const wchar_t *formats[] = { L"%ls.DLL", L"%ls.DRV", L"lib%ls.DLL", L"%ls" }; const DWORD flags[] = { LOAD_LIBRARY_SEARCH_USER_DIRS | LOAD_LIBRARY_SEARCH_DEFAULT_DIRS, 0 }; int cFormat, cFlag; int flags_start = 1; /* Assume we don't support the new API. */ /* Detect if newer API are available, if not, skip the first flags entry. */ if (GetProcAddress((HMODULE)LoadLibraryW(L"Kernel32.DLL"), "AddDllDirectory")) { flags_start = 0; } /* Iterate through the possible flags and formats. */ for (cFlag = flags_start; cFlag < 2; cFlag++) { for (cFormat = 0; cFormat < 4; cFormat++) { snwprintf(buf, bufsize, formats[cFormat], dll_name); instance = LoadLibraryExW(buf, NULL, flags[cFlag]); if (instance == NULL) { if (GetLastError() != ERROR_MOD_NOT_FOUND) { goto error; } } else { break; /* We're done. DLL has been loaded. */ } } } /* Check if we managed to load the DLL. */ if (instance == NULL) { goto error; } addDLLHandle(buf, instance); if (loaded) { *loaded = instance; } stgFree(buf); return NULL; error: stgFree(buf); char* errormsg = malloc(sizeof(char) * 80); snprintf(errormsg, 80, "addDLL: %" PATH_FMT " or dependencies not loaded. (Win32 error %lu)", dll_name, GetLastError()); /* LoadLibrary failed; return a ptr to the error msg. */ return errormsg; } pathchar* findSystemLibrary_PEi386( pathchar* dll_name ) { const unsigned int init_buf_size = 1024; unsigned int bufsize = init_buf_size; wchar_t* result = malloc(sizeof(wchar_t) * bufsize); DWORD wResult = SearchPathW(NULL, dll_name, NULL, bufsize, result, NULL); if (wResult > bufsize) { result = realloc(result, sizeof(wchar_t) * wResult); wResult = SearchPathW(NULL, dll_name, NULL, wResult, result, NULL); } if (!wResult) { free(result); return NULL; } return result; } HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) { HINSTANCE hDLL = LoadLibraryW(L"Kernel32.DLL"); LPAddDLLDirectory AddDllDirectory = (LPAddDLLDirectory)(void*)GetProcAddress((HMODULE)hDLL, "AddDllDirectory"); HsPtr result = NULL; const unsigned int init_buf_size = 4096; int bufsize = init_buf_size; // Make sure the path is an absolute path WCHAR* abs_path = malloc(sizeof(WCHAR) * init_buf_size); DWORD wResult = GetFullPathNameW(dll_path, bufsize, abs_path, NULL); if (!wResult){ IF_DEBUG(linker, debugBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError())); } else if (wResult > init_buf_size) { abs_path = realloc(abs_path, sizeof(WCHAR) * wResult); if (!GetFullPathNameW(dll_path, bufsize, abs_path, NULL)) { IF_DEBUG(linker, debugBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError())); } } if (AddDllDirectory) { result = AddDllDirectory(abs_path); } else { warnMissingKBLibraryPaths(); WCHAR* str = malloc(sizeof(WCHAR) * init_buf_size); wResult = GetEnvironmentVariableW(L"PATH", str, bufsize); if (wResult > init_buf_size) { str = realloc(str, sizeof(WCHAR) * wResult); bufsize = wResult; wResult = GetEnvironmentVariableW(L"PATH", str, bufsize); if (!wResult) { sysErrorBelch("addLibrarySearchPath[GetEnvironmentVariableW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError()); } } bufsize = wResult + 2 + pathlen(abs_path); wchar_t* newPath = malloc(sizeof(wchar_t) * bufsize); wcscpy(newPath, abs_path); wcscat(newPath, L";"); wcscat(newPath, str); if (!SetEnvironmentVariableW(L"PATH", (LPCWSTR)newPath)) { sysErrorBelch("addLibrarySearchPath[SetEnvironmentVariableW]: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); } free(newPath); free(abs_path); return str; } if (!result) { sysErrorBelch("addLibrarySearchPath: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); free(abs_path); return NULL; } free(abs_path); return result; } bool removeLibrarySearchPath_PEi386(HsPtr dll_path_index) { bool result = false; if (dll_path_index != NULL) { HINSTANCE hDLL = LoadLibraryW(L"Kernel32.DLL"); LPRemoveDLLDirectory RemoveDllDirectory = (LPRemoveDLLDirectory)(void*)GetProcAddress((HMODULE)hDLL, "RemoveDllDirectory"); if (RemoveDllDirectory) { result = RemoveDllDirectory(dll_path_index); // dll_path_index is now invalid, do not use it after this point. } else { warnMissingKBLibraryPaths(); result = SetEnvironmentVariableW(L"PATH", (LPCWSTR)dll_path_index); free(dll_path_index); } if (!result) { sysErrorBelch("removeLibrarySearchPath: (Win32 error %lu)", GetLastError()); return false; } } return !result; } /* We assume file pointer is right at the beginning of COFF object. */ static uint32_t getSectionAlignment( Section section) { uint32_t c = section.info->props; for(int i = 0; i < pe_alignments_cnt; i++) { if ((c & 0xF00000) == pe_alignments[i].mask) return pe_alignments[i].value; } /* No alignment flag found, assume 8-byte aligned. */ return default_alignment; } /* ---------------------- * return a memory location aligned to the section requirements */ static uint8_t* getAlignedMemory( uint8_t* value, Section section) { uint32_t alignment = getSectionAlignment(section); uintptr_t mask = (uintptr_t)alignment - 1; return (uint8_t*)(((uintptr_t)value + mask) & ~mask); } /* ---------------------- * return a value aligned to the section requirements */ static size_t getAlignedValue( size_t value, Section section) { uint32_t alignment = getSectionAlignment(section); uint32_t mask = (uint32_t)alignment - 1; return (size_t)((value + mask) & ~mask); } /* ----------------------- * This loads import libraries following Microsoft's official standard in the PE * documentation. This is a smaller more efficient format which is just a list * of symbol name => dll. * * This function must fail gracefully and if it does, the filestream needs to * be reset to what it was when the function was called. */ bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f ) { char* image; static bool load_dll_warn = 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_import_Header) { errorBelch("loadImportLibrary: error whilst reading `%s' header " "in `%" PATH_FMT "'\n", member_name, arch_name); fseek(f, -(long int)sizeof_COFF_import_Header, SEEK_CUR); return false; } if ( hdr.Sig1 != IMAGE_FILE_MACHINE_UNKNOWN || hdr.Sig2 != IMPORT_OBJECT_HDR_SIG2 || getObjectType ((char*)&hdr, arch_name) != COFF_IMPORT_LIB) { fseek(f, -(long int)sizeof_COFF_import_Header, SEEK_CUR); IF_DEBUG(linker, debugBelch("loadArchive: Object `%s` is not an import lib. Skipping...\n", member_name)); return false; } IF_DEBUG(linker, debugBelch("loadArchive: reading %lu bytes at %ld\n", hdr.SizeOfData, ftell(f))); image = stgMallocBytes(hdr.SizeOfData, "checkAndLoadImportLibrary(image)"); 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); fseek(f, -(n + sizeof_COFF_import_Header), SEEK_CUR); return false; } char* symbol = strtok(image, "\0"); int symLen = strlen(symbol) + 1; int nameLen = n - symLen; char* dllName = stgMallocBytes(sizeof(char) * nameLen, "checkAndLoadImportLibrary(dllname)"); dllName = strncpy(dllName, image + symLen, nameLen); pathchar* dll = stgMallocBytes(sizeof(wchar_t) * nameLen, "checkAndLoadImportLibrary(dll)"); mbstowcs(dll, dllName, nameLen); stgFree(dllName); IF_DEBUG(linker, debugBelch("loadArchive: read symbol %s from lib `%" PATH_FMT "'\n", symbol, dll)); const char* result = addDLL(dll); stgFree(image); if (result != NULL) { errorBelch("Could not load `%" PATH_FMT "'. Reason: %s\n", dll, result); load_dll_warn = true; stgFree(dll); fseek(f, -(n + sizeof_COFF_import_Header), SEEK_CUR); return false; } stgFree(dll); return true; } static void printName ( uint8_t* name, ObjectCode* oc ) { if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) { uint32_t strtab_offset = * (uint32_t*)(name + 4); debugBelch("%s", oc->info->str_tab + strtab_offset - PEi386_STRTAB_OFFSET); } else { int i; for (i = 0; i < 8; i++) { if (name[i] == 0) break; debugBelch("%c", name[i] ); } } } static void copyName ( uint8_t* name, ObjectCode* oc, uint8_t* dst, int dstSize ) { if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) { uint32_t strtab_offset = * (uint32_t*)(name + 4); strncpy ((char*)dst, oc->info->str_tab + strtab_offset - PEi386_STRTAB_OFFSET, dstSize); dst[dstSize-1] = 0; } else { int i = 0; while (1) { if (i >= 8) break; if (name[i] == 0) break; dst[i] = name[i]; i++; } dst[i] = 0; } } char* get_sym_name ( uint8_t* name, ObjectCode* oc ) { char* newstr; /* If the string is longer than 8 bytes, look in the string table for it -- this will be correctly zero terminated. */ if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) { uint32_t strtab_offset = * (uint32_t*)(name + 4); return oc->info->str_tab + strtab_offset - PEi386_STRTAB_OFFSET; } /* Otherwise, if shorter than 8 bytes, return the original, which by defn is correctly terminated. */ if (name[7]==0) return (char*)name; /* The annoying case: 8 bytes. Copy into a temporary (XXX which is never freed ...) */ newstr = stgMallocBytes(9, "get_sym_name"); ASSERT(newstr); strncpy (newstr, (char*)name,8); newstr[8] = 0; return newstr; } /* Getting the name of a section is mildly tricky, so we make a function for it. Sadly, in one case we have to copy the string (when it is exactly 8 bytes long there's no trailing '\0'), so for consistency we *always* copy the string; the caller must free it */ char * get_name_string (uint8_t* name, ObjectCode* oc) { char *newstr; if (name[0]=='/') { int strtab_offset = strtol((char*)name+1,NULL,10)-PEi386_STRTAB_OFFSET; char* str = oc->info->str_tab + strtab_offset; int len = strlen(str); newstr = stgMallocBytes(len + 1, "cstring_from_section_symbol_name"); strncpy(newstr, str, len + 1); return newstr; } else { newstr = stgMallocBytes(9, "cstring_from_section_symbol_name"); ASSERT(newstr); strncpy(newstr,(char*)name,8); newstr[8] = 0; return newstr; } } /* See Note [mingw-w64 name decoration scheme] */ #if !defined(x86_64_HOST_ARCH) static void zapTrailingAtSign ( SymbolName* sym ) { char* lst = strrchr (sym, '@'); if (lst) lst[0]='\0'; } #endif SymbolAddr* lookupSymbolInDLLs ( const SymbolName* lbl ) { OpenedDLL* o_dll; SymbolAddr* sym; for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */ sym = GetProcAddress(o_dll->instance, lbl+STRIP_LEADING_UNDERSCORE); if (sym != NULL) { /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/ return sym; } /* Ticket #2283. Long description: http://support.microsoft.com/kb/132044 tl;dr: If C/C++ compiler sees __declspec(dllimport) ... foo ... it generates call *__imp_foo, and __imp_foo here has exactly the same semantics as in __imp_foo = GetProcAddress(..., "foo") */ if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { sym = GetProcAddress(o_dll->instance, lbl + 6 + STRIP_LEADING_UNDERSCORE); if (sym != NULL) { IndirectAddr* ret; ret = stgMallocBytes( sizeof(IndirectAddr), "lookupSymbolInDLLs" ); ret->addr = sym; ret->next = indirects; indirects = ret; IF_DEBUG(linker, debugBelch("warning: %s from %S is linked instead of %s\n", lbl+6+STRIP_LEADING_UNDERSCORE, o_dll->name, lbl)); return (void*) & ret->addr; } } sym = GetProcAddress(o_dll->instance, lbl); if (sym != NULL) { /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/ return sym; } } return NULL; } static bool verifyCOFFHeader ( uint16_t machine, IMAGE_FILE_HEADER *hdr, pathchar *fileName ) { #if defined(i386_HOST_ARCH) if (machine != IMAGE_FILE_MACHINE_I386) { errorBelch("%" PATH_FMT ": Not a x86 PE file.", fileName); return false; } #elif defined(x86_64_HOST_ARCH) if (machine != IMAGE_FILE_MACHINE_AMD64) { errorBelch("%" PATH_FMT ": Not a x86_64 PE+ file.", fileName); return false; } #else errorBelch("PE/PE+ not supported on this arch."); #endif if (!hdr) return true; if (hdr->SizeOfOptionalHeader != 0) { errorBelch("%" PATH_FMT ": PE/PE+ with nonempty optional header", fileName); return 0; } if ( (hdr->Characteristics & IMAGE_FILE_EXECUTABLE_IMAGE) || (hdr->Characteristics & IMAGE_FILE_DLL ) || (hdr->Characteristics & IMAGE_FILE_SYSTEM ) ) { errorBelch("%" PATH_FMT ": Not a PE/PE+ object file", fileName); return false; } if ( (hdr->Characteristics & IMAGE_FILE_BYTES_REVERSED_HI)) { errorBelch("%" PATH_FMT ": Invalid PE/PE+ word size or endianness: %d", fileName, (int)(hdr->Characteristics)); return false; } return true; } bool ocVerifyImage_PEi386 ( ObjectCode* oc ) { COFF_HEADER_INFO *info = getHeaderInfo (oc); /* If the header could not be read, then don't process the ObjectCode. This the case when the ObjectCode has been partially freed. */ if (!info) return false; uint32_t i, noRelocs; COFF_section* sectab; COFF_symbol* symtab; uint8_t* strtab; sectab = (COFF_section*) ( ((uint8_t*)(oc->image)) + info->sizeOfHeader + info->sizeOfOptionalHeader ); symtab = (COFF_symbol*) ( ((uint8_t*)(oc->image)) + info->pointerToSymbolTable ); strtab = ((uint8_t*)symtab) + info->numberOfSymbols * getSymbolSize (info); /* .BSS Section is initialized in ocGetNames_PEi386 but we need the Sections array initialized here already. */ Section *sections; sections = (Section*)stgCallocBytes( sizeof(Section), info->numberOfSections + 1, /* +1 for the global BSS section see ocGetNames_PEi386 */ "ocVerifyImage_PEi386(sections)"); oc->sections = sections; oc->n_sections = info->numberOfSections + 1; oc->info = stgCallocBytes (sizeof(struct ObjectCodeFormatInfo), 1, "ocVerifyImage_PEi386(info)"); oc->info->secBytesTotal = 0; oc->info->secBytesUsed = 0; oc->info->init = NULL; oc->info->finit = NULL; oc->info->ch_info = info; /* Copy the tables over from object-file. Copying these allows us to simplify the indexing and to release the object file immediately after this step as all information we need would be in available. After loading we can also release everything in the info structure as it won't be needed again further freeing up memory. COFF_symbol is a union type, so we have to "adjust" the array to be able to access it using normal subscript notation. This eliminates the complex indexing later on. */ uint32_t s_symbols = info->numberOfSymbols * sizeof(COFF_symbol); uint32_t sym_size = getSymbolSize (info); oc->info->symbols = stgMallocBytes (s_symbols, "ocVerifyImage_PEi386(oc->info->symbols)"); for (i = 0; i < info->numberOfSymbols; i++) memcpy (oc->info->symbols+i, (char*)symtab + sym_size * i, sym_size); uint32_t n_strtab = (*(uint32_t*)strtab) - PEi386_STRTAB_OFFSET; oc->info->str_tab = stgMallocBytes (n_strtab, "ocVerifyImage_PEi386(oc->info->str_tab)"); memcpy (oc->info->str_tab, strtab + PEi386_STRTAB_OFFSET, n_strtab); /* Initialize the Sections */ for (i = 0; i < info->numberOfSections; i++) { uint32_t relocs_offset; COFF_section* sectab_i = (COFF_section*) myindex(sizeof_COFF_section, sectab, i); Section *section = §ions[i]; /* Calculate the start of the section data. */ section->start = oc->image + sectab_i->PointerToRawData; section->size = sectab_i->SizeOfRawData; section->info = stgCallocBytes (sizeof(struct SectionFormatInfo), 1, "ocVerifyImage_PEi386(section.info)"); section->info->name = get_name_string (sectab_i->Name, oc); section->info->alignment = getSectionAlignment (*section); section->info->props = sectab_i->Characteristics; section->info->virtualSize = sectab_i->Misc.VirtualSize; section->info->virtualAddr = sectab_i->VirtualAddress; COFF_reloc* reltab = (COFF_reloc*) (oc->image + sectab_i->PointerToRelocations); if (section->info->props & IMAGE_SCN_LNK_NRELOC_OVFL ) { /* If the relocation field (a short) has overflowed, the * real count can be found in the first reloc entry. * * See Section 4.1 (last para) of the PE spec (rev6.0). */ COFF_reloc* rel = (COFF_reloc*) myindex ( sizeof_COFF_reloc, reltab, 0 ); noRelocs = rel->VirtualAddress - 1; relocs_offset = 1; } else { noRelocs = sectab_i->NumberOfRelocations; relocs_offset = 0; } section->info->noRelocs = noRelocs; section->info->relocs = NULL; if (noRelocs > 0) { section->info->relocs = stgMallocBytes (noRelocs * sizeof (COFF_reloc), "ocVerifyImage_PEi386(section->info->relocs)"); memcpy (section->info->relocs, reltab + relocs_offset, noRelocs * sizeof (COFF_reloc)); } oc->info->secBytesTotal += getAlignedValue (section->size, *section); } /* Initialize the last section's info field which contains the .bss section, it doesn't need an info so set it to NULL. */ sections[info->numberOfSections].info = NULL; /* Calculate space for trampolines nearby. We get back 8-byte aligned memory (is that guaranteed?), but the offsets to the sections within the file are all 4 mod 8 (is that guaranteed?). We therefore need to offset the image by 4, so that all the pointers are 8-byte aligned, so that pointer tagging works. */ /* For 32-bit case we don't need this, hence we use macro PEi386_IMAGE_OFFSET, which equals to 4 for 64-bit case and 0 for 32-bit case. */ /* We allocate trampolines area for all symbols right behind image data, aligned on 8. */ oc->info->trampoline = (PEi386_IMAGE_OFFSET + 2 * default_alignment + oc->info->secBytesTotal) & ~0x7; oc->info->secBytesTotal = oc->info->trampoline + info->numberOfSymbols * sizeof(SymbolExtra); /* No further verification after this point; only debug printing. */ i = 0; IF_DEBUG(linker, i=1); if (i == 0) return true; debugBelch("sectab offset = %" FMT_SizeT "\n", ((uint8_t*)sectab) - ((uint8_t*)oc->image) ); debugBelch("symtab offset = %" FMT_SizeT "\n", ((uint8_t*)symtab) - ((uint8_t*)oc->image) ); debugBelch("strtab offset = %" FMT_SizeT "\n", ((uint8_t*)strtab) - ((uint8_t*)oc->image) ); debugBelch("\n" ); if (info->type == COFF_IMAGE) { IMAGE_FILE_HEADER* hdr = (IMAGE_FILE_HEADER*)oc->image; debugBelch( "COFF Type: IMAGE_FILE_HEADER\n"); debugBelch( "Machine: 0x%x\n", (uint32_t)(hdr->Machine) ); debugBelch( "# sections: %d\n", (uint32_t)(hdr->NumberOfSections) ); debugBelch( "time/date: 0x%x\n", (uint32_t)(hdr->TimeDateStamp) ); debugBelch( "symtab offset: %d\n", (uint32_t)(hdr->PointerToSymbolTable) ); debugBelch( "# symbols: %d\n", (uint32_t)(hdr->NumberOfSymbols) ); debugBelch( "sz of opt hdr: %d\n", (uint32_t)(hdr->SizeOfOptionalHeader) ); debugBelch( "characteristics: 0x%x\n", (uint32_t)(hdr->Characteristics) ); } else if (info->type == COFF_ANON_BIG_OBJ) { ANON_OBJECT_HEADER_BIGOBJ* hdr = (ANON_OBJECT_HEADER_BIGOBJ*)oc->image; debugBelch( "COFF Type: ANON_OBJECT_HEADER_BIGOBJ\n"); debugBelch( "Machine: 0x%x\n", (uint32_t)(hdr->Machine) ); debugBelch( "# sections: %d\n", (uint32_t)(hdr->NumberOfSections) ); debugBelch( "time/date: 0x%x\n", (uint32_t)(hdr->TimeDateStamp) ); debugBelch( "symtab offset: %d\n", (uint32_t)(hdr->PointerToSymbolTable) ); debugBelch( "# symbols: %d\n", (uint32_t)(hdr->NumberOfSymbols) ); } else { debugBelch( "COFF Type: UNKNOWN\n"); return false; } /* Print the section table. */ debugBelch("\n" ); for (i = 0; i < info->numberOfSections; i++) { COFF_section* sectab_i = (COFF_section*) myindex ( sizeof_COFF_section, sectab, i ); Section section = sections[i]; debugBelch( "\n" "section %d\n" " name `", i ); printName (sectab_i->Name, oc); debugBelch( "'\n" " vsize %lu\n" " vaddr %lu\n" " data sz %lu\n" " data off 0x%p\n" " num rel %hu\n" " off rel %lu\n" " ptr raw 0x%lx\n" " align %u\n" " data adj %zu\n", sectab_i->Misc.VirtualSize, sectab_i->VirtualAddress, sectab_i->SizeOfRawData, section.start, sectab_i->NumberOfRelocations, sectab_i->PointerToRelocations, sectab_i->PointerToRawData, getSectionAlignment (section), getAlignedValue (section.size, section) ); noRelocs = section.info->noRelocs; for (uint32_t j = 0; j < noRelocs; j++) { COFF_reloc rel = section.info->relocs[j]; debugBelch( " type 0x%-4x vaddr 0x%-8lx name `", rel.Type, rel.VirtualAddress ); COFF_symbol sym = oc->info->symbols[rel.SymbolTableIndex]; printName (getSymShortName (info, &sym), oc); debugBelch("'\n" ); } debugBelch("\n" ); } debugBelch("\n" ); debugBelch("string table has size 0x%x\n", n_strtab + PEi386_STRTAB_OFFSET); debugBelch("---START of string table---\n"); for (i = 4; i < n_strtab; i++) { if (strtab[i] == 0) debugBelch("\n"); else debugBelch("%c", strtab[i] ); } debugBelch("--- END of string table---\n"); debugBelch("\n" ); for (i = 0; i < info->numberOfSymbols; i++) { COFF_symbol* symtab_i = &oc->info->symbols[i]; debugBelch( "symbol %d\n" " name `", i ); printName (getSymShortName (info, symtab_i), oc); debugBelch( "'\n" " value 0x%x\n" " 1+sec# %d\n" " type 0x%x\n" " sclass 0x%x\n" " nAux %d\n", getSymValue (info, symtab_i), getSymSectionNumber (info, symtab_i), getSymType (info, symtab_i), getSymStorageClass (info, symtab_i), getSymNumberOfAuxSymbols (info, symtab_i) ); i += getSymNumberOfAuxSymbols (info, symtab_i); } debugBelch("\n" ); return true; } bool ocGetNames_PEi386 ( ObjectCode* oc ) { bool has_code_section = false; SymbolName* sname = NULL; SymbolAddr* addr = NULL; unsigned int i; COFF_HEADER_INFO *info = oc->info->ch_info; /* Copy section information into the ObjectCode. */ for (i = 0; i < info->numberOfSections; i++) { uint8_t* start; uint8_t* end; uint32_t sz; /* By default consider all section as CODE or DATA, which means we want to load them. */ SectionKind kind = SECTIONKIND_CODE_OR_RODATA; Section section = oc->sections[i]; IF_DEBUG(linker, debugBelch("section name = %s\n", section.info->name )); /* The PE file section flag indicates whether the section contains code or data. */ if (section.info->props & IMAGE_SCN_CNT_CODE) { has_code_section = has_code_section || section.size > 0; kind = SECTIONKIND_CODE_OR_RODATA; } if (section.info->props & IMAGE_SCN_CNT_INITIALIZED_DATA) kind = SECTIONKIND_CODE_OR_RODATA; /* Check next if it contains any uninitialized data */ if (section.info->props & IMAGE_SCN_CNT_UNINITIALIZED_DATA) kind = SECTIONKIND_RWDATA; /* Finally check if it can be discarded. This will also ignore .debug sections */ if ( section.info->props & IMAGE_SCN_MEM_DISCARDABLE || section.info->props & IMAGE_SCN_LNK_REMOVE) kind = SECTIONKIND_OTHER; if (0==strncmp(".ctors", section.info->name, 6)) { kind = SECTIONKIND_INIT_ARRAY; oc->info->init = &oc->sections[i]; } if (0==strncmp(".dtors", section.info->name, 6)) { kind = SECTIONKIND_FINIT_ARRAY; oc->info->finit = &oc->sections[i]; } if ( 0 == strncmp(".stab" , section.info->name, 5 ) || 0 == strncmp(".stabstr" , section.info->name, 8 ) || 0 == strncmp(".pdata" , section.info->name, 6 ) || 0 == strncmp(".xdata" , section.info->name, 6 ) || 0 == strncmp(".debug" , section.info->name, 6 ) || 0 == strncmp(".rdata$zzz", section.info->name, 10)) kind = SECTIONKIND_DEBUG; if (0==strncmp(".idata", section.info->name, 6)) kind = SECTIONKIND_IMPORT; /* See Note [BFD import library]. */ if (0==strncmp(".idata$7", section.info->name, 8)) kind = SECTIONKIND_IMPORT_LIBRARY; if (0==strncmp(".idata$6", section.info->name, 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 = (SymbolName*)section.start+2; COFF_symbol* sym = &oc->info->symbols[info->numberOfSymbols-1]; addr = get_sym_name( getSymShortName (info, sym), oc); IF_DEBUG(linker, debugBelch("addImportSymbol `%s' => `%s'\n", sname, (char*)addr)); /* We're going to free the any data associated with the import library without copying the sections. So we have to duplicate the symbol name and values before the pointers become invalid. */ sname = strdup (sname); addr = strdup (addr); if (!ghciInsertSymbolTable(oc->fileName, symhash, sname, addr, false, oc)) { releaseOcInfo (oc); stgFree (oc->image); oc->image = NULL; return false; } setImportSymbol (oc, sname); /* Don't process this oc any further. Just exit. */ oc->n_symbols = 0; oc->symbols = NULL; stgFree (oc->image); oc->image = NULL; releaseOcInfo (oc); oc->status = OBJECT_DONT_RESOLVE; return true; } /* Allocate space for any (local, anonymous) .bss sections. */ if (0==strncmp(".bss", section.info->name, 4)) { uint32_t bss_sz; uint8_t* zspace; /* sof 10/05: the PE spec text isn't too clear regarding what * the SizeOfRawData field is supposed to hold for object * file sections containing just uninitialized data -- for executables, * it is supposed to be zero; unclear what it's supposed to be * for object files. However, VirtualSize is guaranteed to be * zero for object files, which definitely suggests that SizeOfRawData * will be non-zero (where else would the size of this .bss section be * stored?) Looking at the COFF_section info for incoming object files, * this certainly appears to be the case. * * => I suspect we've been incorrectly handling .bss sections in * (relocatable) object files up until now. This turned out to bite us * with ghc-6.4.1's use of gcc-3.4.x, which has started to emit * initially-zeroed-out local 'static' variable decls into the .bss * section. (The specific function in Q which triggered this is * libraries/base/cbits/dirUtils.c:__hscore_getFolderPath()) * * TODO: check if this comment is still relevant. */ if (section.info->virtualSize == 0 && section.size == 0) continue; /* This is a non-empty .bss section. Allocate zeroed space for it */ bss_sz = section.info->virtualSize; if (bss_sz < section.size) { bss_sz = section.size; } zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)"); oc->sections[i].start = zspace; oc->sections[i].size = bss_sz; section = oc->sections[i]; /* debugBelch("BSS anon section at 0x%x\n", zspace); */ } /* Allocate space for the sections since we have a real oc. We initially mark it the region as non-accessible. But will adjust as we go along. */ if (!oc->info->image) { /* See Note [Memory allocation]. */ ASSERT(code_heap); oc->info->image = HeapAlloc (code_heap, HEAP_ZERO_MEMORY, oc->info->secBytesTotal); if (!oc->info->image) barf ("Could not allocate any heap memory from private heap."); } CHECK(section.size == 0 || section.info->virtualSize == 0); sz = section.size; if (sz < section.info->virtualSize) sz = section.info->virtualSize; start = section.start; end = start + sz; if (kind != SECTIONKIND_OTHER && end > start) { /* See Note [Section alignment]. */ addCopySection(oc, &oc->sections[i], kind, SECTION_NOMEM, start, sz); addProddableBlock(oc, oc->sections[i].start, sz); } } /* Copy exported symbols into the ObjectCode. */ oc->n_symbols = info->numberOfSymbols; oc->symbols = stgCallocBytes(sizeof(Symbol_t), oc->n_symbols, "ocGetNames_PEi386(oc->symbols)"); /* Work out the size of the global BSS section */ StgWord globalBssSize = 0; for (i=0; i < info->numberOfSymbols; i++) { COFF_symbol* sym = &oc->info->symbols[i]; if (getSymSectionNumber (info, sym) == IMAGE_SYM_UNDEFINED && getSymValue (info, sym) > 0 && getSymStorageClass (info, sym) != IMAGE_SYM_CLASS_SECTION) { globalBssSize += getSymValue (info, sym); } i += getSymNumberOfAuxSymbols (info, sym); } /* Allocate BSS space */ SymbolAddr* bss = NULL; if (globalBssSize > 0) { bss = stgCallocBytes(1, globalBssSize, "ocGetNames_PEi386(non-anonymous bss)"); addSection(&oc->sections[oc->n_sections-1], SECTIONKIND_RWDATA, SECTION_MALLOC, bss, globalBssSize, 0, 0, 0); IF_DEBUG(linker, debugBelch("bss @ %p %" FMT_Word "\n", bss, globalBssSize)); addProddableBlock(oc, bss, globalBssSize); } else { addSection(&oc->sections[oc->n_sections-1], SECTIONKIND_OTHER, SECTION_NOMEM, NULL, 0, 0, 0, 0); } /* At this point we're done with oc->image and all relevant memory have been copied. Release it to free up the memory. */ stgFree (oc->image); oc->image = NULL; for (i = 0; i < (uint32_t)oc->n_symbols; i++) { COFF_symbol* sym = &oc->info->symbols[i]; int32_t secNumber = getSymSectionNumber (info, sym); uint32_t symValue = getSymValue (info, sym); uint8_t symStorageClass = getSymStorageClass (info, sym); addr = NULL; bool isWeak = false; sname = get_sym_name (getSymShortName (info, sym), oc); Section *section = secNumber > 0 ? &oc->sections[secNumber-1] : NULL; if ( secNumber != IMAGE_SYM_UNDEFINED && secNumber > 0 && section && section->kind != SECTIONKIND_IMPORT_LIBRARY) { /* This symbol is global and defined, viz, exported */ /* for IMAGE_SYMCLASS_EXTERNAL && !IMAGE_SYM_UNDEFINED, the address of the symbol is: address of relevant section + offset in section */ if (symStorageClass == IMAGE_SYM_CLASS_EXTERNAL || ( symStorageClass == IMAGE_SYM_CLASS_STATIC && section->info->props & IMAGE_SCN_LNK_COMDAT) ) { addr = (SymbolAddr*)((size_t)section->start + symValue); isWeak = section->info->props & IMAGE_SCN_LNK_COMDAT; } } else if (symStorageClass == IMAGE_SYM_CLASS_WEAK_EXTERNAL) { isWeak = true; } else if ( secNumber == IMAGE_SYM_UNDEFINED && symValue > 0) { /* This symbol isn't in any section at all, ie, global bss. Allocate zeroed space for it from the BSS section */ addr = bss; bss = (SymbolAddr*)((StgWord)bss + (StgWord)symValue); IF_DEBUG(linker, debugBelch("bss symbol @ %p %u\n", addr, symValue)); } else if (secNumber > 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 = section->start; if (strlen(dllName) == 0 || dllName[0] == 0 || has_code_section) continue; pathchar* dirName = pathdir(oc->fileName); HsPtr token = addLibrarySearchPath(dirName); stgFree(dirName); sym = &oc->info->symbols[oc->n_symbols-1]; sname = get_sym_name (getSymShortName (info, sym), oc); 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 _iname when defined, but are named _head_ 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(sname)+1; char *tmp = stgMallocBytes(size * sizeof(char), "ocGetNames_PEi386"); strncpy (tmp, 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 mangling. Their names start with _ or __ yet they drop this when making the _head_ symbol. So do the same. */ while (tmp[start]=='_') start++; snprintf (sname, size, "_head_%s", tmp+start); sname[size-start]='\0'; stgFree(tmp); sname = strdup (sname); if (!ghciInsertSymbolTable(oc->fileName, symhash, sname, addr, false, oc)) return false; break; } if ((addr != NULL || isWeak) && (!section || (section && section->kind != SECTIONKIND_IMPORT))) { /* debugBelch("addSymbol %p `%s' Weak:%lld \n", addr, sname, isWeak); */ sname = strdup (sname); IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr, sname)); ASSERT(i < (uint32_t)oc->n_symbols); oc->symbols[i].name = sname; oc->symbols[i].addr = addr; if (isWeak) { setWeakSymbol(oc, sname); } if (! ghciInsertSymbolTable(oc->fileName, symhash, sname, addr, isWeak, oc)) return false; } else { /* We're skipping the symbol, but if we ever load this object file we'll want to skip it then too. */ oc->symbols[i].name = NULL; oc->symbols[i].addr = NULL; } i += getSymNumberOfAuxSymbols (info, sym); } return true; } #if defined(x86_64_HOST_ARCH) /* We've already reserved a room for symbol extras in loadObj, * so simply set correct pointer here. */ bool ocAllocateExtras_PEi386 ( ObjectCode* oc ) { /* If the ObjectCode was unloaded we don't need a trampoline, it's likely an import library so we're discarding it earlier. */ if (!oc->info) return false; const int mask = default_alignment - 1; size_t origin = oc->info->trampoline; oc->symbol_extras = (SymbolExtra*)((uintptr_t)(oc->info->image + origin + mask) & ~mask); oc->first_symbol_extra = 0; COFF_HEADER_INFO *info = oc->info->ch_info; oc->n_symbol_extras = info->numberOfSymbols; return true; } static size_t makeSymbolExtra_PEi386( ObjectCode* oc, uint64_t index, size_t s, char* symbol ) { unsigned int curr_thunk; SymbolExtra *extra; curr_thunk = oc->first_symbol_extra + index; if (index >= oc->n_symbol_extras) { IF_DEBUG(linker, debugBelch("makeSymbolExtra first:%d, num:%lu, member:%" PATH_FMT ", index:%llu\n", curr_thunk, oc->n_symbol_extras, oc->archiveMemberName, index)); barf("Can't allocate thunk for `%s' in `%" PATH_FMT "' with member `%" PATH_FMT "'", symbol, oc->fileName, oc->archiveMemberName); } extra = oc->symbol_extras + curr_thunk; if (!extra->addr) { // jmp *-14(%rip) static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF }; extra->addr = (uint64_t)s; memcpy(extra->jumpIsland, jmp, 6); } return (size_t)extra->jumpIsland; } void ocProtectExtras(ObjectCode* oc STG_UNUSED) { } #endif /* x86_64_HOST_ARCH */ bool ocResolve_PEi386 ( ObjectCode* oc ) { uint64_t A; size_t S; SymbolAddr* pP; unsigned int i; uint32_t j, noRelocs; /* ToDo: should be variable-sized? But is at least safe in the sense of buffer-overrun-proof. */ uint8_t symbol[1000]; /* debugBelch("resolving for %s\n", oc->fileName); */ /* Such libraries have been partially freed and can't be resolved. */ if (oc->status == OBJECT_DONT_RESOLVE) return 1; COFF_HEADER_INFO *info = oc->info->ch_info; uint32_t numberOfSections = info->numberOfSections; for (i = 0; i < numberOfSections; i++) { Section section = oc->sections[i]; /* Ignore sections called which contain stabs debugging information. */ if (section.kind == SECTIONKIND_DEBUG) continue; noRelocs = section.info->noRelocs; for (j = 0; j < noRelocs; j++) { COFF_symbol* sym; COFF_reloc* reloc = §ion.info->relocs[j]; /* the location to patch */ pP = (SymbolAddr*)( (uintptr_t)section.start + (uintptr_t)reloc->VirtualAddress - (uintptr_t)section.info->virtualAddr ); /* the existing contents of pP */ A = *(uint32_t*)pP; /* the symbol to connect to */ uint64_t symIndex = reloc->SymbolTableIndex; sym = &oc->info->symbols[symIndex]; IF_DEBUG(linker, debugBelch( "reloc sec %2d num %3d: type 0x%-4x " "vaddr 0x%-8lx name `", i, j, reloc->Type, reloc->VirtualAddress ); printName (getSymShortName (info, sym), oc); debugBelch("'\n" )); if (getSymStorageClass (info, sym) == IMAGE_SYM_CLASS_STATIC) { Section section = oc->sections[getSymSectionNumber (info, sym)-1]; S = ((size_t)(section.start)) + ((size_t)(getSymValue (info, sym))); } else { copyName ( getSymShortName (info, sym), oc, symbol, sizeof(symbol)-1 ); S = (size_t) lookupDependentSymbol( (char*)symbol, oc ); if ((void*)S == NULL) { errorBelch(" | %" PATH_FMT ": unknown symbol `%s'", oc->fileName, symbol); releaseOcInfo (oc); return false; } } /* All supported relocations write at least 4 bytes */ checkProddableBlock(oc, pP, 4); switch (reloc->Type) { #if defined(i386_HOST_ARCH) case IMAGE_REL_I386_DIR32: case IMAGE_REL_I386_DIR32NB: *(uint32_t *)pP = S + A; break; case IMAGE_REL_I386_REL32: /* Tricky. We have to insert a displacement at pP which, when added to the PC for the _next_ insn, gives the address of the target (S). Problem is to know the address of the next insn when we only know pP. We assume that this literal field is always the last in the insn, so that the address of the next insn is pP+4 -- hence the constant 4. Also I don't know if A should be added, but so far it has always been zero. SOF 05/2005: 'A' (old contents of *pP) have been observed to contain values other than zero (the 'wx' object file that came with wxhaskell-0.9.4; dunno how it was compiled..). So, add displacement to old value instead of asserting A to be zero. Fixes wxhaskell-related crashes, and no other ill effects have been observed. Update: the reason why we're seeing these more elaborate relocations is due to a switch in how the NCG compiles SRTs and offsets to them from info tables. SRTs live in .(ro)data, while info tables live in .text, causing GAS to emit REL32/DISP32 relocations with non-zero values. Adding the displacement is the right thing to do. */ *(uint32_t *)pP = ((uint32_t)S) + A - ((uint32_t)(size_t)pP) - 4; break; #elif defined(x86_64_HOST_ARCH) case 1: /* R_X86_64_64 (ELF constant 1) - IMAGE_REL_AMD64_ADDR64 (PE constant 1) */ { uint64_t A; checkProddableBlock(oc, pP, 8); A = *(uint64_t*)pP; *(uint64_t *)pP = S + A; break; } case 2: /* R_X86_64_32 (ELF constant 10) - IMAGE_REL_AMD64_ADDR32 (PE constant 2) */ case 3: /* R_X86_64_32S (ELF constant 11) - IMAGE_REL_AMD64_ADDR32NB (PE constant 3) */ case 17: /* R_X86_64_32S ELF constant, no PE mapping. See note [ELF constant in PE file] */ { uint64_t v; v = S + A; // N.B. in the case of the sign-extended relocations we must ensure that v // fits in a signed 32-bit value. See #15808. if (((int64_t) v > (int64_t) INT32_MAX) || ((int64_t) v < (int64_t) INT32_MIN)) { copyName (getSymShortName (info, sym), oc, symbol, sizeof(symbol)-1); S = makeSymbolExtra_PEi386(oc, symIndex, S, (char *)symbol); /* And retry */ v = S + A; if (((int64_t) v > (int64_t) INT32_MAX) || ((int64_t) v < (int64_t) INT32_MIN)) { barf("IMAGE_REL_AMD64_ADDR32[NB]: High bits are set in %zx for %s", v, (char *)symbol); } } *(uint32_t *)pP = (uint32_t)v; break; } case 4: /* R_X86_64_PC32 (ELF constant 2) - IMAGE_REL_AMD64_REL32 (PE constant 4) */ { intptr_t v; v = S + (int32_t)A - ((intptr_t)pP) - 4; if ((v > (int64_t) INT32_MAX) || (v < (int64_t) INT32_MIN)) { /* Make the trampoline then */ copyName (getSymShortName (info, sym), oc, symbol, sizeof(symbol)-1); S = makeSymbolExtra_PEi386(oc, symIndex, S, (char *)symbol); /* And retry */ v = S + (int32_t)A - ((intptr_t)pP) - 4; if ((v > (int64_t) INT32_MAX) || (v < (int64_t) INT32_MIN)) { barf("IMAGE_REL_AMD64_REL32: High bits are set in %zx for %s", v, (char *)symbol); } } *(uint32_t *)pP = (uint32_t)v; break; } #endif default: debugBelch("%" PATH_FMT ": unhandled PEi386 relocation type %d\n", oc->fileName, reloc->Type); releaseOcInfo (oc); return false; } } } IF_DEBUG(linker, debugBelch("completed %" PATH_FMT "\n", oc->fileName)); return true; } /* Note [ELF constant in PE file] For some reason, the PE files produced by GHC contain a linux relocation constant 17 (0x11) in the object files. As far as I (Phyx-) can tell this constant doesn't seem like it's coming from GHC, or at least I could not find anything in the .s output that GHC produces which specifies the relocation type. This leads me to believe that this is a bug in GAS. However because this constant is there we must deal with it. This is done by mapping it to the equivalent in behaviour PE relocation constant 0x03. See #9907 */ bool ocRunInit_PEi386 ( ObjectCode *oc ) { if (!oc || !oc->info || !oc->info->init) { return true; } int argc, envc; char **argv, **envv; getProgArgv(&argc, &argv); getProgEnvv(&envc, &envv); Section section = *oc->info->init; CHECK(SECTIONKIND_INIT_ARRAY == section.kind); uint8_t *init_startC = section.start; init_t *init_start = (init_t*)init_startC; init_t *init_end = (init_t*)(init_startC + section.size); // ctors are run *backwards*! for (init_t *init = init_end - 1; init >= init_start; init--) (*init)(argc, argv, envv); freeProgEnvv(envc, envv); releaseOcInfo (oc); return true; } SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl) { RtsSymbolInfo *pinfo; if (!ghciLookupSymbolInfo(symhash, lbl, &pinfo)) { IF_DEBUG(linker, debugBelch("lookupSymbol: symbol '%s' not found\n", lbl)); SymbolAddr* sym; /* See Note [mingw-w64 name decoration scheme] */ #if !defined(x86_64_HOST_ARCH) zapTrailingAtSign ( lbl ); #endif sym = lookupSymbolInDLLs(lbl); return sym; // might be NULL if not found } else { // If Windows, perform initialization of uninitialized // Symbols from the C runtime which was loaded above. // We do this on lookup to prevent the hit when // The symbol isn't being used. if (pinfo->value == (void*)0xBAADF00D) { char symBuffer[50]; sprintf(symBuffer, "_%s", lbl); static HMODULE msvcrt = NULL; if (!msvcrt) msvcrt = GetModuleHandle("msvcrt"); pinfo->value = GetProcAddress(msvcrt, symBuffer); } else if (pinfo && pinfo->owner && isSymbolImport (pinfo->owner, lbl)) { /* See Note [BFD import library]. */ HINSTANCE dllInstance = (HINSTANCE)lookupDependentSymbol(pinfo->value, NULL); 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; } return loadSymbol(lbl, pinfo); } } /* ----------------------------------------------------------------------------- * Section management. */ /* See Note [Section alignment]. */ static void addCopySection (ObjectCode *oc, Section *s, SectionKind kind, SectionAlloc alloc, void* start, StgWord size) { char* pos = oc->info->image + oc->info->secBytesUsed; char* newStart = (char*)getAlignedMemory ((uint8_t*)pos, *s); memcpy (newStart, start, size); uintptr_t offset = (uintptr_t)newStart - (uintptr_t)oc->info->image; oc->info->secBytesUsed = (size_t)offset + size; start = newStart; /* Initially I wanted to apply the right memory protection to the region and which would leaved the gaps in between the regions as inaccessible memory to prevent exploits. The problem is protection is always on page granularity, so we can use less memory and be insecure or use more memory and be secure. For now, I've chosen lower memory over secure as the first pass, this doesn't regress security over the current implementation. After this patch I will change to different implementation that will fix the mem protection and keep the memory size small. */ addSection (s, kind, alloc, start, size, 0, 0, 0); } /* ----------------------------------------------------------------------------- * Debugging operations. */ pathchar* resolveSymbolAddr_PEi386 (pathchar* buffer, int size, SymbolAddr* symbol, uintptr_t* top ){ SYMBOL_INFO sym; ZeroMemory (&sym, sizeof(SYMBOL_INFO)); sym.MaxNameLen = sizeof(char) * 1024; DWORD64 uDisplacement = 0; HANDLE hProcess = GetCurrentProcess(); ObjectCode* obj = NULL; uintptr_t start, end; *top = 0; pathprintf (buffer, size, WSTR("0x%" PRIxPTR), symbol); if (SymFromAddr (hProcess, (uintptr_t)symbol, &uDisplacement, &sym)) { /* Try using Windows symbols. */ wcscat (buffer, WSTR(" ")); pathchar* name = mkPath (sym.Name); wcscat (buffer, name); stgFree (name); if (uDisplacement != 0) { int64_t displacement = (int64_t)uDisplacement; pathchar s_disp[50]; if (displacement < 0) pathprintf ((pathchar*)s_disp, 50, WSTR("-%ld"), -displacement); else pathprintf ((pathchar*)s_disp, 50, WSTR("+%ld"), displacement); wcscat (buffer, s_disp); } } else { /* Try to calculate from information inside the rts. */ uintptr_t loc = (uintptr_t)symbol; for (ObjectCode* oc = objects; oc; oc = oc->next) { for (int i = 0; i < oc->n_sections; i++) { Section section = oc->sections[i]; start = (uintptr_t)section.start; end = start + section.size; if (loc > start && loc <= end) { wcscat (buffer, WSTR(" ")); if (oc->archiveMemberName) { wcscat (buffer, oc->archiveMemberName); } else { wcscat (buffer, oc->fileName); } pathchar s_disp[50]; pathprintf (s_disp, 50, WSTR("+0x%" PRIxPTR), loc - start); wcscat (buffer, s_disp); obj = oc; goto exit_loop; } } } /* If we managed to make it here, we must not have any symbols nor be dealing with code we've linked. The only thing left is an internal segfault or one in a dynamic library. So let's enumerate the module address space. */ HMODULE *hMods = NULL; DWORD cbNeeded; EnumProcessModules (hProcess, hMods, 0, &cbNeeded); hMods = stgMallocBytes (cbNeeded, "resolveSymbolAddr_PEi386"); if (EnumProcessModules (hProcess, hMods, cbNeeded, &cbNeeded)) { uintptr_t loc = (uintptr_t)symbol; MODULEINFO info; for (uint32_t i = 0; i < cbNeeded / sizeof(HMODULE); i++) { ZeroMemory (&info, sizeof (MODULEINFO)); if (GetModuleInformation (hProcess, hMods[i], &info, sizeof(MODULEINFO))) { uintptr_t start = (uintptr_t)info.lpBaseOfDll; uintptr_t end = start + info.SizeOfImage; if (loc >= start && loc < end) { /* Hoera, finally found some information. */ pathchar tmp[MAX_PATH]; if (GetModuleFileNameExW (hProcess, hMods[i], tmp, MAX_PATH)) { wcscat (buffer, WSTR(" ")); wcscat (buffer, tmp); pathprintf (tmp, MAX_PATH, WSTR("+0x%" PRIxPTR), loc - start); wcscat (buffer, tmp); } break; } } } } stgFree(hMods); } /* Finally any file/line number. */ IMAGEHLP_LINE64 lineInfo = {0}; DWORD dwDisplacement = 0; exit_loop: if (SymGetLineFromAddr64(hProcess, (uintptr_t)symbol, &dwDisplacement, &lineInfo)) { /* Try using Windows symbols. */ pathchar s_line[512]; pathprintf ((pathchar*) s_line, 512, WSTR(" %ls (%lu)"), lineInfo.FileName, lineInfo.LineNumber); wcscat (buffer, s_line); if (dwDisplacement != 0) { pathprintf ((pathchar*) s_line, 512, WSTR(" +%lu byte%s"), dwDisplacement, (dwDisplacement == 1 ? WSTR("") : WSTR("s"))); } wcscat (buffer, s_line); } else if (obj) { /* Try to calculate from information inside the rts. */ typedef struct _SymX { SymbolName* name; uintptr_t loc; } SymX; SymX* locs = stgCallocBytes (sizeof(SymX), obj->n_symbols, "resolveSymbolAddr"); int blanks = 0; for (int i = 0; i < obj->n_symbols; i++) { SymbolName* sym = obj->symbols[i].name; if (sym == NULL) { blanks++; continue; } RtsSymbolInfo* a = NULL; ghciLookupSymbolInfo(symhash, sym, &a); if (a) { SymX sx = {0}; sx.name = sym; sx.loc = (uintptr_t)a->value; locs[i] = sx; } } int comp (const void * elem1, const void * elem2) { SymX f = *((SymX*)elem1); SymX s = *((SymX*)elem2); if (f.loc > s.loc) return 1; if (f.loc < s.loc) return -1; return 0; } qsort (locs, obj->n_symbols, sizeof (SymX), comp); uintptr_t key = (uintptr_t)symbol; SymX* res = NULL; for (int x = blanks; x < obj->n_symbols; x++) { if (x < (obj->n_symbols -1)) { if (locs[x].loc >= key && key < locs[x+1].loc) { res = &locs[x]; break; } } else { if (locs[x].loc >= key) { res = &locs[x]; break; } } } if (res) { pathchar s_disp[512]; *top = (uintptr_t)res->loc; pathprintf ((pathchar*)s_disp, 512, WSTR("\n\t\t (%s+0x%" PRIxPTR ")"), res->name, res->loc - key); wcscat (buffer, s_disp); } stgFree (locs); } return buffer; } #endif /* mingw32_HOST_OS */