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