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