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