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