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