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