Linker: ARM: Ensure that cache flush covers all symbol extras
[ghc.git] / rts / Linker.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 2000-2012
4 *
5 * RTS Object Linker
6 *
7 * ---------------------------------------------------------------------------*/
8
9 #if 0
10 #include "PosixSource.h"
11 #endif
12
13 #include "Rts.h"
14 #include "HsFFI.h"
15
16 #include "sm/Storage.h"
17 #include "Stats.h"
18 #include "Hash.h"
19 #include "LinkerInternals.h"
20 #include "RtsUtils.h"
21 #include "Trace.h"
22 #include "StgPrimFloat.h" // for __int_encodeFloat etc.
23 #include "Proftimer.h"
24 #include "GetEnv.h"
25 #include "Stable.h"
26 #include "RtsSymbols.h"
27 #include "Profiling.h"
28
29 #if !defined(mingw32_HOST_OS)
30 #include "posix/Signals.h"
31 #endif
32
33 // get protos for is*()
34 #include <ctype.h>
35
36 #ifdef HAVE_SYS_TYPES_H
37 #include <sys/types.h>
38 #endif
39
40 #include <inttypes.h>
41 #include <stdlib.h>
42 #include <string.h>
43 #include <stdio.h>
44 #include <assert.h>
45 #include <libgen.h>
46
47 #ifdef HAVE_SYS_STAT_H
48 #include <sys/stat.h>
49 #endif
50
51 #if defined(HAVE_DLFCN_H)
52 #include <dlfcn.h>
53 #endif
54
55 #if (defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS)) \
56 || (!defined(powerpc_HOST_ARCH) && \
57 ( defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || \
58 defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS ) || \
59 defined(openbsd_HOST_OS ) || defined(darwin_HOST_OS ) || \
60 defined(kfreebsdgnu_HOST_OS) || defined(gnu_HOST_OS ) || \
61 defined(solaris2_HOST_OS)))
62 /* Don't use mmap on powerpc/darwin as the mmap there doesn't support
63 * reallocating but we need to allocate jump islands just after each
64 * object images. Otherwise relative branches to jump islands can fail
65 * due to 24-bits displacement overflow.
66 */
67 #define USE_MMAP 1
68 #include <fcntl.h>
69 #include <sys/mman.h>
70
71 #ifdef HAVE_UNISTD_H
72 #include <unistd.h>
73 #endif
74
75 #else
76
77 #define USE_MMAP 0
78
79 #endif
80
81
82 /* PowerPC has relative branch instructions with only 24 bit displacements
83 * and therefore needs jump islands contiguous with each object code module.
84 */
85 #if (USE_MMAP && defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS))
86 #define USE_CONTIGUOUS_MMAP 1
87 #else
88 #define USE_CONTIGUOUS_MMAP 0
89 #endif
90
91 #if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS) || defined(gnu_HOST_OS)
92 # define OBJFORMAT_ELF
93 # include <regex.h> // regex is already used by dlopen() so this is OK
94 // to use here without requiring an additional lib
95 #elif defined (mingw32_HOST_OS)
96 # define OBJFORMAT_PEi386
97 # include <windows.h>
98 # include <shfolder.h> /* SHGetFolderPathW */
99 # include <math.h>
100 # include <wchar.h>
101 #elif defined(darwin_HOST_OS)
102 # define OBJFORMAT_MACHO
103 # include <regex.h>
104 # include <mach/machine.h>
105 # include <mach-o/fat.h>
106 # include <mach-o/loader.h>
107 # include <mach-o/nlist.h>
108 # include <mach-o/reloc.h>
109 #if defined(powerpc_HOST_ARCH)
110 # include <mach-o/ppc/reloc.h>
111 #endif
112 #if defined(x86_64_HOST_ARCH)
113 # include <mach-o/x86_64/reloc.h>
114 #endif
115 #endif
116
117 #if defined(x86_64_HOST_ARCH) && defined(darwin_HOST_OS)
118 #define ALWAYS_PIC
119 #endif
120
121 #if defined(dragonfly_HOST_OS)
122 #include <sys/tls.h>
123 #endif
124
125 typedef struct _RtsSymbolInfo {
126 void *value;
127 const ObjectCode *owner;
128 HsBool weak;
129 } RtsSymbolInfo;
130
131 /* Hash table mapping symbol names to RtsSymbolInfo */
132 static /*Str*/HashTable *symhash;
133
134 /* List of currently loaded objects */
135 ObjectCode *objects = NULL; /* initially empty */
136
137 /* List of objects that have been unloaded via unloadObj(), but are waiting
138 to be actually freed via checkUnload() */
139 ObjectCode *unloaded_objects = NULL; /* initially empty */
140
141 #ifdef THREADED_RTS
142 /* This protects all the Linker's global state except unloaded_objects */
143 Mutex linker_mutex;
144 /*
145 * This protects unloaded_objects. We have a separate mutex for this, because
146 * the GC needs to access unloaded_objects in checkUnload, while the linker only
147 * needs to access unloaded_objects in unloadObj(), so this allows most linker
148 * operations proceed concurrently with the GC.
149 */
150 Mutex linker_unloaded_mutex;
151 #endif
152
153 /* Type of the initializer */
154 typedef void (*init_t) (int argc, char **argv, char **env);
155
156 static HsInt isAlreadyLoaded( pathchar *path );
157 static HsInt loadOc( ObjectCode* oc );
158 static ObjectCode* mkOc( pathchar *path, char *image, int imageSize,
159 rtsBool mapped, char *archiveMemberName,
160 int misalignment
161 );
162
163 // Use wchar_t for pathnames on Windows (#5697)
164 #if defined(mingw32_HOST_OS)
165 #define pathcmp wcscmp
166 #define pathlen wcslen
167 #define pathopen _wfopen
168 #define pathstat _wstat
169 #define struct_stat struct _stat
170 #define open wopen
171 #define WSTR(s) L##s
172 #else
173 #define pathcmp strcmp
174 #define pathlen strlen
175 #define pathopen fopen
176 #define pathstat stat
177 #define struct_stat struct stat
178 #define WSTR(s) s
179 #endif
180
181 static pathchar* pathdup(pathchar *path)
182 {
183 pathchar *ret;
184 #if defined(mingw32_HOST_OS)
185 ret = wcsdup(path);
186 #else
187 /* sigh, strdup() isn't a POSIX function, so do it the long way */
188 ret = stgMallocBytes( strlen(path)+1, "loadObj" );
189 strcpy(ret, path);
190 #endif
191 return ret;
192 }
193
194
195 #if defined(OBJFORMAT_ELF)
196 static int ocVerifyImage_ELF ( ObjectCode* oc );
197 static int ocGetNames_ELF ( ObjectCode* oc );
198 static int ocResolve_ELF ( ObjectCode* oc );
199 static int ocRunInit_ELF ( ObjectCode* oc );
200 #if NEED_SYMBOL_EXTRAS
201 static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc );
202 #endif
203 #elif defined(OBJFORMAT_PEi386)
204 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
205 static int ocGetNames_PEi386 ( ObjectCode* oc );
206 static int ocResolve_PEi386 ( ObjectCode* oc );
207 static int ocRunInit_PEi386 ( ObjectCode* oc );
208 static void *lookupSymbolInDLLs ( unsigned char *lbl );
209 /* See Note [mingw-w64 name decoration scheme] */
210 #ifndef x86_64_HOST_ARCH
211 static void zapTrailingAtSign ( unsigned char *sym );
212 #endif
213 static char *allocateImageAndTrampolines (
214 pathchar* arch_name, char* member_name,
215 #if defined(x86_64_HOST_ARCH)
216 FILE* f,
217 #endif
218 int size );
219 #if defined(x86_64_HOST_ARCH)
220 static int ocAllocateSymbolExtras_PEi386 ( ObjectCode* oc );
221 static size_t makeSymbolExtra_PEi386( ObjectCode* oc, size_t, char* symbol );
222 #define PEi386_IMAGE_OFFSET 4
223 #else
224 #define PEi386_IMAGE_OFFSET 0
225 #endif
226 #elif defined(OBJFORMAT_MACHO)
227 static int ocVerifyImage_MachO ( ObjectCode* oc );
228 static int ocGetNames_MachO ( ObjectCode* oc );
229 static int ocResolve_MachO ( ObjectCode* oc );
230 static int ocRunInit_MachO ( ObjectCode* oc );
231
232 #if (USE_MMAP == 0)
233 static int machoGetMisalignment( FILE * );
234 #endif
235 #if NEED_SYMBOL_EXTRAS
236 static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
237 #endif
238 #ifdef powerpc_HOST_ARCH
239 static void machoInitSymbolsWithoutUnderscore( void );
240 #endif
241 #endif
242
243 #if defined(OBJFORMAT_PEi386)
244 // MingW-w64 is missing these from the implementation. So we have to look them up
245 typedef DLL_DIRECTORY_COOKIE(WINAPI *LPAddDLLDirectory)(PCWSTR NewDirectory);
246 typedef WINBOOL(WINAPI *LPRemoveDLLDirectory)(DLL_DIRECTORY_COOKIE Cookie);
247 #endif
248
249 static void freeProddableBlocks (ObjectCode *oc);
250
251 #if USE_MMAP
252 /**
253 * An allocated page being filled by the allocator
254 */
255 struct m32_alloc_t {
256 void * base_addr; // Page address
257 unsigned int current_size; // Number of bytes already reserved
258 };
259
260 #define M32_MAX_PAGES 32
261
262 /**
263 * Allocator
264 *
265 * Currently an allocator is just a set of pages being filled. The maximum
266 * number of pages can be configured with M32_MAX_PAGES.
267 */
268 typedef struct m32_allocator_t {
269 struct m32_alloc_t pages[M32_MAX_PAGES];
270 } * m32_allocator;
271
272 // We use a global memory allocator
273 static struct m32_allocator_t allocator;
274
275 struct m32_allocator_t;
276 static void m32_allocator_init(struct m32_allocator_t *m32);
277 #endif
278
279 /* on x86_64 we have a problem with relocating symbol references in
280 * code that was compiled without -fPIC. By default, the small memory
281 * model is used, which assumes that symbol references can fit in a
282 * 32-bit slot. The system dynamic linker makes this work for
283 * references to shared libraries by either (a) allocating a jump
284 * table slot for code references, or (b) moving the symbol at load
285 * time (and copying its contents, if necessary) for data references.
286 *
287 * We unfortunately can't tell whether symbol references are to code
288 * or data. So for now we assume they are code (the vast majority
289 * are), and allocate jump-table slots. Unfortunately this will
290 * SILENTLY generate crashing code for data references. This hack is
291 * enabled by X86_64_ELF_NONPIC_HACK.
292 *
293 * One workaround is to use shared Haskell libraries. This is
294 * coming. Another workaround is to keep the static libraries but
295 * compile them with -fPIC, because that will generate PIC references
296 * to data which can be relocated. The PIC code is still too green to
297 * do this systematically, though.
298 *
299 * See bug #781
300 * See thread http://www.haskell.org/pipermail/cvs-ghc/2007-September/038458.html
301 *
302 * Naming Scheme for Symbol Macros
303 *
304 * SymI_*: symbol is internal to the RTS. It resides in an object
305 * file/library that is statically.
306 * SymE_*: symbol is external to the RTS library. It might be linked
307 * dynamically.
308 *
309 * Sym*_HasProto : the symbol prototype is imported in an include file
310 * or defined explicitly
311 * Sym*_NeedsProto: the symbol is undefined and we add a dummy
312 * default proto extern void sym(void);
313 */
314 #define X86_64_ELF_NONPIC_HACK 1
315
316 /* Link objects into the lower 2Gb on x86_64. GHC assumes the
317 * small memory model on this architecture (see gcc docs,
318 * -mcmodel=small).
319 *
320 * MAP_32BIT not available on OpenBSD/amd64
321 */
322 #if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
323 #define TRY_MAP_32BIT MAP_32BIT
324 #else
325 #define TRY_MAP_32BIT 0
326 #endif
327
328 /*
329 Note [The ARM/Thumb Story]
330 ~~~~~~~~~~~~~~~~~~~~~~~~~~
331
332 Support for the ARM architecture is complicated by the fact that ARM has not
333 one but several instruction encodings. The two relevant ones here are the original
334 ARM encoding and Thumb, a more dense variant of ARM supporting only a subset
335 of the instruction set.
336
337 How the CPU decodes a particular instruction is determined by a mode bit. This
338 mode bit is set on jump instructions, the value being determined by the low
339 bit of the target address: An odd address means the target is a procedure
340 encoded in the Thumb encoding whereas an even address means it's a traditional
341 ARM procedure (the actual address jumped to is even regardless of the encoding bit).
342
343 Interoperation between Thumb- and ARM-encoded object code (known as "interworking")
344 is tricky. If the linker needs to link a call by an ARM object into Thumb code
345 (or vice-versa) it will produce a jump island. This, however, is incompatible with
346 GHC's tables-next-to-code. For this reason, it is critical that GHC emit
347 exclusively ARM or Thumb objects for all Haskell code.
348
349 We still do, however, need to worry about foreign code.
350 */
351
352 /*
353 * Due to the small memory model (see above), on x86_64 we have to map
354 * all our non-PIC object files into the low 2Gb of the address space
355 * (why 2Gb and not 4Gb? Because all addresses must be reachable
356 * using a 32-bit signed PC-relative offset). On Linux we can do this
357 * using the MAP_32BIT flag to mmap(), however on other OSs
358 * (e.g. *BSD, see #2063, and also on Linux inside Xen, see #2512), we
359 * can't do this. So on these systems, we have to pick a base address
360 * in the low 2Gb of the address space and try to allocate memory from
361 * there.
362 *
363 * We pick a default address based on the OS, but also make this
364 * configurable via an RTS flag (+RTS -xm)
365 */
366 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
367
368 #if defined(MAP_32BIT)
369 // Try to use MAP_32BIT
370 #define MMAP_32BIT_BASE_DEFAULT 0
371 #else
372 // A guess: 1Gb.
373 #define MMAP_32BIT_BASE_DEFAULT 0x40000000
374 #endif
375
376 static void *mmap_32bit_base = (void *)MMAP_32BIT_BASE_DEFAULT;
377 #endif
378
379 /* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
380 #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
381 #define MAP_ANONYMOUS MAP_ANON
382 #endif
383
384 /* -----------------------------------------------------------------------------
385 * Insert symbols into hash tables, checking for duplicates.
386 *
387 * Returns: 0 on failure, nonzero on success
388 */
389
390 static int ghciInsertSymbolTable(
391 pathchar* obj_name,
392 HashTable *table,
393 const char* key,
394 void *data,
395 HsBool weak,
396 ObjectCode *owner)
397 {
398 RtsSymbolInfo *pinfo = lookupStrHashTable(table, key);
399 if (!pinfo) /* new entry */
400 {
401 pinfo = stgMallocBytes(sizeof (*pinfo), "ghciInsertToSymbolTable");
402 pinfo->value = data;
403 pinfo->owner = owner;
404 pinfo->weak = weak;
405 insertStrHashTable(table, key, pinfo);
406 return 1;
407 }
408 else if ((!pinfo->weak || pinfo->value) && weak)
409 {
410 return 1; /* duplicate weak symbol, throw it away */
411 }
412 else if (pinfo->weak) /* weak symbol is in the table */
413 {
414 /* override the weak definition with the non-weak one */
415 pinfo->value = data;
416 pinfo->owner = owner;
417 pinfo->weak = HS_BOOL_FALSE;
418 return 1;
419 }
420 debugBelch(
421 "GHC runtime linker: fatal error: I found a duplicate definition for symbol\n"
422 " %s\n"
423 "whilst processing object file\n"
424 " %" PATH_FMT "\n"
425 "This could be caused by:\n"
426 " * Loading two different object files which export the same symbol\n"
427 " * Specifying the same object file twice on the GHCi command line\n"
428 " * An incorrect `package.conf' entry, causing some object to be\n"
429 " loaded twice.\n",
430 (char*)key,
431 obj_name
432 );
433 return 0;
434 }
435
436 static HsBool ghciLookupSymbolTable(HashTable *table,
437 const char *key, void **result)
438 {
439 RtsSymbolInfo *pinfo = lookupStrHashTable(table, key);
440 if (!pinfo) {
441 *result = NULL;
442 return HS_BOOL_FALSE;
443 }
444 if (pinfo->weak)
445 IF_DEBUG(linker, debugBelch("lookup: promoting %s\n", key));
446 /* Once it's looked up, it can no longer be overridden */
447 pinfo->weak = HS_BOOL_FALSE;
448
449 *result = pinfo->value;
450 return HS_BOOL_TRUE;
451 }
452
453 static void ghciRemoveSymbolTable(HashTable *table, const char *key,
454 ObjectCode *owner)
455 {
456 RtsSymbolInfo *pinfo = lookupStrHashTable(table, key);
457 if (!pinfo || owner != pinfo->owner) return;
458 removeStrHashTable(table, key, NULL);
459 stgFree(pinfo);
460 }
461 /* -----------------------------------------------------------------------------
462 * initialize the object linker
463 */
464
465
466 static int linker_init_done = 0 ;
467
468 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
469 static void *dl_prog_handle;
470 static regex_t re_invalid;
471 static regex_t re_realso;
472 #ifdef THREADED_RTS
473 static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
474 #endif
475 #elif defined(OBJFORMAT_PEi386)
476 void addDLLHandle(pathchar* dll_name, HINSTANCE instance);
477 #endif
478
479 void initLinker (void)
480 {
481 // default to retaining CAFs for backwards compatibility. Most
482 // users will want initLinker_(0): otherwise unloadObj() will not
483 // be able to unload object files when they contain CAFs.
484 initLinker_(1);
485 }
486
487 void
488 initLinker_ (int retain_cafs)
489 {
490 RtsSymbolVal *sym;
491 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
492 int compileResult;
493 #endif
494
495 IF_DEBUG(linker, debugBelch("initLinker: start\n"));
496
497 /* Make initLinker idempotent, so we can call it
498 before every relevant operation; that means we
499 don't need to initialise the linker separately */
500 if (linker_init_done == 1) {
501 IF_DEBUG(linker, debugBelch("initLinker: idempotent return\n"));
502 return;
503 } else {
504 linker_init_done = 1;
505 }
506
507 objects = NULL;
508 unloaded_objects = NULL;
509
510 #if defined(THREADED_RTS)
511 initMutex(&linker_mutex);
512 initMutex(&linker_unloaded_mutex);
513 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
514 initMutex(&dl_mutex);
515 #endif
516 #endif
517 symhash = allocStrHashTable();
518
519 /* populate the symbol table with stuff from the RTS */
520 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
521 if (! ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"),
522 symhash, sym->lbl, sym->addr, HS_BOOL_FALSE, NULL)) {
523 barf("ghciInsertSymbolTable failed");
524 }
525 IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr));
526 }
527 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
528 machoInitSymbolsWithoutUnderscore();
529 # endif
530 /* GCC defines a special symbol __dso_handle which is resolved to NULL if
531 referenced from a statically linked module. We need to mimic this, but
532 we cannot use NULL because we use it to mean nonexistent symbols. So we
533 use an arbitrary (hopefully unique) address here.
534 */
535 if (! ghciInsertSymbolTable(WSTR("(GHCi special symbols)"),
536 symhash, "__dso_handle", (void *)0x12345687, HS_BOOL_FALSE, NULL)) {
537 barf("ghciInsertSymbolTable failed");
538 }
539
540 // Redirect newCAF to newRetainedCAF if retain_cafs is true.
541 if (! ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"), symhash,
542 MAYBE_LEADING_UNDERSCORE_STR("newCAF"),
543 retain_cafs ? newRetainedCAF : newGCdCAF,
544 HS_BOOL_FALSE, NULL)) {
545 barf("ghciInsertSymbolTable failed");
546 }
547
548 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
549 # if defined(RTLD_DEFAULT)
550 dl_prog_handle = RTLD_DEFAULT;
551 # else
552 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
553 # endif /* RTLD_DEFAULT */
554
555 compileResult = regcomp(&re_invalid,
556 "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*(invalid ELF header|file too short)",
557 REG_EXTENDED);
558 if (compileResult != 0) {
559 barf("Compiling re_invalid failed");
560 }
561 compileResult = regcomp(&re_realso,
562 "(GROUP|INPUT) *\\( *([^ )]+)",
563 REG_EXTENDED);
564 if (compileResult != 0) {
565 barf("Compiling re_realso failed");
566 }
567 # endif
568
569 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
570 if (RtsFlags.MiscFlags.linkerMemBase != 0) {
571 // User-override for mmap_32bit_base
572 mmap_32bit_base = (void*)RtsFlags.MiscFlags.linkerMemBase;
573 }
574 #endif
575
576 #if defined(mingw32_HOST_OS)
577 /*
578 * These two libraries cause problems when added to the static link,
579 * but are necessary for resolving symbols in GHCi, hence we load
580 * them manually here.
581 */
582 addDLL(WSTR("msvcrt"));
583 addDLL(WSTR("kernel32"));
584 addDLLHandle(WSTR("*.exe"), GetModuleHandle(NULL));
585 #endif
586
587 #if USE_MMAP
588 m32_allocator_init(&allocator);
589 #endif
590
591 IF_DEBUG(linker, debugBelch("initLinker: done\n"));
592 return;
593 }
594
595 void
596 exitLinker( void ) {
597 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
598 if (linker_init_done == 1) {
599 regfree(&re_invalid);
600 regfree(&re_realso);
601 #ifdef THREADED_RTS
602 closeMutex(&dl_mutex);
603 #endif
604 }
605 #endif
606 if (linker_init_done == 1) {
607 freeHashTable(symhash, free);
608 }
609 #ifdef THREADED_RTS
610 closeMutex(&linker_mutex);
611 #endif
612 }
613
614 /* -----------------------------------------------------------------------------
615 * Loading DLL or .so dynamic libraries
616 * -----------------------------------------------------------------------------
617 *
618 * Add a DLL from which symbols may be found. In the ELF case, just
619 * do RTLD_GLOBAL-style add, so no further messing around needs to
620 * happen in order that symbols in the loaded .so are findable --
621 * lookupSymbol() will subsequently see them by dlsym on the program's
622 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
623 *
624 * In the PEi386 case, open the DLLs and put handles to them in a
625 * linked list. When looking for a symbol, try all handles in the
626 * list. This means that we need to load even DLLs that are guaranteed
627 * to be in the ghc.exe image already, just so we can get a handle
628 * to give to loadSymbol, so that we can find the symbols. For such
629 * libraries, the LoadLibrary call should be a no-op except for returning
630 * the handle.
631 *
632 */
633
634 #if defined(OBJFORMAT_PEi386)
635 /* A record for storing handles into DLLs. */
636
637 typedef
638 struct _OpenedDLL {
639 pathchar* name;
640 struct _OpenedDLL* next;
641 HINSTANCE instance;
642 }
643 OpenedDLL;
644
645 /* A list thereof. */
646 static OpenedDLL* opened_dlls = NULL;
647
648 /* A record for storing indirectly linked functions from DLLs. */
649 typedef
650 struct _IndirectAddr {
651 void* addr;
652 struct _IndirectAddr* next;
653 }
654 IndirectAddr;
655
656 /* A list thereof. */
657 static IndirectAddr* indirects = NULL;
658
659 /* Adds a DLL instance to the list of DLLs in which to search for symbols. */
660 void addDLLHandle(pathchar* dll_name, HINSTANCE instance) {
661 OpenedDLL* o_dll;
662 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLLHandle" );
663 o_dll->name = dll_name ? pathdup(dll_name) : NULL;
664 o_dll->instance = instance;
665 o_dll->next = opened_dlls;
666 opened_dlls = o_dll;
667 }
668
669 #endif
670
671 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
672
673 /* Suppose in ghci we load a temporary SO for a module containing
674 f = 1
675 and then modify the module, recompile, and load another temporary
676 SO with
677 f = 2
678 Then as we don't unload the first SO, dlsym will find the
679 f = 1
680 symbol whereas we want the
681 f = 2
682 symbol. We therefore need to keep our own SO handle list, and
683 try SOs in the right order. */
684
685 typedef
686 struct _OpenedSO {
687 struct _OpenedSO* next;
688 void *handle;
689 }
690 OpenedSO;
691
692 /* A list thereof. */
693 static OpenedSO* openedSOs = NULL;
694
695 static const char *
696 internal_dlopen(const char *dll_name)
697 {
698 OpenedSO* o_so;
699 void *hdl;
700 const char *errmsg;
701 char *errmsg_copy;
702
703 // omitted: RTLD_NOW
704 // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
705 IF_DEBUG(linker,
706 debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name));
707
708 //-------------- Begin critical section ------------------
709 // This critical section is necessary because dlerror() is not
710 // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008)
711 // Also, the error message returned must be copied to preserve it
712 // (see POSIX also)
713
714 ACQUIRE_LOCK(&dl_mutex);
715 hdl = dlopen(dll_name, RTLD_LAZY|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */
716
717 errmsg = NULL;
718 if (hdl == NULL) {
719 /* dlopen failed; return a ptr to the error msg. */
720 errmsg = dlerror();
721 if (errmsg == NULL) errmsg = "addDLL: unknown error";
722 errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL");
723 strcpy(errmsg_copy, errmsg);
724 errmsg = errmsg_copy;
725 } else {
726 o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL");
727 o_so->handle = hdl;
728 o_so->next = openedSOs;
729 openedSOs = o_so;
730 }
731
732 RELEASE_LOCK(&dl_mutex);
733 //--------------- End critical section -------------------
734
735 return errmsg;
736 }
737
738 /*
739 Note [RTLD_LOCAL]
740
741 In GHCi we want to be able to override previous .so's with newly
742 loaded .so's when we recompile something. This further implies that
743 when we look up a symbol in internal_dlsym() we have to iterate
744 through the loaded libraries (in order from most recently loaded to
745 oldest) looking up the symbol in each one until we find it.
746
747 However, this can cause problems for some symbols that are copied
748 by the linker into the executable image at runtime - see #8935 for a
749 lengthy discussion. To solve that problem we need to look up
750 symbols in the main executable *first*, before attempting to look
751 them up in the loaded .so's. But in order to make that work, we
752 have to always call dlopen with RTLD_LOCAL, so that the loaded
753 libraries don't populate the global symbol table.
754 */
755
756 static void *
757 internal_dlsym(const char *symbol) {
758 OpenedSO* o_so;
759 void *v;
760
761 // We acquire dl_mutex as concurrent dl* calls may alter dlerror
762 ACQUIRE_LOCK(&dl_mutex);
763 dlerror();
764 // look in program first
765 v = dlsym(dl_prog_handle, symbol);
766 if (dlerror() == NULL) {
767 RELEASE_LOCK(&dl_mutex);
768 return v;
769 }
770
771 for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) {
772 v = dlsym(o_so->handle, symbol);
773 if (dlerror() == NULL) {
774 RELEASE_LOCK(&dl_mutex);
775 return v;
776 }
777 }
778 RELEASE_LOCK(&dl_mutex);
779 return v;
780 }
781 # endif
782
783 const char *
784 addDLL( pathchar *dll_name )
785 {
786 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
787 /* ------------------- ELF DLL loader ------------------- */
788
789 #define NMATCH 5
790 regmatch_t match[NMATCH];
791 const char *errmsg;
792 FILE* fp;
793 size_t match_length;
794 #define MAXLINE 1000
795 char line[MAXLINE];
796 int result;
797
798 IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name));
799 errmsg = internal_dlopen(dll_name);
800
801 if (errmsg == NULL) {
802 return NULL;
803 }
804
805 // GHC Trac ticket #2615
806 // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so)
807 // contain linker scripts rather than ELF-format object code. This
808 // code handles the situation by recognizing the real object code
809 // file name given in the linker script.
810 //
811 // If an "invalid ELF header" error occurs, it is assumed that the
812 // .so file contains a linker script instead of ELF object code.
813 // In this case, the code looks for the GROUP ( ... ) linker
814 // directive. If one is found, the first file name inside the
815 // parentheses is treated as the name of a dynamic library and the
816 // code attempts to dlopen that file. If this is also unsuccessful,
817 // an error message is returned.
818
819 // see if the error message is due to an invalid ELF header
820 IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg));
821 result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0);
822 IF_DEBUG(linker, debugBelch("result = %i\n", result));
823 if (result == 0) {
824 // success -- try to read the named file as a linker script
825 match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so),
826 MAXLINE-1);
827 strncpy(line, (errmsg+(match[1].rm_so)),match_length);
828 line[match_length] = '\0'; // make sure string is null-terminated
829 IF_DEBUG(linker, debugBelch ("file name = '%s'\n", line));
830 if ((fp = fopen(line, "r")) == NULL) {
831 return errmsg; // return original error if open fails
832 }
833 // try to find a GROUP or INPUT ( ... ) command
834 while (fgets(line, MAXLINE, fp) != NULL) {
835 IF_DEBUG(linker, debugBelch("input line = %s", line));
836 if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
837 // success -- try to dlopen the first named file
838 IF_DEBUG(linker, debugBelch("match%s\n",""));
839 line[match[2].rm_eo] = '\0';
840 stgFree((void*)errmsg); // Free old message before creating new one
841 errmsg = internal_dlopen(line+match[2].rm_so);
842 break;
843 }
844 // if control reaches here, no GROUP or INPUT ( ... ) directive
845 // was found and the original error message is returned to the
846 // caller
847 }
848 fclose(fp);
849 }
850 return errmsg;
851
852 # elif defined(OBJFORMAT_PEi386)
853 /* ------------------- Win32 DLL loader ------------------- */
854
855 pathchar* buf;
856 OpenedDLL* o_dll;
857 HINSTANCE instance;
858
859 IF_DEBUG(linker, debugBelch("\naddDLL; dll_name = `%" PATH_FMT "'\n", dll_name));
860
861 /* See if we've already got it, and ignore if so. */
862 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
863 if (0 == pathcmp(o_dll->name, dll_name))
864 return NULL;
865 }
866
867 /* The file name has no suffix (yet) so that we can try
868 both foo.dll and foo.drv
869
870 The documentation for LoadLibrary says:
871 If no file name extension is specified in the lpFileName
872 parameter, the default library extension .dll is
873 appended. However, the file name string can include a trailing
874 point character (.) to indicate that the module name has no
875 extension. */
876
877 size_t bufsize = pathlen(dll_name) + 10;
878 buf = stgMallocBytes(bufsize * sizeof(wchar_t), "addDLL");
879
880 /* These are ordered by probability of success and order we'd like them */
881 const wchar_t *formats[] = { L"%s.DLL", L"%s.DRV", L"lib%s.DLL", L"%s" };
882 const DWORD flags[] = { LOAD_LIBRARY_SEARCH_USER_DIRS | LOAD_LIBRARY_SEARCH_DEFAULT_DIRS, 0 };
883
884 int cFormat;
885 int cFlag;
886 int flags_start = 1; // Assume we don't support the new API
887
888 /* Detect if newer API are available, if not, skip the first flags entry */
889 if (GetProcAddress((HMODULE)LoadLibraryW(L"Kernel32.DLL"), "AddDllDirectory")) {
890 flags_start = 0;
891 }
892
893 /* Iterate through the possible flags and formats */
894 for (cFlag = flags_start; cFlag < 2; cFlag++)
895 {
896 for (cFormat = 0; cFormat < 4; cFormat++)
897 {
898 snwprintf(buf, bufsize, formats[cFormat], dll_name);
899 instance = LoadLibraryExW(buf, NULL, flags[cFlag]);
900 if (instance == NULL)
901 {
902 if (GetLastError() != ERROR_MOD_NOT_FOUND)
903 {
904 goto error;
905 }
906 }
907 else
908 {
909 break; // We're done. DLL has been loaded.
910 }
911 }
912 }
913
914 // Check if we managed to load the DLL
915 if (instance == NULL) {
916 goto error;
917 }
918
919 stgFree(buf);
920
921 addDLLHandle(dll_name, instance);
922
923 return NULL;
924
925 error:
926 stgFree(buf);
927 sysErrorBelch("addDLL: %" PATH_FMT " (Win32 error %lu)", dll_name, GetLastError());
928
929 /* LoadLibrary failed; return a ptr to the error msg. */
930 return "addDLL: could not load DLL";
931
932 # else
933 barf("addDLL: not implemented on this platform");
934 # endif
935 }
936
937 /* -----------------------------------------------------------------------------
938 * Searches the system directories to determine if there is a system DLL that
939 * satisfies the given name. This prevent GHCi from linking against a static
940 * library if a DLL is available.
941 *
942 * Returns: NULL on failure or no DLL found, else the full path to the DLL
943 * that can be loaded.
944 */
945 pathchar* findSystemLibrary(pathchar* dll_name)
946 {
947 IF_DEBUG(linker, debugBelch("\nfindSystemLibrary: dll_name = `%" PATH_FMT "'\n", dll_name));
948
949 #if defined(OBJFORMAT_PEi386)
950 const unsigned int init_buf_size = 1024;
951 unsigned int bufsize = init_buf_size;
952 wchar_t* result = malloc(sizeof(wchar_t) * bufsize);
953 DWORD wResult = SearchPathW(NULL, dll_name, NULL, bufsize, result, NULL);
954
955 if (wResult > bufsize) {
956 result = realloc(result, sizeof(wchar_t) * wResult);
957 wResult = SearchPathW(NULL, dll_name, NULL, wResult, result, NULL);
958 }
959
960
961 if (!wResult) {
962 free(result);
963 return NULL;
964 }
965
966 return result;
967 #else
968 (void)(dll_name); // Function not implemented for other platforms.
969 return NULL;
970 #endif
971 }
972
973 /* -----------------------------------------------------------------------------
974 * Emits a warning determining that the system is missing a required security
975 * update that we need to get access to the proper APIs
976 */
977 void warnMissingKBLibraryPaths( void )
978 {
979 static HsBool missing_update_warn = HS_BOOL_FALSE;
980 if (!missing_update_warn) {
981 debugBelch("Warning: If linking fails, consider installing KB2533623.\n");
982 missing_update_warn = HS_BOOL_TRUE;
983 }
984 }
985
986 /* -----------------------------------------------------------------------------
987 * appends a directory to the process DLL Load path so LoadLibrary can find it
988 *
989 * Returns: NULL on failure, or pointer to be passed to removeLibrarySearchPath to
990 * restore the search path to what it was before this call.
991 */
992 HsPtr addLibrarySearchPath(pathchar* dll_path)
993 {
994 IF_DEBUG(linker, debugBelch("\naddLibrarySearchPath: dll_path = `%" PATH_FMT "'\n", dll_path));
995
996 #if defined(OBJFORMAT_PEi386)
997 HINSTANCE hDLL = LoadLibraryW(L"Kernel32.DLL");
998 LPAddDLLDirectory AddDllDirectory = (LPAddDLLDirectory)GetProcAddress((HMODULE)hDLL, "AddDllDirectory");
999
1000 HsPtr result = NULL;
1001
1002 const unsigned int init_buf_size = 4096;
1003 int bufsize = init_buf_size;
1004
1005 // Make sure the path is an absolute path
1006 WCHAR* abs_path = malloc(sizeof(WCHAR) * init_buf_size);
1007 DWORD wResult = GetFullPathNameW(dll_path, bufsize, abs_path, NULL);
1008 if (!wResult){
1009 sysErrorBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError());
1010 }
1011 else if (wResult > init_buf_size) {
1012 abs_path = realloc(abs_path, sizeof(WCHAR) * wResult);
1013 if (!GetFullPathNameW(dll_path, bufsize, abs_path, NULL)) {
1014 sysErrorBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError());
1015 }
1016 }
1017
1018 if (AddDllDirectory) {
1019 result = AddDllDirectory(abs_path);
1020 }
1021 else
1022 {
1023 warnMissingKBLibraryPaths();
1024 WCHAR* str = malloc(sizeof(WCHAR) * init_buf_size);
1025 wResult = GetEnvironmentVariableW(L"PATH", str, bufsize);
1026
1027 if (wResult > init_buf_size) {
1028 str = realloc(str, sizeof(WCHAR) * wResult);
1029 bufsize = wResult;
1030 wResult = GetEnvironmentVariableW(L"PATH", str, bufsize);
1031 if (!wResult) {
1032 sysErrorBelch("addLibrarySearchPath[GetEnvironmentVariableW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError());
1033 }
1034 }
1035
1036 bufsize = wResult + 2 + pathlen(abs_path);
1037 wchar_t* newPath = malloc(sizeof(wchar_t) * bufsize);
1038
1039 wcscpy(newPath, abs_path);
1040 wcscat(newPath, L";");
1041 wcscat(newPath, str);
1042 if (!SetEnvironmentVariableW(L"PATH", (LPCWSTR)newPath)) {
1043 sysErrorBelch("addLibrarySearchPath[SetEnvironmentVariableW]: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError());
1044 }
1045
1046 free(newPath);
1047 free(abs_path);
1048
1049 return str;
1050 }
1051
1052 if (!result) {
1053 sysErrorBelch("addLibrarySearchPath: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError());
1054 free(abs_path);
1055 return NULL;
1056 }
1057
1058 free(abs_path);
1059 return result;
1060 #else
1061 (void)(dll_path); // Function not implemented for other platforms.
1062 return NULL;
1063 #endif
1064 }
1065
1066 /* -----------------------------------------------------------------------------
1067 * removes a directory from the process DLL Load path
1068 *
1069 * Returns: HS_BOOL_TRUE on success, otherwise HS_BOOL_FALSE
1070 */
1071 HsBool removeLibrarySearchPath(HsPtr dll_path_index)
1072 {
1073 IF_DEBUG(linker, debugBelch("\nremoveLibrarySearchPath: ptr = `%p'\n", dll_path_index));
1074
1075 #if defined(OBJFORMAT_PEi386)
1076 HsBool result = 0;
1077
1078 if (dll_path_index != NULL) {
1079 HINSTANCE hDLL = LoadLibraryW(L"Kernel32.DLL");
1080 LPRemoveDLLDirectory RemoveDllDirectory = (LPRemoveDLLDirectory)GetProcAddress((HMODULE)hDLL, "RemoveDllDirectory");
1081
1082 if (RemoveDllDirectory) {
1083 result = RemoveDllDirectory(dll_path_index);
1084 // dll_path_index is now invalid, do not use it after this point.
1085 }
1086 else
1087 {
1088 warnMissingKBLibraryPaths();
1089 result = SetEnvironmentVariableW(L"PATH", (LPCWSTR)dll_path_index);
1090 free(dll_path_index);
1091 }
1092
1093 if (!result) {
1094 sysErrorBelch("removeLibrarySearchPath: (Win32 error %lu)", GetLastError());
1095 return HS_BOOL_FALSE;
1096 }
1097 }
1098
1099 return result == 0 ? HS_BOOL_TRUE : HS_BOOL_FALSE;
1100 #else
1101 (void)(dll_path_index); // Function not implemented for other platforms.
1102 return HS_BOOL_FALSE;
1103 #endif
1104 }
1105
1106 /* -----------------------------------------------------------------------------
1107 * insert a symbol in the hash table
1108 *
1109 * Returns: 0 on failure, nozero on success
1110 */
1111 HsInt insertSymbol(pathchar* obj_name, char* key, void* data)
1112 {
1113 return ghciInsertSymbolTable(obj_name, symhash, key, data, HS_BOOL_FALSE, NULL);
1114 }
1115
1116 /* -----------------------------------------------------------------------------
1117 * lookup a symbol in the hash table
1118 */
1119 static void* lookupSymbol_ (char *lbl)
1120 {
1121 void *val;
1122 IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl));
1123
1124 ASSERT(symhash != NULL);
1125
1126 if (!ghciLookupSymbolTable(symhash, lbl, &val)) {
1127 IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n"));
1128 # if defined(OBJFORMAT_ELF)
1129 return internal_dlsym(lbl);
1130 # elif defined(OBJFORMAT_MACHO)
1131
1132 /* HACK: On OS X, all symbols are prefixed with an underscore.
1133 However, dlsym wants us to omit the leading underscore from the
1134 symbol name -- the dlsym routine puts it back on before searching
1135 for the symbol. For now, we simply strip it off here (and ONLY
1136 here).
1137 */
1138 IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n", lbl));
1139 ASSERT(lbl[0] == '_');
1140 return internal_dlsym(lbl + 1);
1141 # elif defined(OBJFORMAT_PEi386)
1142 void* sym;
1143
1144 /* See Note [mingw-w64 name decoration scheme] */
1145 #ifndef x86_64_HOST_ARCH
1146 zapTrailingAtSign ( (unsigned char*)lbl );
1147 #endif
1148 sym = lookupSymbolInDLLs((unsigned char*)lbl);
1149 return sym; // might be NULL if not found
1150
1151 # else
1152 ASSERT(2+2 == 5);
1153 return NULL;
1154 # endif
1155 } else {
1156 IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p\n", lbl, val));
1157 return val;
1158 }
1159 }
1160
1161 void* lookupSymbol( char *lbl )
1162 {
1163 ACQUIRE_LOCK(&linker_mutex);
1164 char *r = lookupSymbol_(lbl);
1165 RELEASE_LOCK(&linker_mutex);
1166 return r;
1167 }
1168
1169 /* -----------------------------------------------------------------------------
1170 Create a StablePtr for a foreign export. This is normally called by
1171 a C function with __attribute__((constructor)), which is generated
1172 by GHC and linked into the module.
1173
1174 If the object code is being loaded dynamically, then we remember
1175 which StablePtrs were allocated by the constructors and free them
1176 again in unloadObj().
1177 -------------------------------------------------------------------------- */
1178
1179 static ObjectCode *loading_obj = NULL;
1180
1181 StgStablePtr foreignExportStablePtr (StgPtr p)
1182 {
1183 ForeignExportStablePtr *fe_sptr;
1184 StgStablePtr *sptr;
1185
1186 sptr = getStablePtr(p);
1187
1188 if (loading_obj != NULL) {
1189 fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr),
1190 "foreignExportStablePtr");
1191 fe_sptr->stable_ptr = sptr;
1192 fe_sptr->next = loading_obj->stable_ptrs;
1193 loading_obj->stable_ptrs = fe_sptr;
1194 }
1195
1196 return sptr;
1197 }
1198
1199
1200 /* -----------------------------------------------------------------------------
1201 * Debugging aid: look in GHCi's object symbol tables for symbols
1202 * within DELTA bytes of the specified address, and show their names.
1203 */
1204 #ifdef DEBUG
1205 void ghci_enquire ( char* addr );
1206
1207 void ghci_enquire ( char* addr )
1208 {
1209 int i;
1210 char* sym;
1211 char* a;
1212 const int DELTA = 64;
1213 ObjectCode* oc;
1214
1215 for (oc = objects; oc; oc = oc->next) {
1216 for (i = 0; i < oc->n_symbols; i++) {
1217 sym = oc->symbols[i];
1218 if (sym == NULL) continue;
1219 a = NULL;
1220 if (a == NULL) {
1221 ghciLookupSymbolTable(symhash, sym, (void **)&a);
1222 }
1223 if (a == NULL) {
1224 // debugBelch("ghci_enquire: can't find %s\n", sym);
1225 }
1226 else if (addr-DELTA <= a && a <= addr+DELTA) {
1227 debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym);
1228 }
1229 }
1230 }
1231 }
1232 #endif
1233
1234 #if USE_MMAP
1235 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1236 #define ROUND_DOWN(x,size) (x & ~(size - 1))
1237
1238 static StgWord getPageSize(void)
1239 {
1240 static StgWord pagesize = 0;
1241 if (pagesize == 0) {
1242 pagesize = sysconf(_SC_PAGESIZE);
1243 }
1244 return pagesize;
1245 }
1246
1247 static StgWord roundUpToPage (StgWord size)
1248 {
1249 return ROUND_UP(size, getPageSize());
1250 }
1251
1252 #ifdef OBJFORMAT_ELF
1253 static StgWord roundDownToPage (StgWord size)
1254 {
1255 return ROUND_DOWN(size, getPageSize());
1256 }
1257 #endif
1258
1259 //
1260 // Returns NULL on failure.
1261 //
1262 static void * mmapForLinker (size_t bytes, nat flags, int fd, int offset)
1263 {
1264 void *map_addr = NULL;
1265 void *result;
1266 StgWord size;
1267 static nat fixed = 0;
1268
1269 IF_DEBUG(linker, debugBelch("mmapForLinker: start\n"));
1270 size = roundUpToPage(bytes);
1271
1272 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
1273 mmap_again:
1274
1275 if (mmap_32bit_base != 0) {
1276 map_addr = mmap_32bit_base;
1277 }
1278 #endif
1279
1280 IF_DEBUG(linker,
1281 debugBelch("mmapForLinker: \tprotection %#0x\n",
1282 PROT_EXEC | PROT_READ | PROT_WRITE));
1283 IF_DEBUG(linker,
1284 debugBelch("mmapForLinker: \tflags %#0x\n",
1285 MAP_PRIVATE | TRY_MAP_32BIT | fixed | flags));
1286
1287 result = mmap(map_addr, size,
1288 PROT_EXEC|PROT_READ|PROT_WRITE,
1289 MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, offset);
1290
1291 if (result == MAP_FAILED) {
1292 sysErrorBelch("mmap %" FMT_Word " bytes at %p",(W_)size,map_addr);
1293 errorBelch("Try specifying an address with +RTS -xm<addr> -RTS");
1294 return NULL;
1295 }
1296
1297 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
1298 if (mmap_32bit_base != 0) {
1299 if (result == map_addr) {
1300 mmap_32bit_base = (StgWord8*)map_addr + size;
1301 } else {
1302 if ((W_)result > 0x80000000) {
1303 // oops, we were given memory over 2Gb
1304 munmap(result,size);
1305 #if defined(freebsd_HOST_OS) || \
1306 defined(kfreebsdgnu_HOST_OS) || \
1307 defined(dragonfly_HOST_OS)
1308 // Some platforms require MAP_FIXED. This is normally
1309 // a bad idea, because MAP_FIXED will overwrite
1310 // existing mappings.
1311 fixed = MAP_FIXED;
1312 goto mmap_again;
1313 #else
1314 errorBelch("loadObj: failed to mmap() memory below 2Gb; "
1315 "asked for %lu bytes at %p. "
1316 "Try specifying an address with +RTS -xm<addr> -RTS",
1317 size, map_addr);
1318 return NULL;
1319 #endif
1320 } else {
1321 // hmm, we were given memory somewhere else, but it's
1322 // still under 2Gb so we can use it. Next time, ask
1323 // for memory right after the place we just got some
1324 mmap_32bit_base = (StgWord8*)result + size;
1325 }
1326 }
1327 } else {
1328 if ((W_)result > 0x80000000) {
1329 // oops, we were given memory over 2Gb
1330 // ... try allocating memory somewhere else?;
1331 debugTrace(DEBUG_linker,
1332 "MAP_32BIT didn't work; gave us %lu bytes at 0x%p",
1333 bytes, result);
1334 munmap(result, size);
1335
1336 // Set a base address and try again... (guess: 1Gb)
1337 mmap_32bit_base = (void*)0x40000000;
1338 goto mmap_again;
1339 }
1340 }
1341 #endif
1342
1343 IF_DEBUG(linker,
1344 debugBelch("mmapForLinker: mapped %" FMT_Word
1345 " bytes starting at %p\n", (W_)size, result));
1346 IF_DEBUG(linker,
1347 debugBelch("mmapForLinker: done\n"));
1348
1349 return result;
1350 }
1351
1352 /*
1353
1354 Note [M32 Allocator]
1355 ~~~~~~~~~~~~~~~~~~~~
1356
1357 A memory allocator that allocates only pages in the 32-bit range (lower 2GB).
1358 This is useful on 64-bit platforms to ensure that addresses of allocated
1359 objects can be referenced with a 32-bit relative offset.
1360
1361 Initially, the linker used `mmap` to allocate a page per object. Hence it
1362 wasted a lot of space for small objects (see #9314). With this allocator, we
1363 try to fill pages as much as we can for small objects.
1364
1365 How does it work?
1366 -----------------
1367
1368 For small objects, a Word64 counter is added at the beginning of the page they
1369 are stored in. It indicates the number of objects that are still alive in the
1370 page. When the counter drops down to zero, the page is freed. The counter is
1371 atomically decremented, hence the deallocation is thread-safe.
1372
1373 During the allocation phase, the allocator keeps track of some pages that are
1374 not totally filled: the number of pages in the "filling" list is configurable
1375 with M32_MAX_PAGES. Allocation consists in finding some place in one of these
1376 pages or starting a new one, then increasing the page counter. If none of the
1377 pages in the "filling" list has enough free space, the most filled one is
1378 flushed (see below) and a new one is allocated.
1379
1380 The allocator holds a reference on pages in the "filling" list: the counter in
1381 these pages is 1+n where n is the current number of objects allocated in the
1382 page. Hence allocated objects can be freed while the allocator is using
1383 (filling) the page. Flushing a page consists in decreasing its counter and
1384 removing it from the "filling" list. By extension, flushing the allocator
1385 consists in flushing all the pages in the "filling" list. Don't forget to
1386 flush the allocator at the end of the allocation phase in order to avoid space
1387 leaks!
1388
1389 Large objects are objects that are larger than a page (minus the bytes required
1390 for the counter and the optional padding). These objects are allocated into
1391 their own set of pages. We can differentiate large and small objects from
1392 their address: large objects are aligned on page size while small objects never
1393 are (because of the space reserved for the page's object counter).
1394
1395 For large objects, the remaining space at the end of the last page is left
1396 unused by the allocator. It can be used with care as it will be freed with the
1397 associated large object. GHC linker uses this feature/hack, hence changing the
1398 implementation of the M32 allocator must be done with care (i.e. do not try to
1399 improve the allocator to avoid wasting this space without modifying the linker
1400 code accordingly).
1401
1402 Object allocation is *not* thread-safe (however it could be done easily with a
1403 lock in the allocator structure). Object deallocation is thread-safe.
1404
1405 */
1406
1407 /****************************************************************************
1408 * M32 ALLOCATOR (see Note [M32 Allocator]
1409 ***************************************************************************/
1410
1411 /**
1412 * Wrapper for `unmap` that handles error cases.
1413 */
1414 static void munmapForLinker (void * addr, size_t size)
1415 {
1416 int r = munmap(addr,size);
1417 if (r == -1) {
1418 // Should we abort here?
1419 sysErrorBelch("munmap");
1420 }
1421 }
1422
1423 /**
1424 * Initialize the allocator structure
1425 */
1426 static void m32_allocator_init(m32_allocator m32) {
1427 memset(m32, 0, sizeof(struct m32_allocator_t));
1428 }
1429
1430 /**
1431 * Atomically decrement the object counter on the given page and release the
1432 * page if necessary. The given address must be the *base address* of the page.
1433 *
1434 * You shouldn't have to use this method. Use `m32_free` instead.
1435 */
1436 static void m32_free_internal(void * addr) {
1437 uintptr_t c = __sync_sub_and_fetch((uintptr_t*)addr, 1);
1438 if (c == 0) {
1439 munmapForLinker(addr, getPageSize());
1440 }
1441 }
1442
1443 /**
1444 * Release the allocator's reference to pages on the "filling" list. This
1445 * should be called when it is believed that no more allocations will be needed
1446 * from the allocator to ensure that empty pages waiting to be filled aren't
1447 * unnecessarily held.
1448 */
1449 static void m32_allocator_flush(m32_allocator m32) {
1450 int i;
1451 for (i=0; i<M32_MAX_PAGES; i++) {
1452 void * addr = __sync_fetch_and_and(&m32->pages[i].base_addr, 0x0);
1453 if (addr != 0) {
1454 m32_free_internal(addr);
1455 }
1456 }
1457 }
1458
1459 // Return true if the object has its own dedicated set of pages
1460 #define m32_is_large_object(size,alignment) \
1461 (size >= getPageSize() - ROUND_UP(8,alignment))
1462
1463 // Return true if the object has its own dedicated set of pages
1464 #define m32_is_large_object_addr(addr) \
1465 ((uintptr_t) addr % getPageSize() == 0)
1466
1467 /**
1468 * Free the memory associated with an object.
1469 *
1470 * If the object is "small", the object counter of the page it is allocated in
1471 * is decremented and the page is not freed until all of its objects are freed.
1472 */
1473 static void m32_free(void *addr, unsigned int size) {
1474 uintptr_t m = (uintptr_t) addr % getPageSize();
1475
1476 if (m == 0) {
1477 // large object
1478 munmapForLinker(addr,ROUND_UP(size,getPageSize()));
1479 }
1480 else {
1481 // small object
1482 void * page_addr = (void*)((uintptr_t)addr - m);
1483 m32_free_internal(page_addr);
1484 }
1485 }
1486
1487 /**
1488 * Allocate `size` bytes of memory with the given alignment
1489 */
1490 static void *
1491 m32_alloc(m32_allocator m32, unsigned int size,
1492 unsigned int alignment) {
1493
1494 unsigned int pgsz = (unsigned int)getPageSize();
1495
1496 if (m32_is_large_object(size,alignment)) {
1497 // large object
1498 return mmapForLinker(size,MAP_ANONYMOUS,-1,0);
1499 }
1500 else {
1501 // small object
1502 // Try to find a page that can contain it
1503 int empty = -1;
1504 int most_filled = -1;
1505 int i;
1506 for (i=0; i<M32_MAX_PAGES; i++) {
1507 // empty page
1508 if (m32->pages[i].base_addr == 0) {
1509 empty = empty == -1 ? i : empty;
1510 continue;
1511 }
1512 // page can contain the buffer?
1513 unsigned int alsize = ROUND_UP(m32->pages[i].current_size, alignment);
1514 if (size <= pgsz - alsize) {
1515 void * addr = (char*)m32->pages[i].base_addr + alsize;
1516 m32->pages[i].current_size = alsize + size;
1517 // increment the counter atomically
1518 __sync_fetch_and_add((uintptr_t*)m32->pages[i].base_addr, 1);
1519 return addr;
1520 }
1521 // most filled?
1522 if (most_filled == -1
1523 || m32->pages[most_filled].current_size < m32->pages[i].current_size)
1524 {
1525 most_filled = i;
1526 }
1527 }
1528
1529 // If we haven't found an empty page, flush the most filled one
1530 if (empty == -1) {
1531 m32_free_internal(m32->pages[most_filled].base_addr);
1532 m32->pages[most_filled].base_addr = 0;
1533 m32->pages[most_filled].current_size = 0;
1534 empty = most_filled;
1535 }
1536
1537 // Allocate a new page
1538 void * addr = mmapForLinker(pgsz,MAP_ANONYMOUS,-1,0);
1539 if (addr == NULL) {
1540 return NULL;
1541 }
1542 m32->pages[empty].base_addr = addr;
1543 // Add 8 bytes for the counter + padding
1544 m32->pages[empty].current_size = size+ROUND_UP(8,alignment);
1545 // Initialize the counter:
1546 // 1 for the allocator + 1 for the returned allocated memory
1547 *((uintptr_t*)addr) = 2;
1548 return (char*)addr + ROUND_UP(8,alignment);
1549 }
1550 }
1551
1552 /****************************************************************************
1553 * END (M32 ALLOCATOR)
1554 ***************************************************************************/
1555
1556 #endif // USE_MMAP
1557
1558 /*
1559 * Remove symbols from the symbol table, and free oc->symbols.
1560 * This operation is idempotent.
1561 */
1562 static void removeOcSymbols (ObjectCode *oc)
1563 {
1564 if (oc->symbols == NULL) return;
1565
1566 // Remove all the mappings for the symbols within this object..
1567 int i;
1568 for (i = 0; i < oc->n_symbols; i++) {
1569 if (oc->symbols[i] != NULL) {
1570 ghciRemoveSymbolTable(symhash, oc->symbols[i], oc);
1571 }
1572 }
1573
1574 stgFree(oc->symbols);
1575 oc->symbols = NULL;
1576 }
1577
1578 /*
1579 * Release StablePtrs and free oc->stable_ptrs.
1580 * This operation is idempotent.
1581 */
1582 static void freeOcStablePtrs (ObjectCode *oc)
1583 {
1584 // Release any StablePtrs that were created when this
1585 // object module was initialized.
1586 ForeignExportStablePtr *fe_ptr, *next;
1587
1588 for (fe_ptr = oc->stable_ptrs; fe_ptr != NULL; fe_ptr = next) {
1589 next = fe_ptr->next;
1590 freeStablePtr(fe_ptr->stable_ptr);
1591 stgFree(fe_ptr);
1592 }
1593 oc->stable_ptrs = NULL;
1594 }
1595
1596 static void
1597 freePreloadObjectFile (ObjectCode *oc)
1598 {
1599 #if USE_MMAP
1600
1601 if (oc->imageMapped) {
1602 munmap(oc->image, oc->fileSize);
1603 } else {
1604 stgFree(oc->image);
1605 }
1606
1607 #elif defined(mingw32_HOST_OS)
1608
1609 VirtualFree(oc->image - PEi386_IMAGE_OFFSET, 0, MEM_RELEASE);
1610
1611 IndirectAddr *ia, *ia_next;
1612 ia = indirects;
1613 while (ia != NULL) {
1614 ia_next = ia->next;
1615 stgFree(ia);
1616 ia = ia_next;
1617 }
1618 indirects = NULL;
1619
1620 #else
1621
1622 stgFree(oc->image);
1623
1624 #endif
1625
1626 oc->image = NULL;
1627 oc->fileSize = 0;
1628 }
1629
1630 /*
1631 * freeObjectCode() releases all the pieces of an ObjectCode. It is called by
1632 * the GC when a previously unloaded ObjectCode has been determined to be
1633 * unused, and when an error occurs during loadObj().
1634 */
1635 void freeObjectCode (ObjectCode *oc)
1636 {
1637 freePreloadObjectFile(oc);
1638
1639 if (oc->symbols != NULL) {
1640 stgFree(oc->symbols);
1641 oc->symbols = NULL;
1642 }
1643
1644 if (oc->sections != NULL) {
1645 int i;
1646 for (i=0; i < oc->n_sections; i++) {
1647 if (oc->sections[i].start != NULL) {
1648 switch(oc->sections[i].alloc){
1649 #if USE_MMAP
1650 case SECTION_MMAP:
1651 munmap(oc->sections[i].mapped_start,
1652 oc->sections[i].mapped_size);
1653 break;
1654 case SECTION_M32:
1655 m32_free(oc->sections[i].start,
1656 oc->sections[i].size);
1657 break;
1658 #endif
1659 case SECTION_MALLOC:
1660 stgFree(oc->sections[i].start);
1661 break;
1662 default:
1663 break;
1664 }
1665 }
1666 }
1667 stgFree(oc->sections);
1668 }
1669
1670 freeProddableBlocks(oc);
1671
1672 /* Free symbol_extras. On x86_64 Windows, symbol_extras are allocated
1673 * alongside the image, so we don't need to free. */
1674 #if NEED_SYMBOL_EXTRAS && (!defined(x86_64_HOST_ARCH) || !defined(mingw32_HOST_OS))
1675 #if USE_MMAP
1676 if (!USE_CONTIGUOUS_MMAP && oc->symbol_extras != NULL)
1677 {
1678 m32_free(oc->symbol_extras, sizeof(SymbolExtra) * oc->n_symbol_extras);
1679 }
1680 #else // !USE_MMAP
1681 stgFree(oc->symbol_extras);
1682 #endif
1683 #endif
1684
1685 stgFree(oc->fileName);
1686 stgFree(oc->archiveMemberName);
1687 stgFree(oc);
1688 }
1689
1690
1691 static ObjectCode*
1692 mkOc( pathchar *path, char *image, int imageSize,
1693 rtsBool mapped, char *archiveMemberName, int misalignment ) {
1694 ObjectCode* oc;
1695
1696 IF_DEBUG(linker, debugBelch("mkOc: start\n"));
1697 oc = stgMallocBytes(sizeof(ObjectCode), "mkOc(oc)");
1698
1699 # if defined(OBJFORMAT_ELF)
1700 oc->formatName = "ELF";
1701 # elif defined(OBJFORMAT_PEi386)
1702 oc->formatName = "PEi386";
1703 # elif defined(OBJFORMAT_MACHO)
1704 oc->formatName = "Mach-O";
1705 # else
1706 stgFree(oc);
1707 barf("loadObj: not implemented on this platform");
1708 # endif
1709
1710 oc->image = image;
1711 oc->fileName = pathdup(path);
1712
1713 if (archiveMemberName) {
1714 oc->archiveMemberName = stgMallocBytes( strlen(archiveMemberName)+1, "loadObj" );
1715 strcpy(oc->archiveMemberName, archiveMemberName);
1716 }
1717 else {
1718 oc->archiveMemberName = NULL;
1719 }
1720
1721 oc->fileSize = imageSize;
1722 oc->symbols = NULL;
1723 oc->n_sections = 0;
1724 oc->sections = NULL;
1725 oc->proddables = NULL;
1726 oc->stable_ptrs = NULL;
1727 #if NEED_SYMBOL_EXTRAS
1728 oc->symbol_extras = NULL;
1729 #endif
1730 oc->imageMapped = mapped;
1731
1732 oc->misalignment = misalignment;
1733
1734 /* chain it onto the list of objects */
1735 oc->next = NULL;
1736
1737 IF_DEBUG(linker, debugBelch("mkOc: done\n"));
1738 return oc;
1739 }
1740
1741 /* -----------------------------------------------------------------------------
1742 * Check if an object or archive is already loaded.
1743 *
1744 * Returns: 1 if the path is already loaded, 0 otherwise.
1745 */
1746 static HsInt
1747 isAlreadyLoaded( pathchar *path )
1748 {
1749 ObjectCode *o;
1750 for (o = objects; o; o = o->next) {
1751 if (0 == pathcmp(o->fileName, path)) {
1752 return 1; /* already loaded */
1753 }
1754 }
1755 return 0; /* not loaded yet */
1756 }
1757
1758 static HsInt loadArchive_ (pathchar *path)
1759 {
1760 ObjectCode* oc;
1761 char *image;
1762 int memberSize;
1763 FILE *f;
1764 int n;
1765 size_t thisFileNameSize;
1766 char *fileName;
1767 size_t fileNameSize;
1768 int isObject, isGnuIndex, isThin;
1769 char tmp[20];
1770 char *gnuFileIndex;
1771 int gnuFileIndexSize;
1772 #if defined(darwin_HOST_OS)
1773 int i;
1774 uint32_t nfat_arch, nfat_offset, cputype, cpusubtype;
1775 #if defined(i386_HOST_ARCH)
1776 const uint32_t mycputype = CPU_TYPE_X86;
1777 const uint32_t mycpusubtype = CPU_SUBTYPE_X86_ALL;
1778 #elif defined(x86_64_HOST_ARCH)
1779 const uint32_t mycputype = CPU_TYPE_X86_64;
1780 const uint32_t mycpusubtype = CPU_SUBTYPE_X86_64_ALL;
1781 #elif defined(powerpc_HOST_ARCH)
1782 const uint32_t mycputype = CPU_TYPE_POWERPC;
1783 const uint32_t mycpusubtype = CPU_SUBTYPE_POWERPC_ALL;
1784 #elif defined(powerpc64_HOST_ARCH)
1785 const uint32_t mycputype = CPU_TYPE_POWERPC64;
1786 const uint32_t mycpusubtype = CPU_SUBTYPE_POWERPC_ALL;
1787 #else
1788 #error Unknown Darwin architecture
1789 #endif
1790 #endif
1791 int misalignment = 0;
1792
1793 /* TODO: don't call barf() on error, instead return an error code, freeing
1794 * all resources correctly. This function is pretty complex, so it needs
1795 * to be refactored to make this practical. */
1796
1797 IF_DEBUG(linker, debugBelch("loadArchive: start\n"));
1798 IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%" PATH_FMT" '\n", path));
1799
1800 /* Check that we haven't already loaded this archive.
1801 Ignore requests to load multiple times */
1802 if (isAlreadyLoaded(path)) {
1803 IF_DEBUG(linker,
1804 debugBelch("ignoring repeated load of %" PATH_FMT "\n", path));
1805 return 1; /* success */
1806 }
1807
1808 gnuFileIndex = NULL;
1809 gnuFileIndexSize = 0;
1810
1811 fileNameSize = 32;
1812 fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)");
1813
1814 isThin = 0;
1815
1816 f = pathopen(path, WSTR("rb"));
1817 if (!f)
1818 barf("loadObj: can't read `%s'", path);
1819
1820 /* Check if this is an archive by looking for the magic "!<arch>\n"
1821 * string. Usually, if this fails, we barf and quit. On Darwin however,
1822 * we may have a fat archive, which contains archives for more than
1823 * one architecture. Fat archives start with the magic number 0xcafebabe,
1824 * always stored big endian. If we find a fat_header, we scan through
1825 * the fat_arch structs, searching through for one for our host
1826 * architecture. If a matching struct is found, we read the offset
1827 * of our archive data (nfat_offset) and seek forward nfat_offset bytes
1828 * from the start of the file.
1829 *
1830 * A subtlety is that all of the members of the fat_header and fat_arch
1831 * structs are stored big endian, so we need to call byte order
1832 * conversion functions.
1833 *
1834 * If we find the appropriate architecture in a fat archive, we gobble
1835 * its magic "!<arch>\n" string and continue processing just as if
1836 * we had a single architecture archive.
1837 */
1838
1839 n = fread ( tmp, 1, 8, f );
1840 if (n != 8)
1841 barf("loadArchive: Failed reading header from `%s'", path);
1842 if (strncmp(tmp, "!<arch>\n", 8) == 0) {}
1843 #if !defined(mingw32_HOST_OS)
1844 /* See Note [thin archives on Windows] */
1845 else if (strncmp(tmp, "!<thin>\n", 8) == 0) {
1846 isThin = 1;
1847 }
1848 #endif
1849 #if defined(darwin_HOST_OS)
1850 /* Not a standard archive, look for a fat archive magic number: */
1851 else if (ntohl(*(uint32_t *)tmp) == FAT_MAGIC) {
1852 nfat_arch = ntohl(*(uint32_t *)(tmp + 4));
1853 IF_DEBUG(linker, debugBelch("loadArchive: found a fat archive containing %d architectures\n", nfat_arch));
1854 nfat_offset = 0;
1855
1856 for (i = 0; i < (int)nfat_arch; i++) {
1857 /* search for the right arch */
1858 n = fread( tmp, 1, 20, f );
1859 if (n != 8)
1860 barf("loadArchive: Failed reading arch from `%s'", path);
1861 cputype = ntohl(*(uint32_t *)tmp);
1862 cpusubtype = ntohl(*(uint32_t *)(tmp + 4));
1863
1864 if (cputype == mycputype && cpusubtype == mycpusubtype) {
1865 IF_DEBUG(linker, debugBelch("loadArchive: found my archive in a fat archive\n"));
1866 nfat_offset = ntohl(*(uint32_t *)(tmp + 8));
1867 break;
1868 }
1869 }
1870
1871 if (nfat_offset == 0) {
1872 barf ("loadArchive: searched %d architectures, but no host arch found", (int)nfat_arch);
1873 }
1874 else {
1875 n = fseek( f, nfat_offset, SEEK_SET );
1876 if (n != 0)
1877 barf("loadArchive: Failed to seek to arch in `%s'", path);
1878 n = fread ( tmp, 1, 8, f );
1879 if (n != 8)
1880 barf("loadArchive: Failed reading header from `%s'", path);
1881 if (strncmp(tmp, "!<arch>\n", 8) != 0) {
1882 barf("loadArchive: couldn't find archive in `%s' at offset %d", path, nfat_offset);
1883 }
1884 }
1885 }
1886 else {
1887 barf("loadArchive: Neither an archive, nor a fat archive: `%s'", path);
1888 }
1889 #else
1890 else {
1891 barf("loadArchive: Not an archive: `%s'", path);
1892 }
1893 #endif
1894
1895 IF_DEBUG(linker, debugBelch("loadArchive: loading archive contents\n"));
1896
1897 while(1) {
1898 n = fread ( fileName, 1, 16, f );
1899 if (n != 16) {
1900 if (feof(f)) {
1901 IF_DEBUG(linker, debugBelch("loadArchive: EOF while reading from '%" PATH_FMT "'\n", path));
1902 break;
1903 }
1904 else {
1905 barf("loadArchive: Failed reading file name from `%s'", path);
1906 }
1907 }
1908
1909 #if defined(darwin_HOST_OS)
1910 if (strncmp(fileName, "!<arch>\n", 8) == 0) {
1911 IF_DEBUG(linker, debugBelch("loadArchive: found the start of another archive, breaking\n"));
1912 break;
1913 }
1914 #endif
1915
1916 n = fread ( tmp, 1, 12, f );
1917 if (n != 12)
1918 barf("loadArchive: Failed reading mod time from `%s'", path);
1919 n = fread ( tmp, 1, 6, f );
1920 if (n != 6)
1921 barf("loadArchive: Failed reading owner from `%s'", path);
1922 n = fread ( tmp, 1, 6, f );
1923 if (n != 6)
1924 barf("loadArchive: Failed reading group from `%s'", path);
1925 n = fread ( tmp, 1, 8, f );
1926 if (n != 8)
1927 barf("loadArchive: Failed reading mode from `%s'", path);
1928 n = fread ( tmp, 1, 10, f );
1929 if (n != 10)
1930 barf("loadArchive: Failed reading size from `%s'", path);
1931 tmp[10] = '\0';
1932 for (n = 0; isdigit(tmp[n]); n++);
1933 tmp[n] = '\0';
1934 memberSize = atoi(tmp);
1935
1936 IF_DEBUG(linker, debugBelch("loadArchive: size of this archive member is %d\n", memberSize));
1937 n = fread ( tmp, 1, 2, f );
1938 if (n != 2)
1939 barf("loadArchive: Failed reading magic from `%s'", path);
1940 if (strncmp(tmp, "\x60\x0A", 2) != 0)
1941 barf("loadArchive: Failed reading magic from `%s' at %ld. Got %c%c",
1942 path, ftell(f), tmp[0], tmp[1]);
1943
1944 isGnuIndex = 0;
1945 /* Check for BSD-variant large filenames */
1946 if (0 == strncmp(fileName, "#1/", 3)) {
1947 fileName[16] = '\0';
1948 if (isdigit(fileName[3])) {
1949 for (n = 4; isdigit(fileName[n]); n++);
1950 fileName[n] = '\0';
1951 thisFileNameSize = atoi(fileName + 3);
1952 memberSize -= thisFileNameSize;
1953 if (thisFileNameSize >= fileNameSize) {
1954 /* Double it to avoid potentially continually
1955 increasing it by 1 */
1956 fileNameSize = thisFileNameSize * 2;
1957 fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
1958 }
1959 n = fread ( fileName, 1, thisFileNameSize, f );
1960 if (n != (int)thisFileNameSize) {
1961 barf("loadArchive: Failed reading filename from `%s'",
1962 path);
1963 }
1964 fileName[thisFileNameSize] = 0;
1965
1966 /* On OS X at least, thisFileNameSize is the size of the
1967 fileName field, not the length of the fileName
1968 itself. */
1969 thisFileNameSize = strlen(fileName);
1970 }
1971 else {
1972 barf("loadArchive: BSD-variant filename size not found while reading filename from `%s'", path);
1973 }
1974 }
1975 /* Check for GNU file index file */
1976 else if (0 == strncmp(fileName, "//", 2)) {
1977 fileName[0] = '\0';
1978 thisFileNameSize = 0;
1979 isGnuIndex = 1;
1980 }
1981 /* Check for a file in the GNU file index */
1982 else if (fileName[0] == '/') {
1983 if (isdigit(fileName[1])) {
1984 int i;
1985
1986 for (n = 2; isdigit(fileName[n]); n++);
1987 fileName[n] = '\0';
1988 n = atoi(fileName + 1);
1989
1990 if (gnuFileIndex == NULL) {
1991 barf("loadArchive: GNU-variant filename without an index while reading from `%s'", path);
1992 }
1993 if (n < 0 || n > gnuFileIndexSize) {
1994 barf("loadArchive: GNU-variant filename offset %d out of range [0..%d] while reading filename from `%s'", n, gnuFileIndexSize, path);
1995 }
1996 if (n != 0 && gnuFileIndex[n - 1] != '\n') {
1997 barf("loadArchive: GNU-variant filename offset %d invalid (range [0..%d]) while reading filename from `%s'", n, gnuFileIndexSize, path);
1998 }
1999 for (i = n; gnuFileIndex[i] != '\n'; i++);
2000 thisFileNameSize = i - n - 1;
2001 if (thisFileNameSize >= fileNameSize) {
2002 /* Double it to avoid potentially continually
2003 increasing it by 1 */
2004 fileNameSize = thisFileNameSize * 2;
2005 fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
2006 }
2007 memcpy(fileName, gnuFileIndex + n, thisFileNameSize);
2008 fileName[thisFileNameSize] = '\0';
2009 }
2010 else if (fileName[1] == ' ') {
2011 fileName[0] = '\0';
2012 thisFileNameSize = 0;
2013 }
2014 else {
2015 barf("loadArchive: GNU-variant filename offset not found while reading filename from `%s'", path);
2016 }
2017 }
2018 /* Finally, the case where the filename field actually contains
2019 the filename */
2020 else {
2021 /* GNU ar terminates filenames with a '/', this allowing
2022 spaces in filenames. So first look to see if there is a
2023 terminating '/'. */
2024 for (thisFileNameSize = 0;
2025 thisFileNameSize < 16;
2026 thisFileNameSize++) {
2027 if (fileName[thisFileNameSize] == '/') {
2028 fileName[thisFileNameSize] = '\0';
2029 break;
2030 }
2031 }
2032 /* If we didn't find a '/', then a space teminates the
2033 filename. Note that if we don't find one, then
2034 thisFileNameSize ends up as 16, and we already have the
2035 '\0' at the end. */
2036 if (thisFileNameSize == 16) {
2037 for (thisFileNameSize = 0;
2038 thisFileNameSize < 16;
2039 thisFileNameSize++) {
2040 if (fileName[thisFileNameSize] == ' ') {
2041 fileName[thisFileNameSize] = '\0';
2042 break;
2043 }
2044 }
2045 }
2046 }
2047
2048 IF_DEBUG(linker,
2049 debugBelch("loadArchive: Found member file `%s'\n", fileName));
2050
2051 isObject =
2052 (thisFileNameSize >= 2 &&
2053 fileName[thisFileNameSize - 2] == '.' &&
2054 fileName[thisFileNameSize - 1] == 'o')
2055 || (thisFileNameSize >= 4 &&
2056 fileName[thisFileNameSize - 4] == '.' &&
2057 fileName[thisFileNameSize - 3] == 'p' &&
2058 fileName[thisFileNameSize - 2] == '_' &&
2059 fileName[thisFileNameSize - 1] == 'o');
2060
2061 IF_DEBUG(linker, debugBelch("loadArchive: \tthisFileNameSize = %d\n", (int)thisFileNameSize));
2062 IF_DEBUG(linker, debugBelch("loadArchive: \tisObject = %d\n", isObject));
2063
2064 if (isObject) {
2065 char *archiveMemberName;
2066
2067 IF_DEBUG(linker, debugBelch("loadArchive: Member is an object file...loading...\n"));
2068
2069 #if defined(mingw32_HOST_OS)
2070 // TODO: We would like to use allocateExec here, but allocateExec
2071 // cannot currently allocate blocks large enough.
2072 image = allocateImageAndTrampolines(path, fileName,
2073 #if defined(x86_64_HOST_ARCH)
2074 f,
2075 #endif
2076 memberSize);
2077 #elif defined(darwin_HOST_OS)
2078 #if USE_MMAP
2079 image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1, 0);
2080 #else
2081 /* See loadObj() */
2082 misalignment = machoGetMisalignment(f);
2083 image = stgMallocBytes(memberSize + misalignment, "loadArchive(image)");
2084 image += misalignment;
2085 #endif // USE_MMAP
2086
2087 #else // not windows or darwin
2088 image = stgMallocBytes(memberSize, "loadArchive(image)");
2089 #endif
2090
2091 #if !defined(mingw32_HOST_OS)
2092 /*
2093 * Note [thin archives on Windows]
2094 * This doesn't compile on Windows because it assumes
2095 * char* pathnames, and we use wchar_t* on Windows. It's
2096 * not trivial to fix, so I'm leaving it disabled on
2097 * Windows for now --SDM
2098 */
2099 if (isThin) {
2100 FILE *member;
2101 char *pathCopy, *dirName, *memberPath;
2102
2103 /* Allocate and setup the dirname of the archive. We'll need
2104 this to locate the thin member */
2105 pathCopy = stgMallocBytes(strlen(path) + 1, "loadArchive(file)");
2106 strcpy(pathCopy, path);
2107 dirName = dirname(pathCopy);
2108
2109 /* Append the relative member name to the dirname. This should be
2110 be the full path to the actual thin member. */
2111 memberPath = stgMallocBytes(
2112 strlen(path) + 1 + strlen(fileName) + 1, "loadArchive(file)");
2113 strcpy(memberPath, dirName);
2114 memberPath[strlen(dirName)] = '/';
2115 strcpy(memberPath + strlen(dirName) + 1, fileName);
2116
2117 member = pathopen(memberPath, WSTR("rb"));
2118 if (!member)
2119 barf("loadObj: can't read `%s'", path);
2120
2121 n = fread ( image, 1, memberSize, member );
2122 if (n != memberSize) {
2123 barf("loadArchive: error whilst reading `%s'", fileName);
2124 }
2125
2126 fclose(member);
2127 stgFree(memberPath);
2128 stgFree(pathCopy);
2129 }
2130 else
2131 #endif
2132 {
2133 n = fread ( image, 1, memberSize, f );
2134 if (n != memberSize) {
2135 barf("loadArchive: error whilst reading `%s'", path);
2136 }
2137 }
2138
2139 archiveMemberName = stgMallocBytes(pathlen(path) + thisFileNameSize + 3,
2140 "loadArchive(file)");
2141 sprintf(archiveMemberName, "%" PATH_FMT "(%.*s)",
2142 path, (int)thisFileNameSize, fileName);
2143
2144 oc = mkOc(path, image, memberSize, rtsFalse, archiveMemberName
2145 , misalignment);
2146
2147 stgFree(archiveMemberName);
2148
2149 if (0 == loadOc(oc)) {
2150 stgFree(fileName);
2151 fclose(f);
2152 return 0;
2153 } else {
2154 oc->next = objects;
2155 objects = oc;
2156 }
2157 }
2158 else if (isGnuIndex) {
2159 if (gnuFileIndex != NULL) {
2160 barf("loadArchive: GNU-variant index found, but already have an index, while reading filename from `%s'", path);
2161 }
2162 IF_DEBUG(linker, debugBelch("loadArchive: Found GNU-variant file index\n"));
2163 #if USE_MMAP
2164 gnuFileIndex = mmapForLinker(memberSize + 1, MAP_ANONYMOUS, -1, 0);
2165 #else
2166 gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)");
2167 #endif
2168 n = fread ( gnuFileIndex, 1, memberSize, f );
2169 if (n != memberSize) {
2170 barf("loadArchive: error whilst reading `%s'", path);
2171 }
2172 gnuFileIndex[memberSize] = '/';
2173 gnuFileIndexSize = memberSize;
2174 }
2175 else {
2176 IF_DEBUG(linker, debugBelch("loadArchive: '%s' does not appear to be an object file\n", fileName));
2177 if (!isThin || thisFileNameSize == 0) {
2178 n = fseek(f, memberSize, SEEK_CUR);
2179 if (n != 0)
2180 barf("loadArchive: error whilst seeking by %d in `%s'",
2181 memberSize, path);
2182 }
2183 }
2184
2185 /* .ar files are 2-byte aligned */
2186 if (!(isThin && thisFileNameSize > 0) && memberSize % 2) {
2187 IF_DEBUG(linker, debugBelch("loadArchive: trying to read one pad byte\n"));
2188 n = fread ( tmp, 1, 1, f );
2189 if (n != 1) {
2190 if (feof(f)) {
2191 IF_DEBUG(linker, debugBelch("loadArchive: found EOF while reading one pad byte\n"));
2192 break;
2193 }
2194 else {
2195 barf("loadArchive: Failed reading padding from `%s'", path);
2196 }
2197 }
2198 IF_DEBUG(linker, debugBelch("loadArchive: successfully read one pad byte\n"));
2199 }
2200 IF_DEBUG(linker, debugBelch("loadArchive: reached end of archive loading while loop\n"));
2201 }
2202
2203 fclose(f);
2204
2205 stgFree(fileName);
2206 if (gnuFileIndex != NULL) {
2207 #if USE_MMAP
2208 munmap(gnuFileIndex, gnuFileIndexSize + 1);
2209 #else
2210 stgFree(gnuFileIndex);
2211 #endif
2212 }
2213
2214 #if USE_MMAP
2215 m32_allocator_flush(&allocator);
2216 #endif
2217
2218 IF_DEBUG(linker, debugBelch("loadArchive: done\n"));
2219 return 1;
2220 }
2221
2222 HsInt loadArchive (pathchar *path)
2223 {
2224 ACQUIRE_LOCK(&linker_mutex);
2225 HsInt r = loadArchive_(path);
2226 RELEASE_LOCK(&linker_mutex);
2227 return r;
2228 }
2229
2230 //
2231 // Load the object file into memory. This will not be its final resting place,
2232 // as on 64-bit platforms we need to map its segments into the low 2Gb of the
2233 // address space, properly aligned.
2234 //
2235 static ObjectCode *
2236 preloadObjectFile (pathchar *path)
2237 {
2238 int fileSize;
2239 struct_stat st;
2240 int r;
2241 void *image;
2242 ObjectCode *oc;
2243 int misalignment = 0;
2244
2245 r = pathstat(path, &st);
2246 if (r == -1) {
2247 errorBelch("loadObj: %" PATH_FMT ": file doesn't exist", path);
2248 return NULL;
2249 }
2250
2251 fileSize = st.st_size;
2252
2253 #if USE_MMAP
2254 int fd;
2255
2256 /* On many architectures malloc'd memory isn't executable, so we need to use
2257 * mmap. */
2258
2259 #if defined(openbsd_HOST_OS)
2260 fd = open(path, O_RDONLY, S_IRUSR);
2261 #else
2262 fd = open(path, O_RDONLY);
2263 #endif
2264 if (fd == -1) {
2265 errorBelch("loadObj: can't open %s", path);
2266 return NULL;
2267 }
2268
2269 image = mmap(NULL, fileSize, PROT_READ|PROT_WRITE|PROT_EXEC,
2270 MAP_PRIVATE, fd, 0);
2271 // not 32-bit yet, we'll remap later
2272 close(fd);
2273
2274 #else /* !USE_MMAP */
2275 FILE *f;
2276
2277 /* load the image into memory */
2278 /* coverity[toctou] */
2279 f = pathopen(path, WSTR("rb"));
2280 if (!f) {
2281 errorBelch("loadObj: can't read `%" PATH_FMT "'", path);
2282 return NULL;
2283 }
2284
2285 # if defined(mingw32_HOST_OS)
2286
2287 // TODO: We would like to use allocateExec here, but allocateExec
2288 // cannot currently allocate blocks large enough.
2289 image = allocateImageAndTrampolines(path, "itself",
2290 #if defined(x86_64_HOST_ARCH)
2291 f,
2292 #endif
2293 fileSize);
2294 if (image == NULL) {
2295 fclose(f);
2296 return NULL;
2297 }
2298
2299 # elif defined(darwin_HOST_OS)
2300
2301 // In a Mach-O .o file, all sections can and will be misaligned
2302 // if the total size of the headers is not a multiple of the
2303 // desired alignment. This is fine for .o files that only serve
2304 // as input for the static linker, but it's not fine for us,
2305 // as SSE (used by gcc for floating point) and Altivec require
2306 // 16-byte alignment.
2307 // We calculate the correct alignment from the header before
2308 // reading the file, and then we misalign image on purpose so
2309 // that the actual sections end up aligned again.
2310 misalignment = machoGetMisalignment(f);
2311 image = stgMallocBytes(fileSize + misalignment, "loadObj(image)");
2312 image += misalignment;
2313
2314 # else /* !defined(mingw32_HOST_OS) */
2315
2316 image = stgMallocBytes(fileSize, "loadObj(image)");
2317
2318 #endif
2319
2320 int n;
2321 n = fread ( image, 1, fileSize, f );
2322 fclose(f);
2323 if (n != fileSize) {
2324 errorBelch("loadObj: error whilst reading `%" PATH_FMT "'", path);
2325 stgFree(image);
2326 return NULL;
2327 }
2328
2329 #endif /* USE_MMAP */
2330
2331 oc = mkOc(path, image, fileSize, rtsTrue, NULL, misalignment);
2332
2333 return oc;
2334 }
2335
2336 /* -----------------------------------------------------------------------------
2337 * Load an obj (populate the global symbol table, but don't resolve yet)
2338 *
2339 * Returns: 1 if ok, 0 on error.
2340 */
2341 static HsInt loadObj_ (pathchar *path)
2342 {
2343 ObjectCode* oc;
2344 IF_DEBUG(linker, debugBelch("loadObj %" PATH_FMT "\n", path));
2345
2346 /* debugBelch("loadObj %s\n", path ); */
2347
2348 /* Check that we haven't already loaded this object.
2349 Ignore requests to load multiple times */
2350
2351 if (isAlreadyLoaded(path)) {
2352 IF_DEBUG(linker,
2353 debugBelch("ignoring repeated load of %" PATH_FMT "\n", path));
2354 return 1; /* success */
2355 }
2356
2357 oc = preloadObjectFile(path);
2358 if (oc == NULL) return 0;
2359
2360 if (! loadOc(oc)) {
2361 // failed; free everything we've allocated
2362 removeOcSymbols(oc);
2363 // no need to freeOcStablePtrs, they aren't created until resolveObjs()
2364 freeObjectCode(oc);
2365 return 0;
2366 }
2367
2368 oc->next = objects;
2369 objects = oc;
2370 return 1;
2371 }
2372
2373 HsInt loadObj (pathchar *path)
2374 {
2375 ACQUIRE_LOCK(&linker_mutex);
2376 HsInt r = loadObj_(path);
2377 RELEASE_LOCK(&linker_mutex);
2378 return r;
2379 }
2380
2381 static HsInt loadOc (ObjectCode* oc)
2382 {
2383 int r;
2384
2385 IF_DEBUG(linker, debugBelch("loadOc: start\n"));
2386
2387 /* verify the in-memory image */
2388 # if defined(OBJFORMAT_ELF)
2389 r = ocVerifyImage_ELF ( oc );
2390 # elif defined(OBJFORMAT_PEi386)
2391 r = ocVerifyImage_PEi386 ( oc );
2392 # elif defined(OBJFORMAT_MACHO)
2393 r = ocVerifyImage_MachO ( oc );
2394 # else
2395 barf("loadObj: no verify method");
2396 # endif
2397 if (!r) {
2398 IF_DEBUG(linker, debugBelch("loadOc: ocVerifyImage_* failed\n"));
2399 return r;
2400 }
2401
2402 #if NEED_SYMBOL_EXTRAS
2403 # if defined(OBJFORMAT_MACHO)
2404 r = ocAllocateSymbolExtras_MachO ( oc );
2405 if (!r) {
2406 IF_DEBUG(linker, debugBelch("loadOc: ocAllocateSymbolExtras_MachO failed\n"));
2407 return r;
2408 }
2409 # elif defined(OBJFORMAT_ELF)
2410 r = ocAllocateSymbolExtras_ELF ( oc );
2411 if (!r) {
2412 IF_DEBUG(linker, debugBelch("loadOc: ocAllocateSymbolExtras_ELF failed\n"));
2413 return r;
2414 }
2415 # elif defined(OBJFORMAT_PEi386)
2416 ocAllocateSymbolExtras_PEi386 ( oc );
2417 # endif
2418 #endif
2419
2420 /* build the symbol list for this image */
2421 # if defined(OBJFORMAT_ELF)
2422 r = ocGetNames_ELF ( oc );
2423 # elif defined(OBJFORMAT_PEi386)
2424 r = ocGetNames_PEi386 ( oc );
2425 # elif defined(OBJFORMAT_MACHO)
2426 r = ocGetNames_MachO ( oc );
2427 # else
2428 barf("loadObj: no getNames method");
2429 # endif
2430 if (!r) {
2431 IF_DEBUG(linker, debugBelch("loadOc: ocGetNames_* failed\n"));
2432 return r;
2433 }
2434
2435 /* loaded, but not resolved yet */
2436 oc->status = OBJECT_LOADED;
2437 IF_DEBUG(linker, debugBelch("loadOc: done.\n"));
2438
2439 return 1;
2440 }
2441
2442 /* -----------------------------------------------------------------------------
2443 * resolve all the currently unlinked objects in memory
2444 *
2445 * Returns: 1 if ok, 0 on error.
2446 */
2447 static HsInt resolveObjs_ (void)
2448 {
2449 ObjectCode *oc;
2450 int r;
2451
2452 IF_DEBUG(linker, debugBelch("resolveObjs: start\n"));
2453
2454 for (oc = objects; oc; oc = oc->next) {
2455 if (oc->status != OBJECT_RESOLVED) {
2456 # if defined(OBJFORMAT_ELF)
2457 r = ocResolve_ELF ( oc );
2458 # elif defined(OBJFORMAT_PEi386)
2459 r = ocResolve_PEi386 ( oc );
2460 # elif defined(OBJFORMAT_MACHO)
2461 r = ocResolve_MachO ( oc );
2462 # else
2463 barf("resolveObjs: not implemented on this platform");
2464 # endif
2465 if (!r) { return r; }
2466
2467 // run init/init_array/ctors/mod_init_func
2468
2469 loading_obj = oc; // tells foreignExportStablePtr what to do
2470 #if defined(OBJFORMAT_ELF)
2471 r = ocRunInit_ELF ( oc );
2472 #elif defined(OBJFORMAT_PEi386)
2473 r = ocRunInit_PEi386 ( oc );
2474 #elif defined(OBJFORMAT_MACHO)
2475 r = ocRunInit_MachO ( oc );
2476 #else
2477 barf("resolveObjs: initializers not implemented on this platform");
2478 #endif
2479 loading_obj = NULL;
2480
2481 if (!r) { return r; }
2482
2483 oc->status = OBJECT_RESOLVED;
2484 }
2485 }
2486
2487 #ifdef PROFILING
2488 // collect any new cost centres & CCSs that were defined during runInit
2489 initProfiling2();
2490 #endif
2491
2492 IF_DEBUG(linker, debugBelch("resolveObjs: done\n"));
2493 return 1;
2494 }
2495
2496 HsInt resolveObjs (void)
2497 {
2498 ACQUIRE_LOCK(&linker_mutex);
2499 HsInt r = resolveObjs_();
2500 RELEASE_LOCK(&linker_mutex);
2501 return r;
2502 }
2503
2504 /* -----------------------------------------------------------------------------
2505 * delete an object from the pool
2506 */
2507 static HsInt unloadObj_ (pathchar *path, rtsBool just_purge)
2508 {
2509 ObjectCode *oc, *prev, *next;
2510 HsBool unloadedAnyObj = HS_BOOL_FALSE;
2511
2512 ASSERT(symhash != NULL);
2513 ASSERT(objects != NULL);
2514
2515 IF_DEBUG(linker, debugBelch("unloadObj: %" PATH_FMT "\n", path));
2516
2517 prev = NULL;
2518 for (oc = objects; oc; oc = next) {
2519 next = oc->next; // oc might be freed
2520
2521 if (!pathcmp(oc->fileName,path)) {
2522
2523 // these are both idempotent, so in just_purge mode we can
2524 // later call unloadObj() to really unload the object.
2525 removeOcSymbols(oc);
2526 freeOcStablePtrs(oc);
2527
2528 if (!just_purge) {
2529 if (prev == NULL) {
2530 objects = oc->next;
2531 } else {
2532 prev->next = oc->next;
2533 }
2534 ACQUIRE_LOCK(&linker_unloaded_mutex);
2535 oc->next = unloaded_objects;
2536 unloaded_objects = oc;
2537 oc->status = OBJECT_UNLOADED;
2538 RELEASE_LOCK(&linker_unloaded_mutex);
2539 // We do not own oc any more; it can be released at any time by
2540 // the GC in checkUnload().
2541 } else {
2542 prev = oc;
2543 }
2544
2545 /* This could be a member of an archive so continue
2546 * unloading other members. */
2547 unloadedAnyObj = HS_BOOL_TRUE;
2548 } else {
2549 prev = oc;
2550 }
2551 }
2552
2553 if (unloadedAnyObj) {
2554 return 1;
2555 }
2556 else {
2557 errorBelch("unloadObj: can't find `%" PATH_FMT "' to unload", path);
2558 return 0;
2559 }
2560 }
2561
2562 HsInt unloadObj (pathchar *path)
2563 {
2564 ACQUIRE_LOCK(&linker_mutex);
2565 HsInt r = unloadObj_(path, rtsFalse);
2566 RELEASE_LOCK(&linker_mutex);
2567 return r;
2568 }
2569
2570 HsInt purgeObj (pathchar *path)
2571 {
2572 ACQUIRE_LOCK(&linker_mutex);
2573 HsInt r = unloadObj_(path, rtsTrue);
2574 RELEASE_LOCK(&linker_mutex);
2575 return r;
2576 }
2577
2578 /* -----------------------------------------------------------------------------
2579 * Sanity checking. For each ObjectCode, maintain a list of address ranges
2580 * which may be prodded during relocation, and abort if we try and write
2581 * outside any of these.
2582 */
2583 static void
2584 addProddableBlock ( ObjectCode* oc, void* start, int size )
2585 {
2586 ProddableBlock* pb
2587 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
2588
2589 IF_DEBUG(linker, debugBelch("addProddableBlock: %p %p %d\n", oc, start, size));
2590 ASSERT(size > 0);
2591 pb->start = start;
2592 pb->size = size;
2593 pb->next = oc->proddables;
2594 oc->proddables = pb;
2595 }
2596
2597 static void
2598 checkProddableBlock (ObjectCode *oc, void *addr, size_t size )
2599 {
2600 ProddableBlock* pb;
2601
2602 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
2603 char* s = (char*)(pb->start);
2604 char* e = s + pb->size;
2605 char* a = (char*)addr;
2606 if (a >= s && (a+size) <= e) return;
2607 }
2608 barf("checkProddableBlock: invalid fixup in runtime linker: %p", addr);
2609 }
2610
2611 static void freeProddableBlocks (ObjectCode *oc)
2612 {
2613 ProddableBlock *pb, *next;
2614
2615 for (pb = oc->proddables; pb != NULL; pb = next) {
2616 next = pb->next;
2617 stgFree(pb);
2618 }
2619 oc->proddables = NULL;
2620 }
2621
2622 /* -----------------------------------------------------------------------------
2623 * Section management.
2624 */
2625 static void
2626 addSection (Section *s, SectionKind kind, SectionAlloc alloc,
2627 void* start, StgWord size, StgWord mapped_offset,
2628 void* mapped_start, StgWord mapped_size)
2629 {
2630 s->start = start; /* actual start of section in memory */
2631 s->size = size; /* actual size of section in memory */
2632 s->kind = kind;
2633 s->alloc = alloc;
2634 s->mapped_offset = mapped_offset; /* offset from the image of mapped_start */
2635
2636 s->mapped_start = mapped_start; /* start of mmap() block */
2637 s->mapped_size = mapped_size; /* size of mmap() block */
2638
2639 IF_DEBUG(linker,
2640 debugBelch("addSection: %p-%p (size %" FMT_Word "), kind %d\n",
2641 start, (void*)((StgWord)start + size),
2642 size, kind ));
2643 }
2644
2645
2646 /* --------------------------------------------------------------------------
2647 * Symbol Extras.
2648 * This is about allocating a small chunk of memory for every symbol in the
2649 * object file. We make sure that the SymboLExtras are always "in range" of
2650 * limited-range PC-relative instructions on various platforms by allocating
2651 * them right next to the object code itself.
2652 */
2653
2654 #if NEED_SYMBOL_EXTRAS
2655 #if !defined(x86_64_HOST_ARCH) || !defined(mingw32_HOST_OS)
2656
2657 /*
2658 ocAllocateSymbolExtras
2659
2660 Allocate additional space at the end of the object file image to make room
2661 for jump islands (powerpc, x86_64, arm) and GOT entries (x86_64).
2662
2663 PowerPC relative branch instructions have a 24 bit displacement field.
2664 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
2665 If a particular imported symbol is outside this range, we have to redirect
2666 the jump to a short piece of new code that just loads the 32bit absolute
2667 address and jumps there.
2668 On x86_64, PC-relative jumps and PC-relative accesses to the GOT are limited
2669 to 32 bits (+-2GB).
2670
2671 This function just allocates space for one SymbolExtra for every
2672 undefined symbol in the object file. The code for the jump islands is
2673 filled in by makeSymbolExtra below.
2674 */
2675
2676 static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
2677 {
2678 StgWord n;
2679
2680 #if USE_MMAP
2681 if (USE_CONTIGUOUS_MMAP)
2682 {
2683 n = roundUpToPage(oc->fileSize);
2684
2685 /* Keep image and symbol_extras contiguous */
2686 void *new = mmapForLinker(n + (sizeof(SymbolExtra) * count),
2687 MAP_ANONYMOUS, -1, 0);
2688 if (new)
2689 {
2690 memcpy(new, oc->image, oc->fileSize);
2691 if (oc->imageMapped) {
2692 munmap(oc->image, n);
2693 }
2694 oc->image = new;
2695 oc->imageMapped = rtsTrue;
2696 oc->fileSize = n + (sizeof(SymbolExtra) * count);
2697 oc->symbol_extras = (SymbolExtra *) (oc->image + n);
2698 }
2699 else {
2700 oc->symbol_extras = NULL;
2701 return 0;
2702 }
2703 }
2704 else
2705 #endif
2706
2707 if( count > 0 )
2708 {
2709 #if USE_MMAP
2710 n = roundUpToPage(oc->fileSize);
2711
2712 oc->symbol_extras = m32_alloc(&allocator,
2713 sizeof(SymbolExtra) * count, 8);
2714 if (oc->symbol_extras == NULL) return 0;
2715 #else
2716 // round up to the nearest 4
2717 int aligned = (oc->fileSize + 3) & ~3;
2718
2719 int misalignment = oc->misalignment;
2720
2721 oc->image -= misalignment;
2722 oc->image = stgReallocBytes( oc->image,
2723 misalignment +
2724 aligned + sizeof (SymbolExtra) * count,
2725 "ocAllocateSymbolExtras" );
2726 oc->image += misalignment;
2727
2728 oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
2729 #endif /* USE_MMAP */
2730 }
2731
2732 if (oc->symbol_extras != NULL) {
2733 memset( oc->symbol_extras, 0, sizeof (SymbolExtra) * count );
2734 }
2735
2736 oc->first_symbol_extra = first;
2737 oc->n_symbol_extras = count;
2738
2739 return 1;
2740 }
2741
2742 #endif
2743 #endif // NEED_SYMBOL_EXTRAS
2744
2745 #if defined(arm_HOST_ARCH)
2746
2747 static void
2748 ocFlushInstructionCache( ObjectCode *oc )
2749 {
2750 int i;
2751 // Object code
2752 for (i=0; i < oc->n_sections; i++) {
2753 Section *s = &oc->sections[i];
2754 // This is a bit too broad but we don't have any way to determine what
2755 // is certainly code
2756 if (s->kind == SECTIONKIND_CODE_OR_RODATA)
2757 __clear_cache(s->start, (void*) ((uintptr_t) s->start + s->size));
2758 }
2759
2760 // Jump islands
2761 // Note the (+1) to ensure that the last symbol extra is covered by the
2762 // flush.
2763 __clear_cache(oc->symbol_extras, &oc->symbol_extras[oc->n_symbol_extras+1]);
2764 }
2765
2766 #endif
2767
2768 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
2769 #if !defined(x86_64_HOST_ARCH) || !defined(mingw32_HOST_OS)
2770
2771 static SymbolExtra* makeSymbolExtra( ObjectCode* oc,
2772 unsigned long symbolNumber,
2773 unsigned long target )
2774 {
2775 SymbolExtra *extra;
2776
2777 ASSERT( symbolNumber >= oc->first_symbol_extra
2778 && symbolNumber - oc->first_symbol_extra < oc->n_symbol_extras);
2779
2780 extra = &oc->symbol_extras[symbolNumber - oc->first_symbol_extra];
2781
2782 #ifdef powerpc_HOST_ARCH
2783 // lis r12, hi16(target)
2784 extra->jumpIsland.lis_r12 = 0x3d80;
2785 extra->jumpIsland.hi_addr = target >> 16;
2786
2787 // ori r12, r12, lo16(target)
2788 extra->jumpIsland.ori_r12_r12 = 0x618c;
2789 extra->jumpIsland.lo_addr = target & 0xffff;
2790
2791 // mtctr r12
2792 extra->jumpIsland.mtctr_r12 = 0x7d8903a6;
2793
2794 // bctr
2795 extra->jumpIsland.bctr = 0x4e800420;
2796 #endif
2797 #ifdef x86_64_HOST_ARCH
2798 // jmp *-14(%rip)
2799 static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
2800 extra->addr = target;
2801 memcpy(extra->jumpIsland, jmp, 6);
2802 #endif
2803
2804 return extra;
2805 }
2806
2807 #endif
2808 #endif // defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
2809
2810 #ifdef arm_HOST_ARCH
2811 static SymbolExtra* makeArmSymbolExtra( ObjectCode* oc,
2812 unsigned long symbolNumber,
2813 unsigned long target,
2814 int fromThumb,
2815 int toThumb )
2816 {
2817 SymbolExtra *extra;
2818
2819 ASSERT( symbolNumber >= oc->first_symbol_extra
2820 && symbolNumber - oc->first_symbol_extra < oc->n_symbol_extras);
2821
2822 extra = &oc->symbol_extras[symbolNumber - oc->first_symbol_extra];
2823
2824 // Make sure instruction mode bit is set properly
2825 if (toThumb)
2826 target |= 1;
2827 else
2828 target &= ~1;
2829
2830 if (!fromThumb) {
2831 // In ARM encoding:
2832 // movw r12, #0
2833 // movt r12, #0
2834 // bx r12
2835 uint32_t code[] = { 0xe300c000, 0xe340c000, 0xe12fff1c };
2836
2837 // Patch lower half-word into movw
2838 code[0] |= ((target>>12) & 0xf) << 16;
2839 code[0] |= target & 0xfff;
2840 // Patch upper half-word into movt
2841 target >>= 16;
2842 code[1] |= ((target>>12) & 0xf) << 16;
2843 code[1] |= target & 0xfff;
2844
2845 memcpy(extra->jumpIsland, code, 12);
2846
2847 } else {
2848 // In Thumb encoding:
2849 // movw r12, #0
2850 // movt r12, #0
2851 // bx r12
2852 uint16_t code[] = { 0xf240, 0x0c00,
2853 0xf2c0, 0x0c00,
2854 0x4760 };
2855
2856 // Patch lower half-word into movw
2857 code[0] |= (target>>12) & 0xf;
2858 code[0] |= ((target>>11) & 0x1) << 10;
2859 code[1] |= ((target>>8) & 0x7) << 12;
2860 code[1] |= target & 0xff;
2861 // Patch upper half-word into movt
2862 target >>= 16;
2863 code[2] |= (target>>12) & 0xf;
2864 code[2] |= ((target>>11) & 0x1) << 10;
2865 code[3] |= ((target>>8) & 0x7) << 12;
2866 code[3] |= target & 0xff;
2867
2868 memcpy(extra->jumpIsland, code, 10);
2869 }
2870
2871 return extra;
2872 }
2873 #endif // arm_HOST_ARCH
2874
2875 /* --------------------------------------------------------------------------
2876 * PowerPC specifics (instruction cache flushing)
2877 * ------------------------------------------------------------------------*/
2878
2879 #ifdef powerpc_HOST_ARCH
2880 /*
2881 ocFlushInstructionCache
2882
2883 Flush the data & instruction caches.
2884 Because the PPC has split data/instruction caches, we have to
2885 do that whenever we modify code at runtime.
2886 */
2887
2888 static void
2889 ocFlushInstructionCacheFrom(void* begin, size_t length)
2890 {
2891 size_t n = (length + 3) / 4;
2892 unsigned long* p = begin;
2893
2894 while (n--)
2895 {
2896 __asm__ volatile ( "dcbf 0,%0\n\t"
2897 "sync\n\t"
2898 "icbi 0,%0"
2899 :
2900 : "r" (p)
2901 );
2902 p++;
2903 }
2904 __asm__ volatile ( "sync\n\t"
2905 "isync"
2906 );
2907 }
2908
2909 static void
2910 ocFlushInstructionCache( ObjectCode *oc )
2911 {
2912 /* The main object code */
2913 ocFlushInstructionCacheFrom(oc->image + oc->misalignment, oc->fileSize);
2914
2915 /* Jump Islands */
2916 ocFlushInstructionCacheFrom(oc->symbol_extras, sizeof(SymbolExtra) * oc->n_symbol_extras);
2917 }
2918 #endif /* powerpc_HOST_ARCH */
2919
2920
2921 /* --------------------------------------------------------------------------
2922 * PEi386(+) specifics (Win32 targets)
2923 * ------------------------------------------------------------------------*/
2924
2925 /* The information for this linker comes from
2926 Microsoft Portable Executable
2927 and Common Object File Format Specification
2928 revision 8.3 February 2013
2929
2930 It can be found online at:
2931
2932 https://msdn.microsoft.com/en-us/windows/hardware/gg463119.aspx
2933
2934 Things move, so if that fails, try searching for it via
2935
2936 http://www.google.com/search?q=PE+COFF+specification
2937
2938 The ultimate reference for the PE format is the Winnt.h
2939 header file that comes with the Platform SDKs; as always,
2940 implementations will drift wrt their documentation.
2941
2942 A good background article on the PE format is Matt Pietrek's
2943 March 1994 article in Microsoft System Journal (MSJ)
2944 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
2945 Win32 Portable Executable File Format." The info in there
2946 has recently been updated in a two part article in
2947 MSDN magazine, issues Feb and March 2002,
2948 "Inside Windows: An In-Depth Look into the Win32 Portable
2949 Executable File Format"
2950
2951 John Levine's book "Linkers and Loaders" contains useful
2952 info on PE too.
2953
2954 The PE specification doesn't specify how to do the actual
2955 relocations. For this reason, and because both PE and ELF are
2956 based on COFF, the relocations for the PEi386+ code is based on
2957 the ELF relocations for the equivalent relocation type.
2958
2959 The ELF ABI can be found at
2960
2961 http://www.x86-64.org/documentation/abi.pdf
2962
2963 The current code is based on version 0.99.6 - October 2013
2964 */
2965
2966
2967 #if defined(OBJFORMAT_PEi386)
2968
2969
2970
2971 typedef unsigned char UChar;
2972 typedef unsigned short UInt16;
2973 typedef unsigned int UInt32;
2974 typedef int Int32;
2975 typedef unsigned long long int UInt64;
2976
2977
2978 typedef
2979 struct {
2980 UInt16 Machine;
2981 UInt16 NumberOfSections;
2982 UInt32 TimeDateStamp;
2983 UInt32 PointerToSymbolTable;
2984 UInt32 NumberOfSymbols;
2985 UInt16 SizeOfOptionalHeader;
2986 UInt16 Characteristics;
2987 }
2988 COFF_header;
2989
2990 #define sizeof_COFF_header 20
2991
2992
2993 typedef
2994 struct {
2995 UChar Name[8];
2996 UInt32 VirtualSize;
2997 UInt32 VirtualAddress;
2998 UInt32 SizeOfRawData;
2999 UInt32 PointerToRawData;
3000 UInt32 PointerToRelocations;
3001 UInt32 PointerToLinenumbers;
3002 UInt16 NumberOfRelocations;
3003 UInt16 NumberOfLineNumbers;
3004 UInt32 Characteristics;
3005 }
3006 COFF_section;
3007
3008 #define sizeof_COFF_section 40
3009
3010
3011 typedef
3012 struct {
3013 UChar Name[8];
3014 UInt32 Value;
3015 UInt16 SectionNumber;
3016 UInt16 Type;
3017 UChar StorageClass;
3018 UChar NumberOfAuxSymbols;
3019 }
3020 COFF_symbol;
3021
3022 #define sizeof_COFF_symbol 18
3023
3024
3025 typedef
3026 struct {
3027 UInt32 VirtualAddress;
3028 UInt32 SymbolTableIndex;
3029 UInt16 Type;
3030 }
3031 COFF_reloc;
3032
3033 #define sizeof_COFF_reloc 10
3034
3035 /* From PE spec doc, section 3.3.2 */
3036 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
3037 windows.h -- for the same purpose, but I want to know what I'm
3038 getting, here. */
3039 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
3040 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
3041 #define MYIMAGE_FILE_DLL 0x2000
3042 #define MYIMAGE_FILE_SYSTEM 0x1000
3043 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
3044 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
3045 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
3046
3047 /* From PE spec doc, section 5.4.2 and 5.4.4 */
3048 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
3049 #define MYIMAGE_SYM_CLASS_STATIC 3
3050 #define MYIMAGE_SYM_UNDEFINED 0
3051
3052 /* From PE spec doc, section 3.1 */
3053 #define MYIMAGE_SCN_CNT_CODE 0x00000020
3054 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
3055 #define MYIMAGE_SCN_CNT_UNINITIALIZED_DATA 0x00000080
3056 #define MYIMAGE_SCN_LNK_COMDAT 0x00001000
3057 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
3058 #define MYIMAGE_SCN_LNK_REMOVE 0x00000800
3059 #define MYIMAGE_SCN_MEM_DISCARDABLE 0x02000000
3060
3061 /* From PE spec doc, section 5.2.1 */
3062 #define MYIMAGE_REL_I386_DIR32 0x0006
3063 #define MYIMAGE_REL_I386_REL32 0x0014
3064
3065 static int verifyCOFFHeader ( COFF_header *hdr, pathchar *filename);
3066
3067 /* We assume file pointer is right at the
3068 beginning of COFF object.
3069 */
3070 static char *
3071 allocateImageAndTrampolines (
3072 pathchar* arch_name, char* member_name,
3073 #if defined(x86_64_HOST_ARCH)
3074 FILE* f,
3075 #endif
3076 int size )
3077 {
3078 char* image;
3079 #if defined(x86_64_HOST_ARCH)
3080 /* PeCoff contains number of symbols right in it's header, so
3081 we can reserve the room for symbolExtras right here. */
3082 COFF_header hdr;
3083 size_t n;
3084
3085 n = fread ( &hdr, 1, sizeof_COFF_header, f );
3086 if (n != sizeof( COFF_header )) {
3087 errorBelch("getNumberOfSymbols: error whilst reading `%s' header in `%S'",
3088 member_name, arch_name);
3089 return NULL;
3090 }
3091 fseek( f, -sizeof_COFF_header, SEEK_CUR );
3092
3093 if (!verifyCOFFHeader(&hdr, arch_name)) {
3094 return 0;
3095 }
3096
3097 /* We get back 8-byte aligned memory (is that guaranteed?), but
3098 the offsets to the sections within the file are all 4 mod 8
3099 (is that guaranteed?). We therefore need to offset the image
3100 by 4, so that all the pointers are 8-byte aligned, so that
3101 pointer tagging works. */
3102 /* For 32-bit case we don't need this, hence we use macro PEi386_IMAGE_OFFSET,
3103 which equals to 4 for 64-bit case and 0 for 32-bit case. */
3104 /* We allocate trampolines area for all symbols right behind
3105 image data, aligned on 8. */
3106 size = ((PEi386_IMAGE_OFFSET + size + 0x7) & ~0x7)
3107 + hdr.NumberOfSymbols * sizeof(SymbolExtra);
3108 #endif
3109 image = VirtualAlloc(NULL, size,
3110 MEM_RESERVE | MEM_COMMIT,
3111 PAGE_EXECUTE_READWRITE);
3112
3113 if (image == NULL) {
3114 errorBelch("%" PATH_FMT ": failed to allocate memory for image for %s",
3115 arch_name, member_name);
3116 return NULL;
3117 }
3118
3119 return image + PEi386_IMAGE_OFFSET;
3120 }
3121
3122 /* We use myindex to calculate array addresses, rather than
3123 simply doing the normal subscript thing. That's because
3124 some of the above structs have sizes which are not
3125 a whole number of words. GCC rounds their sizes up to a
3126 whole number of words, which means that the address calcs
3127 arising from using normal C indexing or pointer arithmetic
3128 are just plain wrong. Sigh.
3129 */
3130 static UChar *
3131 myindex ( int scale, void* base, int index )
3132 {
3133 return
3134 ((UChar*)base) + scale * index;
3135 }
3136
3137
3138 static void
3139 printName ( UChar* name, UChar* strtab )
3140 {
3141 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
3142 UInt32 strtab_offset = * (UInt32*)(name+4);
3143 debugBelch("%s", strtab + strtab_offset );
3144 } else {
3145 int i;
3146 for (i = 0; i < 8; i++) {
3147 if (name[i] == 0) break;
3148 debugBelch("%c", name[i] );
3149 }
3150 }
3151 }
3152
3153
3154 static void
3155 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
3156 {
3157 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
3158 UInt32 strtab_offset = * (UInt32*)(name+4);
3159 strncpy ( (char*)dst, (char*)strtab+strtab_offset, dstSize );
3160 dst[dstSize-1] = 0;
3161 } else {
3162 int i = 0;
3163 while (1) {
3164 if (i >= 8) break;
3165 if (name[i] == 0) break;
3166 dst[i] = name[i];
3167 i++;
3168 }
3169 dst[i] = 0;
3170 }
3171 }
3172
3173
3174 static UChar *
3175 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
3176 {
3177 UChar* newstr;
3178 /* If the string is longer than 8 bytes, look in the
3179 string table for it -- this will be correctly zero terminated.
3180 */
3181 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
3182 UInt32 strtab_offset = * (UInt32*)(name+4);
3183 return ((UChar*)strtab) + strtab_offset;
3184 }
3185 /* Otherwise, if shorter than 8 bytes, return the original,
3186 which by defn is correctly terminated.
3187 */
3188 if (name[7]==0) return name;
3189 /* The annoying case: 8 bytes. Copy into a temporary
3190 (XXX which is never freed ...)
3191 */
3192 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
3193 ASSERT(newstr);
3194 strncpy((char*)newstr,(char*)name,8);
3195 newstr[8] = 0;
3196 return newstr;
3197 }
3198
3199 /* Getting the name of a section is mildly tricky, so we make a
3200 function for it. Sadly, in one case we have to copy the string
3201 (when it is exactly 8 bytes long there's no trailing '\0'), so for
3202 consistency we *always* copy the string; the caller must free it
3203 */
3204 static char *
3205 cstring_from_section_name (UChar* name, UChar* strtab)
3206 {
3207 char *newstr;
3208
3209 if (name[0]=='/') {
3210 int strtab_offset = strtol((char*)name+1,NULL,10);
3211 int len = strlen(((char*)strtab) + strtab_offset);
3212
3213 newstr = stgMallocBytes(len+1, "cstring_from_section_symbol_name");
3214 strcpy((char*)newstr, (char*)((UChar*)strtab) + strtab_offset);
3215 return newstr;
3216 }
3217 else
3218 {
3219 newstr = stgMallocBytes(9, "cstring_from_section_symbol_name");
3220 ASSERT(newstr);
3221 strncpy((char*)newstr,(char*)name,8);
3222 newstr[8] = 0;
3223 return newstr;
3224 }
3225 }
3226
3227 /* Just compares the short names (first 8 chars) */
3228 static COFF_section *
3229 findPEi386SectionCalled ( ObjectCode* oc, UChar* name, UChar* strtab )
3230 {
3231 int i;
3232 rtsBool long_name = rtsFalse;
3233 COFF_header* hdr
3234 = (COFF_header*)(oc->image);
3235 COFF_section* sectab
3236 = (COFF_section*) (
3237 ((UChar*)(oc->image))
3238 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
3239 );
3240 // String is longer than 8 bytes, swap in the proper
3241 // (NULL-terminated) version, and make a note that this
3242 // is a long name.
3243 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
3244 UInt32 strtab_offset = * (UInt32*)(name+4);
3245 name = ((UChar*)strtab) + strtab_offset;
3246 long_name = rtsTrue;
3247 }
3248 for (i = 0; i < hdr->NumberOfSections; i++) {
3249 UChar* n1;
3250 UChar* n2;
3251 COFF_section* section_i
3252 = (COFF_section*)
3253 myindex ( sizeof_COFF_section, sectab, i );
3254 n1 = (UChar*) &(section_i->Name);
3255 n2 = name;
3256 // Long section names are prefixed with a slash, see
3257 // also cstring_from_section_name
3258 if (n1[0] == '/' && long_name) {
3259 // Long name check
3260 // We don't really want to make an assumption that the string
3261 // table indexes are the same, so we'll do a proper check.
3262 int n1_strtab_offset = strtol((char*)n1+1,NULL,10);
3263 n1 = (UChar*) (((char*)strtab) + n1_strtab_offset);
3264 if (0==strcmp((const char*)n1, (const char*)n2)) {
3265 return section_i;
3266 }
3267 } else if (n1[0] != '/' && !long_name) {
3268 // Short name check
3269 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
3270 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
3271 n1[6]==n2[6] && n1[7]==n2[7]) {
3272 return section_i;
3273 }
3274 } else {
3275 // guaranteed to mismatch, because we never attempt to link
3276 // in an executable where the section name may be truncated
3277 }
3278 }
3279
3280 return NULL;
3281 }
3282
3283 /* See Note [mingw-w64 name decoration scheme] */
3284 #ifndef x86_64_HOST_ARCH
3285 static void
3286 zapTrailingAtSign ( UChar* sym )
3287 {
3288 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
3289 int i, j;
3290 if (sym[0] == 0) return;
3291 i = 0;
3292 while (sym[i] != 0) i++;
3293 i--;
3294 j = i;
3295 while (j > 0 && my_isdigit(sym[j])) j--;
3296 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
3297 # undef my_isdigit
3298 }
3299 #endif
3300
3301 /* See Note [mingw-w64 name decoration scheme] */
3302 #ifndef x86_64_HOST_ARCH
3303 #define STRIP_LEADING_UNDERSCORE 1
3304 #else
3305 #define STRIP_LEADING_UNDERSCORE 0
3306 #endif
3307
3308 /*
3309 Note [mingw-w64 name decoration scheme]
3310
3311 What's going on with name decoration? Well, original code
3312 have some crufty and ad-hocish paths related mostly to very old
3313 mingw gcc/binutils/runtime combinations. Now mingw-w64 offers pretty
3314 uniform and MS-compatible decoration scheme across its tools and runtime.
3315
3316 The scheme is pretty straightforward: on 32 bit objects symbols are exported
3317 with underscore prepended (and @ + stack size suffix appended for stdcall
3318 functions), on 64 bits no underscore is prepended and no suffix is appended
3319 because we have no stdcall convention on 64 bits.
3320
3321 See #9218
3322 */
3323
3324 static void *
3325 lookupSymbolInDLLs ( UChar *lbl )
3326 {
3327 OpenedDLL* o_dll;
3328 void *sym;
3329
3330 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
3331 /* debugBelch("look in %ls for %s\n", o_dll->name, lbl); */
3332
3333 sym = GetProcAddress(o_dll->instance, (char*)(lbl+STRIP_LEADING_UNDERSCORE));
3334 if (sym != NULL) {
3335 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
3336 return sym;
3337 }
3338
3339 /* Ticket #2283.
3340 Long description: http://support.microsoft.com/kb/132044
3341 tl;dr:
3342 If C/C++ compiler sees __declspec(dllimport) ... foo ...
3343 it generates call *__imp_foo, and __imp_foo here has exactly
3344 the same semantics as in __imp_foo = GetProcAddress(..., "foo")
3345 */
3346 if (sym == NULL && strncmp ((const char*)lbl, "__imp_", 6) == 0) {
3347 sym = GetProcAddress(o_dll->instance, (char*)(lbl+6+STRIP_LEADING_UNDERSCORE));
3348 if (sym != NULL) {
3349 IndirectAddr* ret;
3350 ret = stgMallocBytes( sizeof(IndirectAddr), "lookupSymbolInDLLs" );
3351 ret->addr = sym;
3352 ret->next = indirects;
3353 indirects = ret;
3354 IF_DEBUG(linker,
3355 debugBelch("warning: %s from %S is linked instead of %s",
3356 (char*)(lbl+6+STRIP_LEADING_UNDERSCORE), o_dll->name, (char*)lbl));
3357 return (void*) & ret->addr;
3358 }
3359 }
3360
3361 sym = GetProcAddress(o_dll->instance, (char*)lbl);
3362 if (sym != NULL) {
3363 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
3364 return sym;
3365 }
3366 }
3367 return NULL;
3368 }
3369
3370 static int
3371 verifyCOFFHeader (COFF_header *hdr, pathchar *fileName)
3372 {
3373 #if defined(i386_HOST_ARCH)
3374 if (hdr->Machine != 0x14c) {
3375 errorBelch("%" PATH_FMT ": Not x86 PEi386", fileName);
3376 return 0;
3377 }
3378 #elif defined(x86_64_HOST_ARCH)
3379 if (hdr->Machine != 0x8664) {
3380 errorBelch("%" PATH_FMT ": Not x86_64 PEi386", fileName);
3381 return 0;
3382 }
3383 #else
3384 errorBelch("PEi386 not supported on this arch");
3385 #endif
3386
3387 if (hdr->SizeOfOptionalHeader != 0) {
3388 errorBelch("%" PATH_FMT ": PEi386 with nonempty optional header",
3389 fileName);
3390 return 0;
3391 }
3392 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
3393 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
3394 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
3395 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
3396 errorBelch("%" PATH_FMT ": Not a PEi386 object file", fileName);
3397 return 0;
3398 }
3399 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
3400 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
3401 errorBelch("%" PATH_FMT ": Invalid PEi386 word size or endiannness: %d",
3402 fileName,
3403 (int)(hdr->Characteristics));
3404 return 0;
3405 }
3406 return 1;
3407 }
3408
3409 static int
3410 ocVerifyImage_PEi386 ( ObjectCode* oc )
3411 {
3412 int i;
3413 UInt32 j, noRelocs;
3414 COFF_header* hdr;
3415 COFF_section* sectab;
3416 COFF_symbol* symtab;
3417 UChar* strtab;
3418 /* debugBelch("\nLOADING %s\n", oc->fileName); */
3419 hdr = (COFF_header*)(oc->image);
3420 sectab = (COFF_section*) (
3421 ((UChar*)(oc->image))
3422 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
3423 );
3424 symtab = (COFF_symbol*) (
3425 ((UChar*)(oc->image))
3426 + hdr->PointerToSymbolTable
3427 );
3428 strtab = ((UChar*)symtab)
3429 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
3430
3431 if (!verifyCOFFHeader(hdr, oc->fileName)) {
3432 return 0;
3433 }
3434
3435 /* If the string table size is way crazy, this might indicate that
3436 there are more than 64k relocations, despite claims to the
3437 contrary. Hence this test. */
3438 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
3439 #if 0
3440 if ( (*(UInt32*)strtab) > 600000 ) {
3441 /* Note that 600k has no special significance other than being
3442 big enough to handle the almost-2MB-sized lumps that
3443 constitute HSwin32*.o. */
3444 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
3445 return 0;
3446 }
3447 #endif
3448
3449 /* No further verification after this point; only debug printing. */
3450 i = 0;
3451 IF_DEBUG(linker, i=1);
3452 if (i == 0) return 1;
3453
3454 debugBelch( "sectab offset = %" FMT_Int "\n", ((UChar*)sectab) - ((UChar*)hdr) );
3455 debugBelch( "symtab offset = %" FMT_Int "\n", ((UChar*)symtab) - ((UChar*)hdr) );
3456 debugBelch( "strtab offset = %" FMT_Int "\n", ((UChar*)strtab) - ((UChar*)hdr) );
3457
3458 debugBelch("\n" );
3459 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
3460 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
3461 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
3462 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
3463 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
3464 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
3465 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
3466
3467 /* Print the section table. */
3468 debugBelch("\n" );
3469 for (i = 0; i < hdr->NumberOfSections; i++) {
3470 COFF_reloc* reltab;
3471 COFF_section* sectab_i
3472 = (COFF_section*)
3473 myindex ( sizeof_COFF_section, sectab, i );
3474 debugBelch(
3475 "\n"
3476 "section %d\n"
3477 " name `",
3478 i
3479 );
3480 printName ( sectab_i->Name, strtab );
3481 debugBelch(
3482 "'\n"
3483 " vsize %d\n"
3484 " vaddr %d\n"
3485 " data sz %d\n"
3486 " data off %d\n"
3487 " num rel %d\n"
3488 " off rel %d\n"
3489 " ptr raw 0x%x\n",
3490 sectab_i->VirtualSize,
3491 sectab_i->VirtualAddress,
3492 sectab_i->SizeOfRawData,
3493 sectab_i->PointerToRawData,
3494 sectab_i->NumberOfRelocations,
3495 sectab_i->PointerToRelocations,
3496 sectab_i->PointerToRawData
3497 );
3498 reltab = (COFF_reloc*) (
3499 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
3500 );
3501
3502 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
3503 /* If the relocation field (a short) has overflowed, the
3504 * real count can be found in the first reloc entry.
3505 *
3506 * See Section 4.1 (last para) of the PE spec (rev6.0).
3507 */
3508 COFF_reloc* rel = (COFF_reloc*)
3509 myindex ( sizeof_COFF_reloc, reltab, 0 );
3510 noRelocs = rel->VirtualAddress;
3511 j = 1;
3512 } else {
3513 noRelocs = sectab_i->NumberOfRelocations;
3514 j = 0;
3515 }
3516
3517 for (; j < noRelocs; j++) {
3518 COFF_symbol* sym;
3519 COFF_reloc* rel = (COFF_reloc*)
3520 myindex ( sizeof_COFF_reloc, reltab, j );
3521 debugBelch(
3522 " type 0x%-4x vaddr 0x%-8x name `",
3523 (UInt32)rel->Type,
3524 rel->VirtualAddress );
3525 sym = (COFF_symbol*)
3526 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
3527 /* Hmm..mysterious looking offset - what's it for? SOF */
3528 printName ( sym->Name, strtab -10 );
3529 debugBelch("'\n" );
3530 }
3531
3532 debugBelch("\n" );
3533 }
3534 debugBelch("\n" );
3535 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
3536 debugBelch("---START of string table---\n");
3537 for (i = 4; i < *(Int32*)strtab; i++) {
3538 if (strtab[i] == 0)
3539 debugBelch("\n"); else
3540 debugBelch("%c", strtab[i] );
3541 }
3542 debugBelch("--- END of string table---\n");
3543
3544 debugBelch("\n" );
3545 i = 0;
3546 while (1) {
3547 COFF_symbol* symtab_i;
3548 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
3549 symtab_i = (COFF_symbol*)
3550 myindex ( sizeof_COFF_symbol, symtab, i );
3551 debugBelch(
3552 "symbol %d\n"
3553 " name `",
3554 i
3555 );
3556 printName ( symtab_i->Name, strtab );
3557 debugBelch(
3558 "'\n"
3559 " value 0x%x\n"
3560 " 1+sec# %d\n"
3561 " type 0x%x\n"
3562 " sclass 0x%x\n"
3563 " nAux %d\n",
3564 symtab_i->Value,
3565 (Int32)(symtab_i->SectionNumber),
3566 (UInt32)symtab_i->Type,
3567 (UInt32)symtab_i->StorageClass,
3568 (UInt32)symtab_i->NumberOfAuxSymbols
3569 );
3570 i += symtab_i->NumberOfAuxSymbols;
3571 i++;
3572 }
3573
3574 debugBelch("\n" );
3575 return 1;
3576 }
3577
3578
3579 static int
3580 ocGetNames_PEi386 ( ObjectCode* oc )
3581 {
3582 COFF_header* hdr;
3583 COFF_section* sectab;
3584 COFF_symbol* symtab;
3585 UChar* strtab;
3586
3587 UChar* sname;
3588 void* addr;
3589 int i;
3590
3591 hdr = (COFF_header*)(oc->image);
3592 sectab = (COFF_section*) (
3593 ((UChar*)(oc->image))
3594 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
3595 );
3596 symtab = (COFF_symbol*) (
3597 ((UChar*)(oc->image))
3598 + hdr->PointerToSymbolTable
3599 );
3600 strtab = ((UChar*)(oc->image))
3601 + hdr->PointerToSymbolTable
3602 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
3603
3604 /* Allocate space for any (local, anonymous) .bss sections. */
3605
3606 for (i = 0; i < hdr->NumberOfSections; i++) {
3607 UInt32 bss_sz;
3608 UChar* zspace;
3609 COFF_section* sectab_i
3610 = (COFF_section*)
3611 myindex ( sizeof_COFF_section, sectab, i );
3612
3613 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
3614
3615 if (0 != strcmp(secname, ".bss")) {
3616 stgFree(secname);
3617 continue;
3618 }
3619
3620 stgFree(secname);
3621
3622 /* sof 10/05: the PE spec text isn't too clear regarding what
3623 * the SizeOfRawData field is supposed to hold for object
3624 * file sections containing just uninitialized data -- for executables,
3625 * it is supposed to be zero; unclear what it's supposed to be
3626 * for object files. However, VirtualSize is guaranteed to be
3627 * zero for object files, which definitely suggests that SizeOfRawData
3628 * will be non-zero (where else would the size of this .bss section be
3629 * stored?) Looking at the COFF_section info for incoming object files,
3630 * this certainly appears to be the case.
3631 *
3632 * => I suspect we've been incorrectly handling .bss sections in (relocatable)
3633 * object files up until now. This turned out to bite us with ghc-6.4.1's use
3634 * of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
3635 * variable decls into the .bss section. (The specific function in Q which
3636 * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
3637 */
3638 if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
3639 /* This is a non-empty .bss section. Allocate zeroed space for
3640 it, and set its PointerToRawData field such that oc->image +
3641 PointerToRawData == addr_of_zeroed_space. */
3642 bss_sz = sectab_i->VirtualSize;
3643 if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
3644 zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
3645 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
3646 addProddableBlock(oc, zspace, bss_sz);
3647 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
3648 }
3649
3650 Section *sections;
3651 sections = (Section*)stgCallocBytes(
3652 sizeof(Section),
3653 hdr->NumberOfSections + 1, /* +1 for the global BSS section see below */
3654 "ocGetNames_PEi386(sections)");
3655 oc->sections = sections;
3656 oc->n_sections = hdr->NumberOfSections + 1;
3657
3658 /* Copy section information into the ObjectCode. */
3659
3660 for (i = 0; i < hdr->NumberOfSections; i++) {
3661 UChar* start;
3662 UChar* end;
3663 UInt32 sz;
3664
3665 /* By default consider all section as CODE or DATA, which means we want to load them. */
3666 SectionKind kind
3667 = SECTIONKIND_CODE_OR_RODATA;
3668 COFF_section* sectab_i
3669 = (COFF_section*)
3670 myindex ( sizeof_COFF_section, sectab, i );
3671
3672 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
3673
3674 IF_DEBUG(linker, debugBelch("section name = %s\n", secname ));
3675
3676 /* The PE file section flag indicates whether the section contains code or data. */
3677 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
3678 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
3679 kind = SECTIONKIND_CODE_OR_RODATA;
3680
3681 /* Check next if it contains any uninitialized data */
3682 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_UNINITIALIZED_DATA)
3683 kind = SECTIONKIND_RWDATA;
3684
3685 /* Finally check if it can be discarded. This will also ignore .debug sections */
3686 if (sectab_i->Characteristics & MYIMAGE_SCN_MEM_DISCARDABLE ||
3687 sectab_i->Characteristics & MYIMAGE_SCN_LNK_REMOVE)
3688 kind = SECTIONKIND_OTHER;
3689
3690 if (0==strcmp(".ctors", (char*)secname))
3691 kind = SECTIONKIND_INIT_ARRAY;
3692
3693 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
3694 sz = sectab_i->SizeOfRawData;
3695 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
3696
3697 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
3698 end = start + sz - 1;
3699
3700 if (kind != SECTIONKIND_OTHER && end >= start) {
3701 addSection(&sections[i], kind, SECTION_NOMEM, start, sz, 0, 0, 0);
3702 addProddableBlock(oc, start, end - start + 1);
3703 }
3704
3705 stgFree(secname);
3706 }
3707
3708 /* Copy exported symbols into the ObjectCode. */
3709
3710 oc->n_symbols = hdr->NumberOfSymbols;
3711 oc->symbols = stgCallocBytes(sizeof(char*), oc->n_symbols,
3712 "ocGetNames_PEi386(oc->symbols)");
3713
3714 /* Work out the size of the global BSS section */
3715 StgWord globalBssSize = 0;
3716 for (i=0; i < (int)hdr->NumberOfSymbols; i++) {
3717 COFF_symbol* symtab_i;
3718 symtab_i = (COFF_symbol*)
3719 myindex ( sizeof_COFF_symbol, symtab, i );
3720 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
3721 && symtab_i->Value > 0) {
3722 globalBssSize += symtab_i->Value;
3723 }
3724 i += symtab_i->NumberOfAuxSymbols;
3725 }
3726
3727 /* Allocate BSS space */
3728 void *bss = NULL;
3729 if (globalBssSize > 0) {
3730 bss = stgCallocBytes(1, globalBssSize,
3731 "ocGetNames_PEi386(non-anonymous bss)");
3732 addSection(&sections[oc->n_sections-1],
3733 SECTIONKIND_RWDATA, SECTION_MALLOC,
3734 bss, globalBssSize, 0, 0, 0);
3735 IF_DEBUG(linker, debugBelch("bss @ %p %" FMT_Word "\n", bss, globalBssSize));
3736 addProddableBlock(oc, bss, globalBssSize);
3737 } else {
3738 addSection(&sections[oc->n_sections-1],
3739 SECTIONKIND_OTHER, SECTION_NOMEM, NULL, 0, 0, 0, 0);
3740 }
3741
3742 for (i = 0; i < oc->n_symbols; i++) {
3743 COFF_symbol* symtab_i;
3744 symtab_i = (COFF_symbol*)
3745 myindex ( sizeof_COFF_symbol, symtab, i );
3746
3747 addr = NULL;
3748
3749 HsBool isWeak = HS_BOOL_FALSE;
3750 if (symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
3751 /* This symbol is global and defined, viz, exported */
3752 /* for MYIMAGE_SYMCLASS_EXTERNAL
3753 && !MYIMAGE_SYM_UNDEFINED,
3754 the address of the symbol is:
3755 address of relevant section + offset in section
3756 */
3757 COFF_section* sectabent
3758 = (COFF_section*) myindex ( sizeof_COFF_section,
3759 sectab,
3760 symtab_i->SectionNumber-1 );
3761 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
3762 || ( symtab_i->StorageClass == MYIMAGE_SYM_CLASS_STATIC
3763 && sectabent->Characteristics & MYIMAGE_SCN_LNK_COMDAT)
3764 ) {
3765 addr = ((UChar*)(oc->image))
3766 + (sectabent->PointerToRawData
3767 + symtab_i->Value);
3768 if (sectabent->Characteristics & MYIMAGE_SCN_LNK_COMDAT) {
3769 isWeak = HS_BOOL_TRUE;
3770 }
3771 }
3772 }
3773 else
3774 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
3775 && symtab_i->Value > 0) {
3776 /* This symbol isn't in any section at all, ie, global bss.
3777 Allocate zeroed space for it from the BSS section */
3778 addr = bss;
3779 bss = (void *)((StgWord)bss + (StgWord)symtab_i->Value);
3780 IF_DEBUG(linker, debugBelch("bss symbol @ %p %u\n", addr, symtab_i->Value));
3781 }
3782
3783 if (addr != NULL ) {
3784 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
3785 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
3786 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
3787 ASSERT(i >= 0 && i < oc->n_symbols);
3788 /* cstring_from_COFF_symbol_name always succeeds. */
3789 oc->symbols[i] = (char*)sname;
3790 if (! ghciInsertSymbolTable(oc->fileName, symhash, (char*)sname, addr,
3791 isWeak, oc)) {
3792 return 0;
3793 }
3794 } else {
3795 # if 0
3796 debugBelch(
3797 "IGNORING symbol %d\n"
3798 " name `",
3799 i
3800 );
3801 printName ( symtab_i->Name, strtab );
3802 debugBelch(
3803 "'\n"
3804 " value 0x%x\n"
3805 " 1+sec# %d\n"
3806 " type 0x%x\n"
3807 " sclass 0x%x\n"
3808 " nAux %d\n",
3809 symtab_i->Value,
3810 (Int32)(symtab_i->SectionNumber),
3811 (UInt32)symtab_i->Type,
3812 (UInt32)symtab_i->StorageClass,
3813 (UInt32)symtab_i->NumberOfAuxSymbols
3814 );
3815 # endif
3816 }
3817
3818 i += symtab_i->NumberOfAuxSymbols;
3819 }
3820
3821 return 1;
3822 }
3823
3824 #if defined(x86_64_HOST_ARCH)
3825
3826 /* We've already reserved a room for symbol extras in loadObj,
3827 * so simply set correct pointer here.
3828 */
3829 static int
3830 ocAllocateSymbolExtras_PEi386 ( ObjectCode* oc )
3831 {
3832 oc->symbol_extras = (SymbolExtra*)(oc->image - PEi386_IMAGE_OFFSET
3833 + ((PEi386_IMAGE_OFFSET + oc->fileSize + 0x7) & ~0x7));
3834 oc->first_symbol_extra = 0;
3835 oc->n_symbol_extras = ((COFF_header*)oc->image)->NumberOfSymbols;
3836
3837 return 1;
3838 }
3839
3840 static size_t
3841 makeSymbolExtra_PEi386( ObjectCode* oc, size_t s, char* symbol )
3842 {
3843 unsigned int curr_thunk;
3844 SymbolExtra *extra;
3845
3846 curr_thunk = oc->first_symbol_extra;
3847 if (curr_thunk >= oc->n_symbol_extras) {
3848 barf("Can't allocate thunk for %s", symbol);
3849 }
3850
3851 extra = oc->symbol_extras + curr_thunk;
3852
3853 // jmp *-14(%rip)
3854 static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
3855 extra->addr = (uint64_t)s;
3856 memcpy(extra->jumpIsland, jmp, 6);
3857
3858 oc->first_symbol_extra++;
3859
3860 return (size_t)extra->jumpIsland;
3861 }
3862
3863 #endif
3864
3865 static int
3866 ocResolve_PEi386 ( ObjectCode* oc )
3867 {
3868 COFF_header* hdr;
3869 COFF_section* sectab;
3870 COFF_symbol* symtab;
3871 UChar* strtab;
3872
3873 UInt32 A;
3874 size_t S;
3875 void * pP;
3876
3877 int i;
3878 UInt32 j, noRelocs;
3879
3880 /* ToDo: should be variable-sized? But is at least safe in the
3881 sense of buffer-overrun-proof. */
3882 UChar symbol[1000];
3883 /* debugBelch("resolving for %s\n", oc->fileName); */
3884
3885 hdr = (COFF_header*)(oc->image);
3886 sectab = (COFF_section*) (
3887 ((UChar*)(oc->image))
3888 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
3889 );
3890 symtab = (COFF_symbol*) (
3891 ((UChar*)(oc->image))
3892 + hdr->PointerToSymbolTable
3893 );
3894 strtab = ((UChar*)(oc->image))
3895 + hdr->PointerToSymbolTable
3896 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
3897
3898 for (i = 0; i < hdr->NumberOfSections; i++) {
3899 COFF_section* sectab_i
3900 = (COFF_section*)
3901 myindex ( sizeof_COFF_section, sectab, i );
3902 COFF_reloc* reltab
3903 = (COFF_reloc*) (
3904 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
3905 );
3906
3907 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
3908
3909 /* Ignore sections called which contain stabs debugging information. */
3910 if ( 0 == strcmp(".stab", (char*)secname)
3911 || 0 == strcmp(".stabstr", (char*)secname)
3912 || 0 == strncmp(".pdata", (char*)secname, 6)
3913 || 0 == strncmp(".xdata", (char*)secname, 6)
3914 || 0 == strncmp(".debug", (char*)secname, 6)
3915 || 0 == strcmp(".rdata$zzz", (char*)secname)) {
3916 stgFree(secname);
3917 continue;
3918 }
3919
3920 stgFree(secname);
3921
3922 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
3923 /* If the relocation field (a short) has overflowed, the
3924 * real count can be found in the first reloc entry.
3925 *
3926 * See Section 4.1 (last para) of the PE spec (rev6.0).
3927 *
3928 * Nov2003 update: the GNU linker still doesn't correctly
3929 * handle the generation of relocatable object files with
3930 * overflown relocations. Hence the output to warn of potential
3931 * troubles.
3932 */
3933 COFF_reloc* rel = (COFF_reloc*)
3934 myindex ( sizeof_COFF_reloc, reltab, 0 );
3935 noRelocs = rel->VirtualAddress;
3936
3937 /* 10/05: we now assume (and check for) a GNU ld that is capable
3938 * of handling object files with (>2^16) of relocs.
3939 */
3940 #if 0
3941 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
3942 noRelocs);
3943 #endif
3944 j = 1;
3945 } else {
3946 noRelocs = sectab_i->NumberOfRelocations;
3947 j = 0;
3948 }
3949
3950 for (; j < noRelocs; j++) {
3951 COFF_symbol* sym;
3952 COFF_reloc* reltab_j
3953 = (COFF_reloc*)