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