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