Clean up RTS Linker Windows.
[ghc.git] / rts / linker / PEi386.c
1 /* --------------------------------------------------------------------------
2 * PEi386(+) specifics (Win32 targets)
3 * ------------------------------------------------------------------------*/
4
5 /* The information for this linker comes from
6 Microsoft Portable Executable
7 and Common Object File Format Specification
8 revision 8.3 February 2013
9
10 It can be found online at:
11
12 https://msdn.microsoft.com/en-us/windows/hardware/gg463119.aspx
13
14 Things move, so if that fails, try searching for it via
15
16 http://www.google.com/search?q=PE+COFF+specification
17
18 The ultimate reference for the PE format is the Winnt.h
19 header file that comes with the Platform SDKs; as always,
20 implementations will drift wrt their documentation.
21
22 A good background article on the PE format is Matt Pietrek's
23 March 1994 article in Microsoft System Journal (MSJ)
24 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
25 Win32 Portable Executable File Format." The info in there
26 has recently been updated in a two part article in
27 MSDN magazine, issues Feb and March 2002,
28 "Inside Windows: An In-Depth Look into the Win32 Portable
29 Executable File Format"
30
31 John Levine's book "Linkers and Loaders" contains useful
32 info on PE too.
33
34 The PE specification doesn't specify how to do the actual
35 relocations. For this reason, and because both PE and ELF are
36 based on COFF, the relocations for the PEi386+ code is based on
37 the ELF relocations for the equivalent relocation type.
38
39 The ELF ABI can be found at
40
41 http://www.x86-64.org/documentation/abi.pdf
42
43 The current code is based on version 0.99.6 - October 2013
44 */
45
46 #include "Rts.h"
47
48 #if defined(x86_64_HOST_ARCH)
49 #define USED_IF_x86_64_HOST_ARCH /* Nothing */
50 #else
51 #define USED_IF_x86_64_HOST_ARCH STG_UNUSED
52 #endif
53
54 #ifdef mingw32_HOST_OS
55
56 #include "RtsUtils.h"
57 #include "RtsSymbolInfo.h"
58 #include "GetEnv.h"
59 #include "linker/PEi386.h"
60 #include "LinkerInternals.h"
61
62 #include <windows.h>
63 #include <shfolder.h> /* SHGetFolderPathW */
64 #include <math.h>
65 #include <wchar.h>
66 #include <stdbool.h>
67 #include <stdint.h>
68
69 static uint8_t* cstring_from_COFF_symbol_name(
70 uint8_t* name,
71 uint8_t* strtab);
72
73 #if defined(x86_64_HOST_ARCH)
74 static size_t makeSymbolExtra_PEi386(
75 ObjectCode* oc,
76 size_t s,
77 SymbolName* symbol);
78 #endif
79
80 static void addDLLHandle(
81 pathchar* dll_name,
82 HINSTANCE instance);
83
84 static bool verifyCOFFHeader(
85 COFF_header *hdr,
86 pathchar *filename);
87
88 /* Add ld symbol for PE image base. */
89 #if defined(__GNUC__)
90 #define __ImageBase __MINGW_LSYMBOL(_image_base__)
91 #endif
92
93 /* Get the base of the module. */
94 /* This symbol is defined by ld. */
95 extern IMAGE_DOS_HEADER __ImageBase;
96 #define __image_base (void*)((HINSTANCE)&__ImageBase)
97
98 void initLinker_PEi386()
99 {
100 if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"),
101 symhash, "__image_base__", __image_base, HS_BOOL_TRUE, NULL)) {
102 barf("ghciInsertSymbolTable failed");
103 }
104
105 #if defined(mingw32_HOST_OS)
106 /*
107 * These two libraries cause problems when added to the static link,
108 * but are necessary for resolving symbols in GHCi, hence we load
109 * them manually here.
110 */
111 addDLL(WSTR("msvcrt"));
112 addDLL(WSTR("kernel32"));
113 addDLLHandle(WSTR("*.exe"), GetModuleHandle(NULL));
114 #endif
115 }
116
117 /* A list thereof. */
118 static OpenedDLL* opened_dlls = NULL;
119
120 /* A list thereof. */
121 static IndirectAddr* indirects = NULL;
122
123 /* Adds a DLL instance to the list of DLLs in which to search for symbols. */
124 static void addDLLHandle(pathchar* dll_name, HINSTANCE instance) {
125 OpenedDLL* o_dll;
126 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLLHandle" );
127 o_dll->name = dll_name ? pathdup(dll_name) : NULL;
128 o_dll->instance = instance;
129 o_dll->next = opened_dlls;
130 opened_dlls = o_dll;
131 }
132
133 void freePreloadObjectFile_PEi386(ObjectCode *oc)
134 {
135 VirtualFree(oc->image - PEi386_IMAGE_OFFSET, 0, MEM_RELEASE);
136
137 IndirectAddr *ia, *ia_next;
138 ia = indirects;
139 while (ia != NULL) {
140 ia_next = ia->next;
141 stgFree(ia);
142 ia = ia_next;
143 }
144 indirects = NULL;
145 }
146
147 const char *
148 addDLL_PEi386( pathchar *dll_name )
149 {
150 /* ------------------- Win32 DLL loader ------------------- */
151
152 pathchar* buf;
153 OpenedDLL* o_dll;
154 HINSTANCE instance;
155
156 IF_DEBUG(linker, debugBelch("addDLL; dll_name = `%" PATH_FMT "'\n", dll_name));
157
158 /* See if we've already got it, and ignore if so. */
159 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
160 if (0 == pathcmp(o_dll->name, dll_name))
161 return NULL;
162 }
163
164 /* The file name has no suffix (yet) so that we can try
165 both foo.dll and foo.drv
166
167 The documentation for LoadLibrary says:
168 If no file name extension is specified in the lpFileName
169 parameter, the default library extension .dll is
170 appended. However, the file name string can include a trailing
171 point character (.) to indicate that the module name has no
172 extension. */
173
174 size_t bufsize = pathlen(dll_name) + 10;
175 buf = stgMallocBytes(bufsize * sizeof(wchar_t), "addDLL");
176
177 /* These are ordered by probability of success and order we'd like them */
178 const wchar_t *formats[] = { L"%ls.DLL", L"%ls.DRV", L"lib%ls.DLL", L"%ls" };
179 const DWORD flags[] = { LOAD_LIBRARY_SEARCH_USER_DIRS | LOAD_LIBRARY_SEARCH_DEFAULT_DIRS, 0 };
180
181 int cFormat, cFlag;
182 int flags_start = 1; // Assume we don't support the new API
183
184 /* Detect if newer API are available, if not, skip the first flags entry */
185 if (GetProcAddress((HMODULE)LoadLibraryW(L"Kernel32.DLL"), "AddDllDirectory")) {
186 flags_start = 0;
187 }
188
189 /* Iterate through the possible flags and formats */
190 for (cFlag = flags_start; cFlag < 2; cFlag++)
191 {
192 for (cFormat = 0; cFormat < 4; cFormat++)
193 {
194 snwprintf(buf, bufsize, formats[cFormat], dll_name);
195 instance = LoadLibraryExW(buf, NULL, flags[cFlag]);
196 if (instance == NULL)
197 {
198 if (GetLastError() != ERROR_MOD_NOT_FOUND)
199 {
200 goto error;
201 }
202 }
203 else
204 {
205 break; // We're done. DLL has been loaded.
206 }
207 }
208 }
209
210 // Check if we managed to load the DLL
211 if (instance == NULL) {
212 goto error;
213 }
214
215 stgFree(buf);
216
217 addDLLHandle(dll_name, instance);
218
219 return NULL;
220
221 error:
222 stgFree(buf);
223
224 char* errormsg = malloc(sizeof(char) * 80);
225 snprintf(errormsg, 80, "addDLL: %" PATH_FMT " or dependencies not loaded. (Win32 error %lu)", dll_name, GetLastError());
226 /* LoadLibrary failed; return a ptr to the error msg. */
227 return errormsg;
228 }
229
230 pathchar* findSystemLibrary_PEi386( pathchar* dll_name )
231 {
232 const unsigned int init_buf_size = 1024;
233 unsigned int bufsize = init_buf_size;
234 wchar_t* result = malloc(sizeof(wchar_t) * bufsize);
235 DWORD wResult = SearchPathW(NULL, dll_name, NULL, bufsize, result, NULL);
236
237 if (wResult > bufsize) {
238 result = realloc(result, sizeof(wchar_t) * wResult);
239 wResult = SearchPathW(NULL, dll_name, NULL, wResult, result, NULL);
240 }
241
242
243 if (!wResult) {
244 free(result);
245 return NULL;
246 }
247
248 return result;
249 }
250
251 HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path)
252 {
253 HINSTANCE hDLL = LoadLibraryW(L"Kernel32.DLL");
254 LPAddDLLDirectory AddDllDirectory = (LPAddDLLDirectory)GetProcAddress((HMODULE)hDLL, "AddDllDirectory");
255
256 HsPtr result = NULL;
257
258 const unsigned int init_buf_size = 4096;
259 int bufsize = init_buf_size;
260
261 // Make sure the path is an absolute path
262 WCHAR* abs_path = malloc(sizeof(WCHAR) * init_buf_size);
263 DWORD wResult = GetFullPathNameW(dll_path, bufsize, abs_path, NULL);
264 if (!wResult){
265 sysErrorBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError());
266 }
267 else if (wResult > init_buf_size) {
268 abs_path = realloc(abs_path, sizeof(WCHAR) * wResult);
269 if (!GetFullPathNameW(dll_path, bufsize, abs_path, NULL)) {
270 sysErrorBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError());
271 }
272 }
273
274 if (AddDllDirectory) {
275 result = AddDllDirectory(abs_path);
276 }
277 else
278 {
279 warnMissingKBLibraryPaths();
280 WCHAR* str = malloc(sizeof(WCHAR) * init_buf_size);
281 wResult = GetEnvironmentVariableW(L"PATH", str, bufsize);
282
283 if (wResult > init_buf_size) {
284 str = realloc(str, sizeof(WCHAR) * wResult);
285 bufsize = wResult;
286 wResult = GetEnvironmentVariableW(L"PATH", str, bufsize);
287 if (!wResult) {
288 sysErrorBelch("addLibrarySearchPath[GetEnvironmentVariableW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError());
289 }
290 }
291
292 bufsize = wResult + 2 + pathlen(abs_path);
293 wchar_t* newPath = malloc(sizeof(wchar_t) * bufsize);
294
295 wcscpy(newPath, abs_path);
296 wcscat(newPath, L";");
297 wcscat(newPath, str);
298 if (!SetEnvironmentVariableW(L"PATH", (LPCWSTR)newPath)) {
299 sysErrorBelch("addLibrarySearchPath[SetEnvironmentVariableW]: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError());
300 }
301
302 free(newPath);
303 free(abs_path);
304
305 return str;
306 }
307
308 if (!result) {
309 sysErrorBelch("addLibrarySearchPath: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError());
310 free(abs_path);
311 return NULL;
312 }
313
314 free(abs_path);
315 return result;
316 }
317
318 bool removeLibrarySearchPath_PEi386(HsPtr dll_path_index)
319 {
320 bool result = false;
321
322 if (dll_path_index != NULL) {
323 HINSTANCE hDLL = LoadLibraryW(L"Kernel32.DLL");
324 LPRemoveDLLDirectory RemoveDllDirectory = (LPRemoveDLLDirectory)GetProcAddress((HMODULE)hDLL, "RemoveDllDirectory");
325
326 if (RemoveDllDirectory) {
327 result = RemoveDllDirectory(dll_path_index);
328 // dll_path_index is now invalid, do not use it after this point.
329 }
330 else
331 {
332 warnMissingKBLibraryPaths();
333 result = SetEnvironmentVariableW(L"PATH", (LPCWSTR)dll_path_index);
334 free(dll_path_index);
335 }
336
337 if (!result) {
338 sysErrorBelch("removeLibrarySearchPath: (Win32 error %lu)", GetLastError());
339 return false;
340 }
341 }
342
343 return result == 0;
344 }
345
346
347 /* We assume file pointer is right at the
348 beginning of COFF object.
349 */
350 char *
351 allocateImageAndTrampolines (
352 pathchar* arch_name, char* member_name,
353 FILE* f USED_IF_x86_64_HOST_ARCH,
354 int size,
355 int isThin USED_IF_x86_64_HOST_ARCH)
356 {
357 char* image;
358 #if defined(x86_64_HOST_ARCH)
359 if (!isThin)
360 {
361 /* PeCoff contains number of symbols right in it's header, so
362 we can reserve the room for symbolExtras right here. */
363 COFF_header hdr;
364 size_t n;
365
366 n = fread(&hdr, 1, sizeof_COFF_header, f);
367 if (n != sizeof_COFF_header) {
368 errorBelch("getNumberOfSymbols: error whilst reading `%s' header in `%" PATH_FMT "'",
369 member_name, arch_name);
370 return NULL;
371 }
372 fseek(f, -(long int)sizeof_COFF_header, SEEK_CUR);
373
374 if (!verifyCOFFHeader(&hdr, arch_name)) {
375 return 0;
376 }
377
378 /* We get back 8-byte aligned memory (is that guaranteed?), but
379 the offsets to the sections within the file are all 4 mod 8
380 (is that guaranteed?). We therefore need to offset the image
381 by 4, so that all the pointers are 8-byte aligned, so that
382 pointer tagging works. */
383 /* For 32-bit case we don't need this, hence we use macro PEi386_IMAGE_OFFSET,
384 which equals to 4 for 64-bit case and 0 for 32-bit case. */
385 /* We allocate trampolines area for all symbols right behind
386 image data, aligned on 8. */
387 size = ((PEi386_IMAGE_OFFSET + size + 0x7) & ~0x7)
388 + hdr.NumberOfSymbols * sizeof(SymbolExtra);
389 }
390 #endif
391 image = VirtualAlloc(NULL, size,
392 MEM_RESERVE | MEM_COMMIT,
393 PAGE_EXECUTE_READWRITE);
394
395 if (image == NULL) {
396 errorBelch("%" PATH_FMT ": failed to allocate memory for image for %s",
397 arch_name, member_name);
398 return NULL;
399 }
400
401 return image + PEi386_IMAGE_OFFSET;
402 }
403
404 bool findAndLoadImportLibrary(ObjectCode* oc)
405 {
406 int i;
407
408 COFF_header* hdr;
409 COFF_section* sectab;
410 COFF_symbol* symtab;
411 uint8_t* strtab;
412
413 hdr = (COFF_header*)(oc->image);
414 sectab = (COFF_section*)(
415 ((uint8_t*)(oc->image))
416 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
417 );
418
419 symtab = (COFF_symbol*)(
420 ((uint8_t*)(oc->image))
421 + hdr->PointerToSymbolTable
422 );
423
424 strtab = ((uint8_t*)symtab)
425 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
426
427 for (i = 0; i < oc->n_sections; i++)
428 {
429 COFF_section* sectab_i
430 = (COFF_section*)myindex(sizeof_COFF_section, sectab, i);
431
432 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
433
434 // Find the first entry containing a valid .idata$7 section.
435 if (strcmp(secname, ".idata$7") == 0) {
436 /* First load the containing DLL if not loaded. */
437 Section section = oc->sections[i];
438
439 pathchar* dirName = pathdir(oc->fileName);
440 HsPtr token = addLibrarySearchPath(dirName);
441 stgFree(dirName);
442 char* dllName = (char*)section.start;
443
444 if (strlen(dllName) == 0 || dllName[0] == ' ')
445 {
446 continue;
447 }
448
449 IF_DEBUG(linker, debugBelch("lookupSymbol: on-demand '%ls' => `%s'\n", oc->fileName, dllName));
450
451 pathchar* dll = mkPath(dllName);
452 removeLibrarySearchPath(token);
453
454 const char* result = addDLL(dll);
455 stgFree(dll);
456
457 if (result != NULL) {
458 errorBelch("Could not load `%s'. Reason: %s\n", (char*)dllName, result);
459 return false;
460 }
461
462 break;
463 }
464
465 stgFree(secname);
466 }
467
468 return true;
469 }
470
471 bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f )
472 {
473 char* image;
474 static bool load_dll_warn = false;
475
476 if (load_dll_warn) { return 0; }
477
478 /* Based on Import Library specification. PE Spec section 7.1 */
479
480 COFF_import_header hdr;
481 size_t n;
482
483 n = fread(&hdr, 1, sizeof_COFF_import_Header, f);
484 if (n != sizeof(COFF_header)) {
485 errorBelch("getNumberOfSymbols: error whilst reading `%s' header in `%" PATH_FMT "'\n",
486 member_name, arch_name);
487 return false;
488 }
489
490 if (hdr.Sig1 != 0x0 || hdr.Sig2 != IMPORT_OBJECT_HDR_SIG2) {
491 fseek(f, -(long int)sizeof_COFF_import_Header, SEEK_CUR);
492 IF_DEBUG(linker, debugBelch("loadArchive: Object `%s` is not an import lib. Skipping...\n", member_name));
493 return false;
494 }
495
496 IF_DEBUG(linker, debugBelch("loadArchive: reading %lu bytes at %ld\n", hdr.SizeOfData, ftell(f)));
497
498 image = malloc(hdr.SizeOfData);
499 n = fread(image, 1, hdr.SizeOfData, f);
500 if (n != hdr.SizeOfData) {
501 errorBelch("loadArchive: error whilst reading `%s' header in `%" PATH_FMT "'. Did not read enough bytes.\n",
502 member_name, arch_name);
503 }
504
505 char* symbol = strtok(image, "\0");
506 int symLen = strlen(symbol) + 1;
507 int nameLen = n - symLen;
508 char* dllName = malloc(sizeof(char) * nameLen);
509 dllName = strncpy(dllName, image + symLen, nameLen);
510 pathchar* dll = malloc(sizeof(wchar_t) * nameLen);
511 mbstowcs(dll, dllName, nameLen);
512 free(dllName);
513
514 IF_DEBUG(linker, debugBelch("loadArchive: read symbol %s from lib `%" PATH_FMT "'\n", symbol, dll));
515 const char* result = addDLL(dll);
516
517 free(image);
518
519 if (result != NULL) {
520 errorBelch("Could not load `%" PATH_FMT "'. Reason: %s\n", dll, result);
521 load_dll_warn = true;
522
523 free(dll);
524 fseek(f, -(n + sizeof_COFF_import_Header), SEEK_CUR);
525 return false;
526 }
527
528 free(dll);
529 return true;
530 }
531
532 static void
533 printName ( uint8_t* name, uint8_t* strtab )
534 {
535 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
536 uint32_t strtab_offset = * (uint32_t*)(name+4);
537 debugBelch("%s", strtab + strtab_offset );
538 } else {
539 int i;
540 for (i = 0; i < 8; i++) {
541 if (name[i] == 0) break;
542 debugBelch("%c", name[i] );
543 }
544 }
545 }
546
547
548 static void
549 copyName ( uint8_t* name, uint8_t* strtab, uint8_t* dst, int dstSize )
550 {
551 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
552 uint32_t strtab_offset = * (uint32_t*)(name+4);
553 strncpy ( (char*)dst, (char*)strtab+strtab_offset, dstSize );
554 dst[dstSize-1] = 0;
555 } else {
556 int i = 0;
557 while (1) {
558 if (i >= 8) break;
559 if (name[i] == 0) break;
560 dst[i] = name[i];
561 i++;
562 }
563 dst[i] = 0;
564 }
565 }
566
567
568 static uint8_t *
569 cstring_from_COFF_symbol_name ( uint8_t* name, uint8_t* strtab )
570 {
571 uint8_t* newstr;
572 /* If the string is longer than 8 bytes, look in the
573 string table for it -- this will be correctly zero terminated.
574 */
575 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
576 uint32_t strtab_offset = * (uint32_t*)(name+4);
577 return strtab + strtab_offset;
578 }
579 /* Otherwise, if shorter than 8 bytes, return the original,
580 which by defn is correctly terminated.
581 */
582 if (name[7]==0) return name;
583 /* The annoying case: 8 bytes. Copy into a temporary
584 (XXX which is never freed ...)
585 */
586 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
587 ASSERT(newstr);
588 strncpy((char*)newstr,(char*)name,8);
589 newstr[8] = 0;
590 return newstr;
591 }
592
593 /* Getting the name of a section is mildly tricky, so we make a
594 function for it. Sadly, in one case we have to copy the string
595 (when it is exactly 8 bytes long there's no trailing '\0'), so for
596 consistency we *always* copy the string; the caller must free it
597 */
598 char *
599 cstring_from_section_name (uint8_t* name, uint8_t* strtab)
600 {
601 char *newstr;
602
603 if (name[0]=='/') {
604 int strtab_offset = strtol((char*)name+1,NULL,10);
605 int len = strlen(((char*)strtab) + strtab_offset);
606
607 newstr = stgMallocBytes(len+1, "cstring_from_section_symbol_name");
608 strcpy(newstr, (char*)strtab + strtab_offset);
609 return newstr;
610 }
611 else
612 {
613 newstr = stgMallocBytes(9, "cstring_from_section_symbol_name");
614 ASSERT(newstr);
615 strncpy(newstr,(char*)name,8);
616 newstr[8] = 0;
617 return newstr;
618 }
619 }
620
621 /* See Note [mingw-w64 name decoration scheme] */
622 #ifndef x86_64_HOST_ARCH
623 static void
624 zapTrailingAtSign ( uint8_t* sym )
625 {
626 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
627 int i, j;
628 if (sym[0] == 0) return;
629 i = 0;
630 while (sym[i] != 0) i++;
631 i--;
632 j = i;
633 while (j > 0 && my_isdigit(sym[j])) j--;
634 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
635 # undef my_isdigit
636 }
637 #endif
638
639 SymbolAddr*
640 lookupSymbolInDLLs ( uint8_t *lbl )
641 {
642 OpenedDLL* o_dll;
643 SymbolAddr* sym;
644
645 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
646 /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */
647
648 sym = GetProcAddress(o_dll->instance, (char*)(lbl+STRIP_LEADING_UNDERSCORE));
649 if (sym != NULL) {
650 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
651 return sym;
652 }
653
654 /* Ticket #2283.
655 Long description: http://support.microsoft.com/kb/132044
656 tl;dr:
657 If C/C++ compiler sees __declspec(dllimport) ... foo ...
658 it generates call *__imp_foo, and __imp_foo here has exactly
659 the same semantics as in __imp_foo = GetProcAddress(..., "foo")
660 */
661 if (sym == NULL && strncmp ((const char*)lbl, "__imp_", 6) == 0) {
662 sym = GetProcAddress(o_dll->instance, (char*)(lbl+6+STRIP_LEADING_UNDERSCORE));
663 if (sym != NULL) {
664 IndirectAddr* ret;
665 ret = stgMallocBytes( sizeof(IndirectAddr), "lookupSymbolInDLLs" );
666 ret->addr = sym;
667 ret->next = indirects;
668 indirects = ret;
669 IF_DEBUG(linker,
670 debugBelch("warning: %s from %S is linked instead of %s\n",
671 (char*)(lbl+6+STRIP_LEADING_UNDERSCORE), o_dll->name, (char*)lbl));
672 return (void*) & ret->addr;
673 }
674 }
675
676 sym = GetProcAddress(o_dll->instance, (char*)lbl);
677 if (sym != NULL) {
678 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
679 return sym;
680 }
681 }
682 return NULL;
683 }
684
685 static bool
686 verifyCOFFHeader ( COFF_header *hdr, pathchar *fileName )
687 {
688 #if defined(i386_HOST_ARCH)
689 if (hdr->Machine != IMAGE_FILE_MACHINE_I386) {
690 errorBelch("%" PATH_FMT ": Not x86 PEi386", fileName);
691 return false;
692 }
693 #elif defined(x86_64_HOST_ARCH)
694 if (hdr->Machine != IMAGE_FILE_MACHINE_AMD64) {
695 errorBelch("%" PATH_FMT ": Not x86_64 PEi386", fileName);
696 return false;
697 }
698 #else
699 errorBelch("PEi386 not supported on this arch");
700 #endif
701
702 if (hdr->SizeOfOptionalHeader != 0) {
703 errorBelch("%" PATH_FMT ": PEi386 with nonempty optional header",
704 fileName);
705 return 0;
706 }
707 if ( /* (hdr->Characteristics & IMAGE_FILE_RELOCS_STRIPPED) || */
708 (hdr->Characteristics & IMAGE_FILE_EXECUTABLE_IMAGE) ||
709 (hdr->Characteristics & IMAGE_FILE_DLL ) ||
710 (hdr->Characteristics & IMAGE_FILE_SYSTEM ) ) {
711 errorBelch("%" PATH_FMT ": Not a PEi386 object file", fileName);
712 return false;
713 }
714 if ( (hdr->Characteristics & IMAGE_FILE_BYTES_REVERSED_HI)
715 /* || !(hdr->Characteristics & IMAGE_FILE_32BIT_MACHINE) */ ) {
716 errorBelch("%" PATH_FMT ": Invalid PEi386 word size or endiannness: %d",
717 fileName,
718 (int)(hdr->Characteristics));
719 return false;
720 }
721 return true;
722 }
723
724 bool
725 ocVerifyImage_PEi386 ( ObjectCode* oc )
726 {
727 int i;
728 uint32_t j, noRelocs;
729 COFF_header* hdr;
730 COFF_section* sectab;
731 COFF_symbol* symtab;
732 uint8_t* strtab;
733 /* debugBelch("\nLOADING %s\n", oc->fileName); */
734 hdr = (COFF_header*)(oc->image);
735 sectab = (COFF_section*) (
736 ((uint8_t*)(oc->image))
737 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
738 );
739 symtab = (COFF_symbol*) (
740 ((uint8_t*)(oc->image))
741 + hdr->PointerToSymbolTable
742 );
743 strtab = ((uint8_t*)symtab)
744 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
745
746 if (!verifyCOFFHeader(hdr, oc->fileName)) {
747 return false;
748 }
749
750 /* If the string table size is way crazy, this might indicate that
751 there are more than 64k relocations, despite claims to the
752 contrary. Hence this test. */
753 /* debugBelch("strtab size %d\n", * (uint32_t*)strtab); */
754 #if 0
755 if ( (*(uint32_t*)strtab) > 600000 ) {
756 /* Note that 600k has no special significance other than being
757 big enough to handle the almost-2MB-sized lumps that
758 constitute HSwin32*.o. */
759 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
760 return false;
761 }
762 #endif
763
764 /* .BSS Section is initialized in ocGetNames_PEi386
765 but we need the Sections array initialized here already. */
766 Section *sections;
767 sections = (Section*)stgCallocBytes(
768 sizeof(Section),
769 hdr->NumberOfSections + 1, /* +1 for the global BSS section see ocGetNames_PEi386 */
770 "ocVerifyImage_PEi386(sections)");
771 oc->sections = sections;
772 oc->n_sections = hdr->NumberOfSections + 1;
773
774 /* Initialize the Sections */
775 for (i = 0; i < hdr->NumberOfSections; i++) {
776 COFF_section* sectab_i
777 = (COFF_section*)
778 myindex(sizeof_COFF_section, sectab, i);
779
780 /* Calculate the start of the data section */
781 sections[i].start = oc->image + sectab_i->PointerToRawData;
782 }
783
784 /* No further verification after this point; only debug printing. */
785 i = 0;
786 IF_DEBUG(linker, i=1);
787 if (i == 0) return true;
788
789 debugBelch("sectab offset = %" FMT_SizeT "\n",
790 ((uint8_t*)sectab) - ((uint8_t*)hdr) );
791 debugBelch("symtab offset = %" FMT_SizeT "\n",
792 ((uint8_t*)symtab) - ((uint8_t*)hdr) );
793 debugBelch("strtab offset = %" FMT_SizeT "\n",
794 ((uint8_t*)strtab) - ((uint8_t*)hdr) );
795
796 debugBelch("\n" );
797 debugBelch( "Machine: 0x%x\n", (uint32_t)(hdr->Machine) );
798 debugBelch( "# sections: %d\n", (uint32_t)(hdr->NumberOfSections) );
799 debugBelch( "time/date: 0x%x\n", (uint32_t)(hdr->TimeDateStamp) );
800 debugBelch( "symtab offset: %d\n", (uint32_t)(hdr->PointerToSymbolTable) );
801 debugBelch( "# symbols: %d\n", (uint32_t)(hdr->NumberOfSymbols) );
802 debugBelch( "sz of opt hdr: %d\n", (uint32_t)(hdr->SizeOfOptionalHeader) );
803 debugBelch( "characteristics: 0x%x\n", (uint32_t)(hdr->Characteristics) );
804
805 /* Print the section table. */
806 debugBelch("\n" );
807 for (i = 0; i < hdr->NumberOfSections; i++) {
808 COFF_reloc* reltab;
809 COFF_section* sectab_i
810 = (COFF_section*)
811 myindex ( sizeof_COFF_section, sectab, i );
812 Section section = sections[i];
813 debugBelch(
814 "\n"
815 "section %d\n"
816 " name `",
817 i
818 );
819 printName ( sectab_i->Name, strtab );
820 debugBelch(
821 "'\n"
822 " vsize %lu\n"
823 " vaddr %lu\n"
824 " data sz %lu\n"
825 " data off 0x%p\n"
826 " num rel %hu\n"
827 " off rel %lu\n"
828 " ptr raw 0x%lx\n",
829 sectab_i->Misc.VirtualSize,
830 sectab_i->VirtualAddress,
831 sectab_i->SizeOfRawData,
832 section.start,
833 sectab_i->NumberOfRelocations,
834 sectab_i->PointerToRelocations,
835 sectab_i->PointerToRawData
836 );
837 reltab = (COFF_reloc*) (
838 ((uint8_t*)(oc->image)) + sectab_i->PointerToRelocations
839 );
840
841 if ( sectab_i->Characteristics & IMAGE_SCN_LNK_NRELOC_OVFL ) {
842 /* If the relocation field (a short) has overflowed, the
843 * real count can be found in the first reloc entry.
844 *
845 * See Section 4.1 (last para) of the PE spec (rev6.0).
846 */
847 COFF_reloc* rel = (COFF_reloc*)
848 myindex ( sizeof_COFF_reloc, reltab, 0 );
849 noRelocs = rel->VirtualAddress;
850 j = 1;
851 } else {
852 noRelocs = sectab_i->NumberOfRelocations;
853 j = 0;
854 }
855
856 for (; j < noRelocs; j++) {
857 COFF_symbol* sym;
858 COFF_reloc* rel = (COFF_reloc*)
859 myindex ( sizeof_COFF_reloc, reltab, j );
860 debugBelch(
861 " type 0x%-4x vaddr 0x%-8lx name `",
862 (uint32_t)rel->Type,
863 rel->VirtualAddress );
864 sym = (COFF_symbol*)
865 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
866 /* Hmm..mysterious looking offset - what's it for? SOF */
867 printName ( sym->N.ShortName, strtab -10 );
868 debugBelch("'\n" );
869 }
870
871 debugBelch("\n" );
872 }
873 debugBelch("\n" );
874 debugBelch("string table has size 0x%x\n", * (uint32_t*)strtab );
875 debugBelch("---START of string table---\n");
876 for (i = 4; i < *(int32_t*)strtab; i++) {
877 if (strtab[i] == 0)
878 debugBelch("\n"); else
879 debugBelch("%c", strtab[i] );
880 }
881 debugBelch("--- END of string table---\n");
882
883 debugBelch("\n" );
884 i = 0;
885 while (1) {
886 COFF_symbol* symtab_i;
887 if (i >= (int32_t)(hdr->NumberOfSymbols)) break;
888 symtab_i = (COFF_symbol*)
889 myindex ( sizeof_COFF_symbol, symtab, i );
890 debugBelch(
891 "symbol %d\n"
892 " name `",
893 i
894 );
895 printName ( symtab_i->N.ShortName, strtab );
896 debugBelch(
897 "'\n"
898 " value 0x%lx\n"
899 " 1+sec# %d\n"
900 " type 0x%x\n"
901 " sclass 0x%x\n"
902 " nAux %d\n",
903 symtab_i->Value,
904 (int32_t)(symtab_i->SectionNumber),
905 (uint32_t)symtab_i->Type,
906 (uint32_t)symtab_i->StorageClass,
907 (uint32_t)symtab_i->NumberOfAuxSymbols
908 );
909 i += symtab_i->NumberOfAuxSymbols;
910 i++;
911 }
912
913 debugBelch("\n" );
914 return true;
915 }
916
917 bool
918 ocGetNames_PEi386 ( ObjectCode* oc )
919 {
920 COFF_header* hdr;
921 COFF_section* sectab;
922 COFF_symbol* symtab;
923 uint8_t* strtab;
924
925 uint8_t* sname;
926 SymbolAddr* addr;
927 int i;
928
929 hdr = (COFF_header*)(oc->image);
930 sectab = (COFF_section*) (
931 ((uint8_t*)(oc->image))
932 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
933 );
934 symtab = (COFF_symbol*) (
935 ((uint8_t*)(oc->image))
936 + hdr->PointerToSymbolTable
937 );
938 strtab = ((uint8_t*)(oc->image))
939 + hdr->PointerToSymbolTable
940 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
941
942 /* Allocate space for any (local, anonymous) .bss sections. */
943
944 for (i = 0; i < hdr->NumberOfSections; i++) {
945 uint32_t bss_sz;
946 uint8_t* zspace;
947 COFF_section* sectab_i
948 = (COFF_section*)
949 myindex ( sizeof_COFF_section, sectab, i );
950
951 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
952
953 if (0 != strcmp(secname, ".bss")) {
954 stgFree(secname);
955 continue;
956 }
957
958 stgFree(secname);
959
960 /* sof 10/05: the PE spec text isn't too clear regarding what
961 * the SizeOfRawData field is supposed to hold for object
962 * file sections containing just uninitialized data -- for executables,
963 * it is supposed to be zero; unclear what it's supposed to be
964 * for object files. However, VirtualSize is guaranteed to be
965 * zero for object files, which definitely suggests that SizeOfRawData
966 * will be non-zero (where else would the size of this .bss section be
967 * stored?) Looking at the COFF_section info for incoming object files,
968 * this certainly appears to be the case.
969 *
970 * => I suspect we've been incorrectly handling .bss sections in (relocatable)
971 * object files up until now. This turned out to bite us with ghc-6.4.1's use
972 * of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
973 * variable decls into the .bss section. (The specific function in Q which
974 * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
975 */
976 if (sectab_i->Misc.VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
977 /* This is a non-empty .bss section.
978 Allocate zeroed space for it */
979 bss_sz = sectab_i->Misc.VirtualSize;
980 if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
981 zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
982 oc->sections[i].start = zspace;
983 addProddableBlock(oc, zspace, bss_sz);
984 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
985 }
986
987 /* Copy section information into the ObjectCode. */
988
989 for (i = 0; i < hdr->NumberOfSections; i++) {
990 uint8_t* start;
991 uint8_t* end;
992 uint32_t sz;
993
994 /* By default consider all section as CODE or DATA, which means we want to load them. */
995 SectionKind kind
996 = SECTIONKIND_CODE_OR_RODATA;
997 COFF_section* sectab_i
998 = (COFF_section*)
999 myindex ( sizeof_COFF_section, sectab, i );
1000 Section section = oc->sections[i];
1001
1002 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
1003
1004 IF_DEBUG(linker, debugBelch("section name = %s\n", secname ));
1005
1006 /* The PE file section flag indicates whether the section contains code or data. */
1007 if (sectab_i->Characteristics & IMAGE_SCN_CNT_CODE ||
1008 sectab_i->Characteristics & IMAGE_SCN_CNT_INITIALIZED_DATA)
1009 kind = SECTIONKIND_CODE_OR_RODATA;
1010
1011 /* Check next if it contains any uninitialized data */
1012 if (sectab_i->Characteristics & IMAGE_SCN_CNT_UNINITIALIZED_DATA)
1013 kind = SECTIONKIND_RWDATA;
1014
1015 /* Finally check if it can be discarded. This will also ignore .debug sections */
1016 if (sectab_i->Characteristics & IMAGE_SCN_MEM_DISCARDABLE ||
1017 sectab_i->Characteristics & IMAGE_SCN_LNK_REMOVE)
1018 kind = SECTIONKIND_OTHER;
1019
1020 if (0==strcmp(".ctors", (char*)secname))
1021 kind = SECTIONKIND_INIT_ARRAY;
1022
1023 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->Misc.VirtualSize == 0);
1024 sz = sectab_i->SizeOfRawData;
1025 if (sz < sectab_i->Misc.VirtualSize) sz = sectab_i->Misc.VirtualSize;
1026
1027 start = section.start;
1028 end = start + sz - 1;
1029
1030 if (kind != SECTIONKIND_OTHER && end >= start) {
1031 addSection(&oc->sections[i], kind, SECTION_NOMEM, start, sz, 0, 0, 0);
1032 addProddableBlock(oc, start, sz);
1033 }
1034
1035 stgFree(secname);
1036 }
1037
1038 /* Copy exported symbols into the ObjectCode. */
1039
1040 oc->n_symbols = hdr->NumberOfSymbols;
1041 oc->symbols = stgCallocBytes(sizeof(SymbolName*), oc->n_symbols,
1042 "ocGetNames_PEi386(oc->symbols)");
1043
1044 /* Work out the size of the global BSS section */
1045 StgWord globalBssSize = 0;
1046 for (i=0; i < (int)hdr->NumberOfSymbols; i++) {
1047 COFF_symbol* symtab_i;
1048 symtab_i = (COFF_symbol*)
1049 myindex ( sizeof_COFF_symbol, symtab, i );
1050 if (symtab_i->SectionNumber == IMAGE_SYM_UNDEFINED
1051 && symtab_i->Value > 0
1052 && symtab_i->StorageClass != IMAGE_SYM_CLASS_SECTION) {
1053 globalBssSize += symtab_i->Value;
1054 }
1055 i += symtab_i->NumberOfAuxSymbols;
1056 }
1057
1058 /* Allocate BSS space */
1059 SymbolAddr* bss = NULL;
1060 if (globalBssSize > 0) {
1061 bss = stgCallocBytes(1, globalBssSize,
1062 "ocGetNames_PEi386(non-anonymous bss)");
1063 addSection(&oc->sections[oc->n_sections-1],
1064 SECTIONKIND_RWDATA, SECTION_MALLOC,
1065 bss, globalBssSize, 0, 0, 0);
1066 IF_DEBUG(linker, debugBelch("bss @ %p %" FMT_Word "\n", bss, globalBssSize));
1067 addProddableBlock(oc, bss, globalBssSize);
1068 } else {
1069 addSection(&oc->sections[oc->n_sections-1],
1070 SECTIONKIND_OTHER, SECTION_NOMEM, NULL, 0, 0, 0, 0);
1071 }
1072
1073 for (i = 0; i < oc->n_symbols; i++) {
1074 COFF_symbol* symtab_i;
1075 symtab_i = (COFF_symbol*)
1076 myindex ( sizeof_COFF_symbol, symtab, i );
1077
1078 addr = NULL;
1079 bool isWeak = false;
1080 if ( symtab_i->SectionNumber != IMAGE_SYM_UNDEFINED
1081 && symtab_i->SectionNumber > 0) {
1082 /* This symbol is global and defined, viz, exported */
1083 /* for IMAGE_SYMCLASS_EXTERNAL
1084 && !IMAGE_SYM_UNDEFINED,
1085 the address of the symbol is:
1086 address of relevant section + offset in section
1087 */
1088 COFF_section* sectabent
1089 = (COFF_section*) myindex ( sizeof_COFF_section,
1090 sectab,
1091 symtab_i->SectionNumber-1 );
1092 if (symtab_i->StorageClass == IMAGE_SYM_CLASS_EXTERNAL
1093 || ( symtab_i->StorageClass == IMAGE_SYM_CLASS_STATIC
1094 && sectabent->Characteristics & IMAGE_SCN_LNK_COMDAT)
1095 ) {
1096 addr = (void*)((size_t)oc->sections[symtab_i->SectionNumber-1].start
1097 + symtab_i->Value);
1098 if (sectabent->Characteristics & IMAGE_SCN_LNK_COMDAT) {
1099 isWeak = true;
1100 }
1101 }
1102 }
1103 else if (symtab_i->StorageClass == IMAGE_SYM_CLASS_WEAK_EXTERNAL) {
1104 isWeak = true;
1105 }
1106 else if ( symtab_i->SectionNumber == IMAGE_SYM_UNDEFINED
1107 && symtab_i->Value > 0) {
1108 /* This symbol isn't in any section at all, ie, global bss.
1109 Allocate zeroed space for it from the BSS section */
1110 addr = bss;
1111 bss = (SymbolAddr*)((StgWord)bss + (StgWord)symtab_i->Value);
1112 IF_DEBUG(linker, debugBelch("bss symbol @ %p %lu\n", addr, symtab_i->Value));
1113 }
1114
1115 sname = cstring_from_COFF_symbol_name(symtab_i->N.ShortName, strtab);
1116 if (addr != NULL || isWeak) {
1117
1118 /* debugBelch("addSymbol %p `%s' Weak:%lld \n", addr, sname, isWeak); */
1119 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname));
1120 ASSERT(i >= 0 && i < oc->n_symbols);
1121 /* cstring_from_COFF_symbol_name always succeeds. */
1122 oc->symbols[i] = (SymbolName*)sname;
1123 if (isWeak) {
1124 setWeakSymbol(oc, sname);
1125 }
1126
1127 if (! ghciInsertSymbolTable(oc->fileName, symhash, (SymbolName*)sname, addr,
1128 isWeak, oc)) {
1129 return false;
1130 }
1131 } else {
1132 /* We're skipping the symbol, but if we ever load this
1133 object file we'll want to skip it then too. */
1134 oc->symbols[i] = NULL;
1135
1136 # if 0
1137 debugBelch(
1138 "IGNORING symbol %d\n"
1139 " name `",
1140 i
1141 );
1142 printName ( symtab_i->N.ShortName, strtab );
1143 debugBelch(
1144 "'\n"
1145 " value 0x%x\n"
1146 " 1+sec# %d\n"
1147 " type 0x%x\n"
1148 " sclass 0x%x\n"
1149 " nAux %d\n",
1150 symtab_i->Value,
1151 (int32_t)(symtab_i->SectionNumber),
1152 (uint32_t)symtab_i->Type,
1153 (uint32_t)symtab_i->StorageClass,
1154 (uint32_t)symtab_i->NumberOfAuxSymbols
1155 );
1156 # endif
1157 }
1158
1159 i += symtab_i->NumberOfAuxSymbols;
1160 }
1161
1162 return true;
1163 }
1164
1165 #if defined(x86_64_HOST_ARCH)
1166
1167 /* We've already reserved a room for symbol extras in loadObj,
1168 * so simply set correct pointer here.
1169 */
1170 bool
1171 ocAllocateSymbolExtras_PEi386 ( ObjectCode* oc )
1172 {
1173 oc->symbol_extras = (SymbolExtra*)(oc->image - PEi386_IMAGE_OFFSET
1174 + ((PEi386_IMAGE_OFFSET + oc->fileSize + 0x7) & ~0x7));
1175 oc->first_symbol_extra = 0;
1176 oc->n_symbol_extras = ((COFF_header*)oc->image)->NumberOfSymbols;
1177
1178 return true;
1179 }
1180
1181 static size_t
1182 makeSymbolExtra_PEi386( ObjectCode* oc, size_t s, char* symbol )
1183 {
1184 unsigned int curr_thunk;
1185 SymbolExtra *extra;
1186
1187 curr_thunk = oc->first_symbol_extra;
1188 if (curr_thunk >= oc->n_symbol_extras) {
1189 barf("Can't allocate thunk for %s", symbol);
1190 }
1191
1192 extra = oc->symbol_extras + curr_thunk;
1193
1194 // jmp *-14(%rip)
1195 static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
1196 extra->addr = (uint64_t)s;
1197 memcpy(extra->jumpIsland, jmp, 6);
1198
1199 oc->first_symbol_extra++;
1200
1201 return (size_t)extra->jumpIsland;
1202 }
1203
1204 #endif /* x86_64_HOST_ARCH */
1205
1206 bool
1207 ocResolve_PEi386 ( ObjectCode* oc )
1208 {
1209 COFF_header* hdr;
1210 COFF_section* sectab;
1211 COFF_symbol* symtab;
1212 uint8_t* strtab;
1213
1214 uint32_t A;
1215 size_t S;
1216 SymbolAddr* pP;
1217
1218 int i;
1219 uint32_t j, noRelocs;
1220
1221 /* ToDo: should be variable-sized? But is at least safe in the
1222 sense of buffer-overrun-proof. */
1223 uint8_t symbol[1000];
1224 /* debugBelch("resolving for %s\n", oc->fileName); */
1225
1226 hdr = (COFF_header*)(oc->image);
1227 sectab = (COFF_section*) (
1228 ((uint8_t*)(oc->image))
1229 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1230 );
1231 symtab = (COFF_symbol*) (
1232 ((uint8_t*)(oc->image))
1233 + hdr->PointerToSymbolTable
1234 );
1235 strtab = ((uint8_t*)(oc->image))
1236 + hdr->PointerToSymbolTable
1237 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1238
1239 for (i = 0; i < hdr->NumberOfSections; i++) {
1240 COFF_section* sectab_i
1241 = (COFF_section*)
1242 myindex ( sizeof_COFF_section, sectab, i );
1243 COFF_reloc* reltab
1244 = (COFF_reloc*) (
1245 ((uint8_t*)(oc->image)) + sectab_i->PointerToRelocations
1246 );
1247 Section section = oc->sections[i];
1248
1249 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
1250
1251 /* Ignore sections called which contain stabs debugging information. */
1252 if ( 0 == strcmp(".stab", (char*)secname)
1253 || 0 == strcmp(".stabstr", (char*)secname)
1254 || 0 == strncmp(".pdata", (char*)secname, 6)
1255 || 0 == strncmp(".xdata", (char*)secname, 6)
1256 || 0 == strncmp(".debug", (char*)secname, 6)
1257 || 0 == strcmp(".rdata$zzz", (char*)secname)) {
1258 stgFree(secname);
1259 continue;
1260 }
1261
1262 stgFree(secname);
1263
1264 if ( sectab_i->Characteristics & IMAGE_SCN_LNK_NRELOC_OVFL ) {
1265 /* If the relocation field (a short) has overflowed, the
1266 * real count can be found in the first reloc entry.
1267 *
1268 * See Section 4.1 (last para) of the PE spec (rev6.0).
1269 *
1270 * Nov2003 update: the GNU linker still doesn't correctly
1271 * handle the generation of relocatable object files with
1272 * overflown relocations. Hence the output to warn of potential
1273 * troubles.
1274 */
1275 COFF_reloc* rel = (COFF_reloc*)
1276 myindex ( sizeof_COFF_reloc, reltab, 0 );
1277 noRelocs = rel->VirtualAddress;
1278
1279 /* 10/05: we now assume (and check for) a GNU ld that is capable
1280 * of handling object files with (>2^16) of relocs.
1281 */
1282 #if 0
1283 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
1284 noRelocs);
1285 #endif
1286 j = 1;
1287 } else {
1288 noRelocs = sectab_i->NumberOfRelocations;
1289 j = 0;
1290 }
1291
1292 for (; j < noRelocs; j++) {
1293 COFF_symbol* sym;
1294 COFF_reloc* reltab_j
1295 = (COFF_reloc*)
1296 myindex ( sizeof_COFF_reloc, reltab, j );
1297
1298 /* the location to patch */
1299 pP = (void*)(
1300 (size_t)section.start
1301 + reltab_j->VirtualAddress
1302 - sectab_i->VirtualAddress
1303 );
1304 /* the existing contents of pP */
1305 A = *(uint32_t*)pP;
1306 /* the symbol to connect to */
1307 sym = (COFF_symbol*)
1308 myindex ( sizeof_COFF_symbol,
1309 symtab, reltab_j->SymbolTableIndex );
1310 IF_DEBUG(linker,
1311 debugBelch(
1312 "reloc sec %2d num %3d: type 0x%-4x "
1313 "vaddr 0x%-8lx name `",
1314 i, j,
1315 (uint32_t)reltab_j->Type,
1316 reltab_j->VirtualAddress );
1317 printName ( sym->N.ShortName, strtab );
1318 debugBelch("'\n" ));
1319
1320 if (sym->StorageClass == IMAGE_SYM_CLASS_STATIC) {
1321 Section section = oc->sections[sym->SectionNumber-1];
1322 S = ((size_t)(section.start))
1323 + ((size_t)(sym->Value));
1324 } else {
1325 copyName ( sym->N.ShortName, strtab, symbol, 1000-1 );
1326 S = (size_t) lookupSymbol_( (char*)symbol );
1327 if ((void*)S == NULL) {
1328
1329 errorBelch("%" PATH_FMT ": unknown symbol `%s'\n", oc->fileName, symbol);
1330 return false;
1331 }
1332 }
1333 /* All supported relocations write at least 4 bytes */
1334 checkProddableBlock(oc, pP, 4);
1335 switch (reltab_j->Type) {
1336 #if defined(i386_HOST_ARCH)
1337 case IMAGE_REL_I386_DIR32:
1338 case IMAGE_REL_I386_DIR32NB:
1339 *(uint32_t *)pP = ((uint32_t)S) + A;
1340 break;
1341 case IMAGE_REL_I386_REL32:
1342 /* Tricky. We have to insert a displacement at
1343 pP which, when added to the PC for the _next_
1344 insn, gives the address of the target (S).
1345 Problem is to know the address of the next insn
1346 when we only know pP. We assume that this
1347 literal field is always the last in the insn,
1348 so that the address of the next insn is pP+4
1349 -- hence the constant 4.
1350 Also I don't know if A should be added, but so
1351 far it has always been zero.
1352
1353 SOF 05/2005: 'A' (old contents of *pP) have been observed
1354 to contain values other than zero (the 'wx' object file
1355 that came with wxhaskell-0.9.4; dunno how it was compiled..).
1356 So, add displacement to old value instead of asserting
1357 A to be zero. Fixes wxhaskell-related crashes, and no other
1358 ill effects have been observed.
1359
1360 Update: the reason why we're seeing these more elaborate
1361 relocations is due to a switch in how the NCG compiles SRTs
1362 and offsets to them from info tables. SRTs live in .(ro)data,
1363 while info tables live in .text, causing GAS to emit REL32/DISP32
1364 relocations with non-zero values. Adding the displacement is
1365 the right thing to do.
1366 */
1367 *(uint32_t *)pP = ((uint32_t)S) + A - ((uint32_t)(size_t)pP) - 4;
1368 break;
1369 #elif defined(x86_64_HOST_ARCH)
1370 case 1: /* R_X86_64_64 (ELF constant 1) - IMAGE_REL_AMD64_ADDR64 (PE constant 1) */
1371 {
1372 uint64_t A;
1373 checkProddableBlock(oc, pP, 8);
1374 A = *(uint64_t*)pP;
1375 *(uint64_t *)pP = ((uint64_t)S) + ((uint64_t)A);
1376 break;
1377 }
1378 case 2: /* R_X86_64_32 (ELF constant 10) - IMAGE_REL_AMD64_ADDR32 (PE constant 2) */
1379 case 3: /* R_X86_64_32S (ELF constant 11) - IMAGE_REL_AMD64_ADDR32NB (PE constant 3) */
1380 case 17: /* R_X86_64_32S ELF constant, no PE mapping. See note [ELF constant in PE file] */
1381 {
1382 size_t v;
1383 v = S + ((size_t)A);
1384 if (v >> 32) {
1385 copyName ( sym->N.ShortName, strtab, symbol, 1000-1 );
1386 S = makeSymbolExtra_PEi386(oc, S, (char *)symbol);
1387 /* And retry */
1388 v = S + ((size_t)A);
1389 if (v >> 32) {
1390 barf("IMAGE_REL_AMD64_ADDR32[NB]: High bits are set in %zx for %s",
1391 v, (char *)symbol);
1392 }
1393 }
1394 *(uint32_t *)pP = (uint32_t)v;
1395 break;
1396 }
1397 case 4: /* R_X86_64_PC32 (ELF constant 2) - IMAGE_REL_AMD64_REL32 (PE constant 4) */
1398 {
1399 intptr_t v;
1400 v = ((intptr_t)S) + ((intptr_t)(int32_t)A) - ((intptr_t)pP) - 4;
1401 if ((v >> 32) && ((-v) >> 32)) {
1402 /* Make the trampoline then */
1403 copyName ( sym->N.ShortName, strtab, symbol, 1000-1 );
1404 S = makeSymbolExtra_PEi386(oc, S, (char *)symbol);
1405 /* And retry */
1406 v = ((intptr_t)S) + ((intptr_t)(int32_t)A) - ((intptr_t)pP) - 4;
1407 if ((v >> 32) && ((-v) >> 32)) {
1408 barf("IMAGE_REL_AMD64_REL32: High bits are set in %zx for %s",
1409 v, (char *)symbol);
1410 }
1411 }
1412 *(uint32_t *)pP = (uint32_t)v;
1413 break;
1414 }
1415 #endif
1416 default:
1417 debugBelch("%" PATH_FMT ": unhandled PEi386 relocation type %d\n",
1418 oc->fileName, reltab_j->Type);
1419 return false;
1420 }
1421
1422 }
1423 }
1424
1425 IF_DEBUG(linker, debugBelch("completed %" PATH_FMT "\n", oc->fileName));
1426 return true;
1427 }
1428
1429 /*
1430 Note [ELF constant in PE file]
1431
1432 For some reason, the PE files produced by GHC contain a linux
1433 relocation constant 17 (0x11) in the object files. As far as I (Phyx-) can tell
1434 this constant doesn't seem like it's coming from GHC, or at least I could not find
1435 anything in the .s output that GHC produces which specifies the relocation type.
1436
1437 This leads me to believe that this is a bug in GAS. However because this constant is
1438 there we must deal with it. This is done by mapping it to the equivalent in behaviour PE
1439 relocation constant 0x03.
1440
1441 See #9907
1442 */
1443
1444 bool
1445 ocRunInit_PEi386 ( ObjectCode *oc )
1446 {
1447 COFF_header* hdr;
1448 COFF_section* sectab;
1449 uint8_t* strtab;
1450 int i;
1451
1452 hdr = (COFF_header*)(oc->image);
1453 sectab = (COFF_section*) (
1454 ((uint8_t*)(oc->image))
1455 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1456 );
1457 strtab = ((uint8_t*)(oc->image))
1458 + hdr->PointerToSymbolTable
1459 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1460
1461 int argc, envc;
1462 char **argv, **envv;
1463
1464 getProgArgv(&argc, &argv);
1465 getProgEnvv(&envc, &envv);
1466
1467 /* TODO: This part is just looking for .ctors section. This can be optimized
1468 and should for objects compiled with function sections as these produce a
1469 large amount of sections.
1470
1471 This can be done by saving the index of the .ctor section in the ObjectCode
1472 from ocGetNames. Then this loop isn't needed. */
1473 for (i = 0; i < hdr->NumberOfSections; i++) {
1474 COFF_section* sectab_i
1475 = (COFF_section*)
1476 myindex ( sizeof_COFF_section, sectab, i );
1477 Section section = oc->sections[i];
1478 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
1479 if (0 == strcmp(".ctors", (char*)secname)) {
1480 uint8_t *init_startC = section.start;
1481 init_t *init_start, *init_end, *init;
1482 init_start = (init_t*)init_startC;
1483 init_end = (init_t*)(init_startC + sectab_i->SizeOfRawData);
1484 // ctors are run *backwards*!
1485 for (init = init_end - 1; init >= init_start; init--) {
1486 (*init)(argc, argv, envv);
1487 }
1488 }
1489 }
1490 freeProgEnvv(envc, envv);
1491 return true;
1492 }
1493
1494 SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl)
1495 {
1496 RtsSymbolInfo *pinfo;
1497
1498 if (!ghciLookupSymbolInfo(symhash, lbl, &pinfo)) {
1499 IF_DEBUG(linker, debugBelch("lookupSymbol: symbol '%s' not found\n", lbl));
1500
1501 SymbolAddr* sym;
1502
1503 /* See Note [mingw-w64 name decoration scheme] */
1504 #ifndef x86_64_HOST_ARCH
1505 zapTrailingAtSign ( (unsigned char*)lbl );
1506 #endif
1507 sym = lookupSymbolInDLLs((unsigned char*)lbl);
1508 return sym; // might be NULL if not found
1509 } else {
1510 #if defined(mingw32_HOST_OS)
1511 // If Windows, perform initialization of uninitialized
1512 // Symbols from the C runtime which was loaded above.
1513 // We do this on lookup to prevent the hit when
1514 // The symbol isn't being used.
1515 if (pinfo->value == (void*)0xBAADF00D)
1516 {
1517 char symBuffer[50];
1518 sprintf(symBuffer, "_%s", lbl);
1519 pinfo->value = GetProcAddress(GetModuleHandle("msvcrt"), symBuffer);
1520 }
1521 #endif
1522 return loadSymbol(lbl, pinfo);
1523 }
1524 }
1525
1526 #endif /* mingw32_HOST_OS */