ELF/x86_64: map object file sections separately into the low 2GB
[ghc.git] / rts / Linker.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 2000-2012
4 *
5 * RTS Object Linker
6 *
7 * ---------------------------------------------------------------------------*/
8
9 #if 0
10 #include "PosixSource.h"
11 #endif
12
13 /* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and
14 MREMAP_MAYMOVE from <sys/mman.h>.
15 */
16 #if defined(__linux__) || defined(__GLIBC__)
17 #define _GNU_SOURCE 1
18 #endif
19
20 #include "Rts.h"
21 #include "HsFFI.h"
22
23 #include "sm/Storage.h"
24 #include "Stats.h"
25 #include "Hash.h"
26 #include "LinkerInternals.h"
27 #include "RtsUtils.h"
28 #include "Trace.h"
29 #include "StgPrimFloat.h" // for __int_encodeFloat etc.
30 #include "Proftimer.h"
31 #include "GetEnv.h"
32 #include "Stable.h"
33
34 #if !defined(mingw32_HOST_OS)
35 #include "posix/Signals.h"
36 #endif
37
38 // get protos for is*()
39 #include <ctype.h>
40
41 #ifdef HAVE_SYS_TYPES_H
42 #include <sys/types.h>
43 #endif
44
45 #include <inttypes.h>
46 #include <stdlib.h>
47 #include <string.h>
48 #include <stdio.h>
49 #include <assert.h>
50 #include <libgen.h>
51
52 #ifdef HAVE_SYS_STAT_H
53 #include <sys/stat.h>
54 #endif
55
56 #if defined(HAVE_DLFCN_H)
57 #include <dlfcn.h>
58 #endif
59
60 #if defined(cygwin32_HOST_OS)
61 #ifdef HAVE_DIRENT_H
62 #include <dirent.h>
63 #endif
64
65 #ifdef HAVE_SYS_TIME_H
66 #include <sys/time.h>
67 #endif
68 #include <regex.h>
69 #include <sys/fcntl.h>
70 #include <sys/termios.h>
71 #include <sys/utime.h>
72 #include <sys/utsname.h>
73 #include <sys/wait.h>
74 #endif
75
76 #if (defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS)) \
77 || (!defined(powerpc_HOST_ARCH) && \
78 ( defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || \
79 defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS ) || \
80 defined(openbsd_HOST_OS ) || defined(darwin_HOST_OS ) || \
81 defined(kfreebsdgnu_HOST_OS) || defined(gnu_HOST_OS)))
82 /* Don't use mmap on powerpc_HOST_ARCH as mmap doesn't support
83 * reallocating but we need to allocate jump islands just after each
84 * object images. Otherwise relative branches to jump islands can fail
85 * due to 24-bits displacement overflow.
86 */
87 #define USE_MMAP
88 #include <fcntl.h>
89 #include <sys/mman.h>
90
91 #ifdef HAVE_UNISTD_H
92 #include <unistd.h>
93 #endif
94
95 #endif
96
97
98 /* PowerPC has relative branch instructions with only 24 bit displacements
99 * and therefore needs jump islands contiguous with each object code module.
100 */
101 #if (defined(USE_MMAP) && defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS))
102 #define USE_CONTIGUOUS_MMAP 1
103 #else
104 #define USE_CONTIGUOUS_MMAP 0
105 #endif
106
107 #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)
108 # define OBJFORMAT_ELF
109 # include <regex.h> // regex is already used by dlopen() so this is OK
110 // to use here without requiring an additional lib
111 #elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
112 # define OBJFORMAT_PEi386
113 # include <windows.h>
114 # include <shfolder.h> /* SHGetFolderPathW */
115 # include <math.h>
116 #elif defined(darwin_HOST_OS)
117 # define OBJFORMAT_MACHO
118 # include <regex.h>
119 # include <mach/machine.h>
120 # include <mach-o/fat.h>
121 # include <mach-o/loader.h>
122 # include <mach-o/nlist.h>
123 # include <mach-o/reloc.h>
124 #if !defined(HAVE_DLFCN_H)
125 # include <mach-o/dyld.h>
126 #endif
127 #if defined(powerpc_HOST_ARCH)
128 # include <mach-o/ppc/reloc.h>
129 #endif
130 #if defined(x86_64_HOST_ARCH)
131 # include <mach-o/x86_64/reloc.h>
132 #endif
133 #endif
134
135 #if defined(x86_64_HOST_ARCH) && defined(darwin_HOST_OS)
136 #define ALWAYS_PIC
137 #endif
138
139 #if defined(dragonfly_HOST_OS)
140 #include <sys/tls.h>
141 #endif
142
143 typedef struct _RtsSymbolInfo {
144 void *value;
145 const ObjectCode *owner;
146 HsBool weak;
147 } RtsSymbolInfo;
148
149 /* Hash table mapping symbol names to RtsSymbolInfo */
150 static /*Str*/HashTable *symhash;
151
152 /* List of currently loaded objects */
153 ObjectCode *objects = NULL; /* initially empty */
154
155 /* List of objects that have been unloaded via unloadObj(), but are waiting
156 to be actually freed via checkUnload() */
157 ObjectCode *unloaded_objects = NULL; /* initially empty */
158
159 #ifdef THREADED_RTS
160 /* This protects all the Linker's global state except unloaded_objects */
161 Mutex linker_mutex;
162 /*
163 * This protects unloaded_objects. We have a separate mutex for this, because
164 * the GC needs to access unloaded_objects in checkUnload, while the linker only
165 * needs to access unloaded_objects in unloadObj(), so this allows most linker
166 * operations proceed concurrently with the GC.
167 */
168 Mutex linker_unloaded_mutex;
169 #endif
170
171 /* Type of the initializer */
172 typedef void (*init_t) (int argc, char **argv, char **env);
173
174 static HsInt isAlreadyLoaded( pathchar *path );
175 static HsInt loadOc( ObjectCode* oc );
176 static ObjectCode* mkOc( pathchar *path, char *image, int imageSize,
177 rtsBool mapped, char *archiveMemberName
178 #ifndef USE_MMAP
179 #ifdef darwin_HOST_OS
180 , int misalignment
181 #endif
182 #endif
183 );
184
185 // Use wchar_t for pathnames on Windows (#5697)
186 #if defined(mingw32_HOST_OS)
187 #define pathcmp wcscmp
188 #define pathlen wcslen
189 #define pathopen _wfopen
190 #define pathstat _wstat
191 #define struct_stat struct _stat
192 #define open wopen
193 #define WSTR(s) L##s
194 #else
195 #define pathcmp strcmp
196 #define pathlen strlen
197 #define pathopen fopen
198 #define pathstat stat
199 #define struct_stat struct stat
200 #define WSTR(s) s
201 #endif
202
203 static pathchar* pathdup(pathchar *path)
204 {
205 pathchar *ret;
206 #if defined(mingw32_HOST_OS)
207 ret = wcsdup(path);
208 #else
209 /* sigh, strdup() isn't a POSIX function, so do it the long way */
210 ret = stgMallocBytes( strlen(path)+1, "loadObj" );
211 strcpy(ret, path);
212 #endif
213 return ret;
214 }
215
216
217 #if defined(OBJFORMAT_ELF)
218 static int ocVerifyImage_ELF ( ObjectCode* oc );
219 static int ocGetNames_ELF ( ObjectCode* oc );
220 static int ocResolve_ELF ( ObjectCode* oc );
221 static int ocRunInit_ELF ( ObjectCode* oc );
222 #if NEED_SYMBOL_EXTRAS
223 static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc );
224 #endif
225 #elif defined(OBJFORMAT_PEi386)
226 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
227 static int ocGetNames_PEi386 ( ObjectCode* oc );
228 static int ocResolve_PEi386 ( ObjectCode* oc );
229 static int ocRunInit_PEi386 ( ObjectCode* oc );
230 static void *lookupSymbolInDLLs ( unsigned char *lbl );
231 /* See Note [mingw-w64 name decoration scheme] */
232 #ifndef x86_64_HOST_ARCH
233 static void zapTrailingAtSign ( unsigned char *sym );
234 #endif
235 static char *allocateImageAndTrampolines (
236 pathchar* arch_name, char* member_name,
237 #if defined(x86_64_HOST_ARCH)
238 FILE* f,
239 #endif
240 int size );
241 #if defined(x86_64_HOST_ARCH)
242 static int ocAllocateSymbolExtras_PEi386 ( ObjectCode* oc );
243 static size_t makeSymbolExtra_PEi386( ObjectCode* oc, size_t, char* symbol );
244 #define PEi386_IMAGE_OFFSET 4
245 #else
246 #define PEi386_IMAGE_OFFSET 0
247 #endif
248 #elif defined(OBJFORMAT_MACHO)
249 static int ocVerifyImage_MachO ( ObjectCode* oc );
250 static int ocGetNames_MachO ( ObjectCode* oc );
251 static int ocResolve_MachO ( ObjectCode* oc );
252 static int ocRunInit_MachO ( ObjectCode* oc );
253
254 #ifndef USE_MMAP
255 static int machoGetMisalignment( FILE * );
256 #endif
257 #if NEED_SYMBOL_EXTRAS
258 static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
259 #endif
260 #ifdef powerpc_HOST_ARCH
261 static void machoInitSymbolsWithoutUnderscore( void );
262 #endif
263 #endif
264
265 static void freeProddableBlocks (ObjectCode *oc);
266
267 #ifdef USE_MMAP
268 /**
269 * An allocated page being filled by the allocator
270 */
271 struct m32_alloc_t {
272 void * base_addr; // Page address
273 unsigned int current_size; // Number of bytes already reserved
274 };
275
276 #define M32_MAX_PAGES 32
277
278 /**
279 * Allocator
280 *
281 * Currently an allocator is just a set of pages being filled. The maximum
282 * number of pages can be configured with M32_MAX_PAGES.
283 */
284 typedef struct m32_allocator_t {
285 struct m32_alloc_t pages[M32_MAX_PAGES];
286 } * m32_allocator;
287
288 // We use a global memory allocator
289 static struct m32_allocator_t allocator;
290
291 struct m32_allocator_t;
292 static void m32_allocator_init(struct m32_allocator_t *m32);
293 #endif
294
295 /* on x86_64 we have a problem with relocating symbol references in
296 * code that was compiled without -fPIC. By default, the small memory
297 * model is used, which assumes that symbol references can fit in a
298 * 32-bit slot. The system dynamic linker makes this work for
299 * references to shared libraries by either (a) allocating a jump
300 * table slot for code references, or (b) moving the symbol at load
301 * time (and copying its contents, if necessary) for data references.
302 *
303 * We unfortunately can't tell whether symbol references are to code
304 * or data. So for now we assume they are code (the vast majority
305 * are), and allocate jump-table slots. Unfortunately this will
306 * SILENTLY generate crashing code for data references. This hack is
307 * enabled by X86_64_ELF_NONPIC_HACK.
308 *
309 * One workaround is to use shared Haskell libraries. This is
310 * coming. Another workaround is to keep the static libraries but
311 * compile them with -fPIC, because that will generate PIC references
312 * to data which can be relocated. The PIC code is still too green to
313 * do this systematically, though.
314 *
315 * See bug #781
316 * See thread http://www.haskell.org/pipermail/cvs-ghc/2007-September/038458.html
317 *
318 * Naming Scheme for Symbol Macros
319 *
320 * SymI_*: symbol is internal to the RTS. It resides in an object
321 * file/library that is statically.
322 * SymE_*: symbol is external to the RTS library. It might be linked
323 * dynamically.
324 *
325 * Sym*_HasProto : the symbol prototype is imported in an include file
326 * or defined explicitly
327 * Sym*_NeedsProto: the symbol is undefined and we add a dummy
328 * default proto extern void sym(void);
329 */
330 #define X86_64_ELF_NONPIC_HACK 1
331
332 /* Link objects into the lower 2Gb on x86_64. GHC assumes the
333 * small memory model on this architecture (see gcc docs,
334 * -mcmodel=small).
335 *
336 * MAP_32BIT not available on OpenBSD/amd64
337 */
338 #if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
339 #define TRY_MAP_32BIT MAP_32BIT
340 #else
341 #define TRY_MAP_32BIT 0
342 #endif
343
344 /*
345 * Due to the small memory model (see above), on x86_64 we have to map
346 * all our non-PIC object files into the low 2Gb of the address space
347 * (why 2Gb and not 4Gb? Because all addresses must be reachable
348 * using a 32-bit signed PC-relative offset). On Linux we can do this
349 * using the MAP_32BIT flag to mmap(), however on other OSs
350 * (e.g. *BSD, see #2063, and also on Linux inside Xen, see #2512), we
351 * can't do this. So on these systems, we have to pick a base address
352 * in the low 2Gb of the address space and try to allocate memory from
353 * there.
354 *
355 * We pick a default address based on the OS, but also make this
356 * configurable via an RTS flag (+RTS -xm)
357 */
358 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
359
360 #if defined(MAP_32BIT)
361 // Try to use MAP_32BIT
362 #define MMAP_32BIT_BASE_DEFAULT 0
363 #else
364 // A guess: 1Gb.
365 #define MMAP_32BIT_BASE_DEFAULT 0x40000000
366 #endif
367
368 static void *mmap_32bit_base = (void *)MMAP_32BIT_BASE_DEFAULT;
369 #endif
370
371 /* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
372 #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
373 #define MAP_ANONYMOUS MAP_ANON
374 #endif
375
376 /* -----------------------------------------------------------------------------
377 * Built-in symbols from the RTS
378 */
379
380 typedef struct _RtsSymbolVal {
381 char *lbl;
382 void *addr;
383 } RtsSymbolVal;
384
385 #define Maybe_Stable_Names SymI_HasProto(stg_mkWeakzh) \
386 SymI_HasProto(stg_mkWeakNoFinalizzerzh) \
387 SymI_HasProto(stg_addCFinalizzerToWeakzh) \
388 SymI_HasProto(stg_makeStableNamezh) \
389 SymI_HasProto(stg_finalizzeWeakzh)
390
391 #if !defined (mingw32_HOST_OS)
392 #define RTS_POSIX_ONLY_SYMBOLS \
393 SymI_HasProto(__hscore_get_saved_termios) \
394 SymI_HasProto(__hscore_set_saved_termios) \
395 SymI_HasProto(shutdownHaskellAndSignal) \
396 SymI_HasProto(signal_handlers) \
397 SymI_HasProto(stg_sig_install) \
398 SymI_HasProto(rtsTimerSignal) \
399 SymI_HasProto(atexit) \
400 SymI_NeedsDataProto(nocldstop)
401 #endif
402
403 #if defined (cygwin32_HOST_OS)
404 #define RTS_MINGW_ONLY_SYMBOLS /**/
405 /* Don't have the ability to read import libs / archives, so
406 * we have to stupidly list a lot of what libcygwin.a
407 * exports; sigh.
408 */
409 #define RTS_CYGWIN_ONLY_SYMBOLS \
410 SymI_HasProto(regfree) \
411 SymI_HasProto(regexec) \
412 SymI_HasProto(regerror) \
413 SymI_HasProto(regcomp) \
414 SymI_HasProto(__errno) \
415 SymI_HasProto(access) \
416 SymI_HasProto(chmod) \
417 SymI_HasProto(chdir) \
418 SymI_HasProto(close) \
419 SymI_HasProto(creat) \
420 SymI_HasProto(dup) \
421 SymI_HasProto(dup2) \
422 SymI_HasProto(fstat) \
423 SymI_HasProto(fcntl) \
424 SymI_HasProto(getcwd) \
425 SymI_HasProto(getenv) \
426 SymI_HasProto(lseek) \
427 SymI_HasProto(open) \
428 SymI_HasProto(fpathconf) \
429 SymI_HasProto(pathconf) \
430 SymI_HasProto(stat) \
431 SymI_HasProto(pow) \
432 SymI_HasProto(tanh) \
433 SymI_HasProto(cosh) \
434 SymI_HasProto(sinh) \
435 SymI_HasProto(atan) \
436 SymI_HasProto(acos) \
437 SymI_HasProto(asin) \
438 SymI_HasProto(tan) \
439 SymI_HasProto(cos) \
440 SymI_HasProto(sin) \
441 SymI_HasProto(exp) \
442 SymI_HasProto(log) \
443 SymI_HasProto(sqrt) \
444 SymI_HasProto(localtime_r) \
445 SymI_HasProto(gmtime_r) \
446 SymI_HasProto(mktime) \
447 SymI_NeedsProto(_imp___tzname) \
448 SymI_HasProto(gettimeofday) \
449 SymI_HasProto(timezone) \
450 SymI_HasProto(tcgetattr) \
451 SymI_HasProto(tcsetattr) \
452 SymI_HasProto(memcpy) \
453 SymI_HasProto(memmove) \
454 SymI_HasProto(realloc) \
455 SymI_HasProto(malloc) \
456 SymI_HasProto(free) \
457 SymI_HasProto(fork) \
458 SymI_HasProto(lstat) \
459 SymI_HasProto(isatty) \
460 SymI_HasProto(mkdir) \
461 SymI_HasProto(opendir) \
462 SymI_HasProto(readdir) \
463 SymI_HasProto(rewinddir) \
464 SymI_HasProto(closedir) \
465 SymI_HasProto(link) \
466 SymI_HasProto(mkfifo) \
467 SymI_HasProto(pipe) \
468 SymI_HasProto(read) \
469 SymI_HasProto(rename) \
470 SymI_HasProto(rmdir) \
471 SymI_HasProto(select) \
472 SymI_HasProto(system) \
473 SymI_HasProto(write) \
474 SymI_HasProto(strcmp) \
475 SymI_HasProto(strcpy) \
476 SymI_HasProto(strncpy) \
477 SymI_HasProto(strerror) \
478 SymI_HasProto(sigaddset) \
479 SymI_HasProto(sigemptyset) \
480 SymI_HasProto(sigprocmask) \
481 SymI_HasProto(umask) \
482 SymI_HasProto(uname) \
483 SymI_HasProto(unlink) \
484 SymI_HasProto(utime) \
485 SymI_HasProto(waitpid)
486
487 #elif defined(mingw32_HOST_OS)
488 #define RTS_POSIX_ONLY_SYMBOLS /**/
489 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
490
491 #if HAVE_GETTIMEOFDAY
492 #define RTS_MINGW_GETTIMEOFDAY_SYM SymI_NeedsProto(gettimeofday)
493 #else
494 #define RTS_MINGW_GETTIMEOFDAY_SYM /**/
495 #endif
496
497 #if HAVE___MINGW_VFPRINTF
498 #define RTS___MINGW_VFPRINTF_SYM SymI_HasProto(__mingw_vfprintf)
499 #else
500 #define RTS___MINGW_VFPRINTF_SYM /**/
501 #endif
502
503 #if defined(i386_HOST_ARCH)
504 #define RTS_WIN32_ONLY(X) X
505 #else
506 #define RTS_WIN32_ONLY(X) /**/
507 #endif
508
509 #if defined(x86_64_HOST_ARCH)
510 #define RTS_WIN64_ONLY(X) X
511 #else
512 #define RTS_WIN64_ONLY(X) /**/
513 #endif
514
515 /* These are statically linked from the mingw libraries into the ghc
516 executable, so we have to employ this hack. */
517 #define RTS_MINGW_ONLY_SYMBOLS \
518 SymI_HasProto(stg_asyncReadzh) \
519 SymI_HasProto(stg_asyncWritezh) \
520 SymI_HasProto(stg_asyncDoProczh) \
521 SymI_HasProto(getWin32ProgArgv) \
522 SymI_HasProto(setWin32ProgArgv) \
523 SymI_HasProto(memset) \
524 SymI_HasProto(inet_ntoa) \
525 SymI_HasProto(inet_addr) \
526 SymI_HasProto(htonl) \
527 SymI_HasProto(recvfrom) \
528 SymI_HasProto(listen) \
529 SymI_HasProto(bind) \
530 SymI_HasProto(shutdown) \
531 SymI_HasProto(connect) \
532 SymI_HasProto(htons) \
533 SymI_HasProto(ntohs) \
534 SymI_HasProto(getservbyname) \
535 SymI_HasProto(getservbyport) \
536 SymI_HasProto(getprotobynumber) \
537 SymI_HasProto(getprotobyname) \
538 SymI_HasProto(gethostbyname) \
539 SymI_HasProto(gethostbyaddr) \
540 SymI_HasProto(gethostname) \
541 SymI_HasProto(strcpy) \
542 SymI_HasProto(strncpy) \
543 SymI_HasProto(abort) \
544 SymI_HasProto(isxdigit) \
545 SymI_HasProto(isupper) \
546 SymI_HasProto(ispunct) \
547 SymI_HasProto(islower) \
548 SymI_HasProto(isspace) \
549 SymI_HasProto(isprint) \
550 SymI_HasProto(isdigit) \
551 SymI_HasProto(iscntrl) \
552 SymI_HasProto(isalpha) \
553 SymI_HasProto(isalnum) \
554 SymI_HasProto(isascii) \
555 RTS___MINGW_VFPRINTF_SYM \
556 SymI_HasProto(strcmp) \
557 SymI_HasProto(memmove) \
558 SymI_HasProto(realloc) \
559 SymI_HasProto(malloc) \
560 SymI_HasProto(pow) \
561 SymI_HasProto(tanh) \
562 SymI_HasProto(cosh) \
563 SymI_HasProto(sinh) \
564 SymI_HasProto(atan) \
565 SymI_HasProto(acos) \
566 SymI_HasProto(asin) \
567 SymI_HasProto(tan) \
568 SymI_HasProto(cos) \
569 SymI_HasProto(sin) \
570 SymI_HasProto(exp) \
571 SymI_HasProto(log) \
572 SymI_HasProto(sqrt) \
573 SymI_HasProto(powf) \
574 SymI_HasProto(tanhf) \
575 SymI_HasProto(coshf) \
576 SymI_HasProto(sinhf) \
577 SymI_HasProto(atanf) \
578 SymI_HasProto(acosf) \
579 SymI_HasProto(asinf) \
580 SymI_HasProto(tanf) \
581 SymI_HasProto(cosf) \
582 SymI_HasProto(sinf) \
583 SymI_HasProto(expf) \
584 SymI_HasProto(logf) \
585 SymI_HasProto(sqrtf) \
586 SymI_HasProto(erf) \
587 SymI_HasProto(erfc) \
588 SymI_HasProto(erff) \
589 SymI_HasProto(erfcf) \
590 SymI_HasProto(memcpy) \
591 SymI_HasProto(rts_InstallConsoleEvent) \
592 SymI_HasProto(rts_ConsoleHandlerDone) \
593 SymI_NeedsProto(mktime) \
594 SymI_NeedsProto(localtime) \
595 SymI_NeedsProto(gmtime) \
596 SymI_NeedsProto(opendir) \
597 SymI_NeedsProto(readdir) \
598 SymI_NeedsProto(rewinddir) \
599 RTS_WIN32_ONLY(SymI_NeedsProto(__chkstk_ms)) \
600 RTS_WIN64_ONLY(SymI_NeedsProto(___chkstk_ms)) \
601 SymI_NeedsProto(localeconv) \
602 SymI_HasProto(close) \
603 SymI_HasProto(read) \
604 SymI_HasProto(dup) \
605 SymI_HasProto(dup2) \
606 SymI_HasProto(write) \
607 SymI_NeedsProto(getpid) \
608 SymI_HasProto(access) \
609 SymI_HasProto(chmod) \
610 SymI_HasProto(creat) \
611 SymI_HasProto(umask) \
612 SymI_HasProto(unlink) \
613 SymI_HasProto(_errno) \
614 SymI_NeedsProto(ftruncate64) \
615 SymI_HasProto(setmode) \
616 SymI_HasProto(_wstat64) \
617 SymI_HasProto(_fstat64) \
618 SymI_HasProto(_wsopen) \
619 RTS_WIN32_ONLY(SymI_HasProto(_imp___environ)) \
620 RTS_WIN64_ONLY(SymI_HasProto(__imp__environ)) \
621 RTS_WIN32_ONLY(SymI_HasProto(_imp___iob)) \
622 RTS_WIN64_ONLY(SymI_HasProto(__iob_func)) \
623 SymI_HasProto(GetFileAttributesA) \
624 SymI_HasProto(GetFileInformationByHandle) \
625 SymI_HasProto(GetFileType) \
626 SymI_HasProto(GetLastError) \
627 SymI_HasProto(QueryPerformanceFrequency) \
628 SymI_HasProto(QueryPerformanceCounter) \
629 SymI_HasProto(GetTickCount) \
630 SymI_HasProto(WaitForSingleObject) \
631 SymI_HasProto(PeekConsoleInputA) \
632 SymI_HasProto(ReadConsoleInputA) \
633 SymI_HasProto(PeekNamedPipe) \
634 SymI_HasProto(select) \
635 SymI_HasProto(isatty) \
636 SymI_HasProto(_get_osfhandle) \
637 SymI_HasProto(GetConsoleMode) \
638 SymI_HasProto(SetConsoleMode) \
639 SymI_HasProto(FlushConsoleInputBuffer) \
640 SymI_HasProto(free) \
641 SymI_NeedsProto(raise) \
642 SymI_NeedsProto(_getpid) \
643 SymI_HasProto(getc) \
644 SymI_HasProto(ungetc) \
645 SymI_HasProto(puts) \
646 SymI_HasProto(putc) \
647 SymI_HasProto(putchar) \
648 SymI_HasProto(fputc) \
649 SymI_HasProto(fread) \
650 SymI_HasProto(fwrite) \
651 SymI_HasProto(ferror) \
652 SymI_HasProto(printf) \
653 SymI_HasProto(fprintf) \
654 SymI_HasProto(sprintf) \
655 SymI_HasProto(vsprintf) \
656 SymI_HasProto(sscanf) \
657 SymI_HasProto(ldexp) \
658 SymI_HasProto(strlen) \
659 SymI_HasProto(strnlen) \
660 SymI_HasProto(strchr) \
661 SymI_HasProto(strtol) \
662 SymI_HasProto(strerror) \
663 SymI_HasProto(memchr) \
664 SymI_HasProto(memcmp) \
665 SymI_HasProto(wcscpy) \
666 SymI_HasProto(wcslen) \
667 SymI_HasProto(_lseeki64) \
668 SymI_HasProto(_wchmod) \
669 SymI_HasProto(closesocket) \
670 SymI_HasProto(send) \
671 SymI_HasProto(recv) \
672 SymI_HasProto(bsearch) \
673 SymI_HasProto(CommandLineToArgvW) \
674 SymI_HasProto(CreateBitmap) \
675 SymI_HasProto(CreateBitmapIndirect) \
676 SymI_HasProto(CreateCompatibleBitmap) \
677 SymI_HasProto(CreateDIBPatternBrushPt) \
678 SymI_HasProto(CreateDIBitmap) \
679 SymI_HasProto(SetBitmapDimensionEx) \
680 SymI_HasProto(GetBitmapDimensionEx) \
681 SymI_HasProto(GetStockObject) \
682 SymI_HasProto(GetObjectW) \
683 SymI_HasProto(DeleteObject) \
684 SymI_HasProto(SetDIBits) \
685 SymI_HasProto(GetDIBits) \
686 SymI_HasProto(CreateSolidBrush) \
687 SymI_HasProto(CreateHatchBrush) \
688 SymI_HasProto(CreatePatternBrush) \
689 SymI_HasProto(CreateFontW) \
690 SymI_HasProto(AngleArc) \
691 SymI_HasProto(Arc) \
692 SymI_HasProto(ArcTo) \
693 SymI_HasProto(BeginPath) \
694 SymI_HasProto(BitBlt) \
695 SymI_HasProto(CancelDC) \
696 SymI_HasProto(Chord) \
697 SymI_HasProto(CloseFigure) \
698 SymI_HasProto(CombineRgn) \
699 SymI_HasProto(CreateCompatibleDC) \
700 SymI_HasProto(CreateEllipticRgn) \
701 SymI_HasProto(CreateEllipticRgnIndirect) \
702 SymI_HasProto(CreatePen) \
703 SymI_HasProto(CreatePolygonRgn) \
704 SymI_HasProto(CreateRectRgn) \
705 SymI_HasProto(CreateRectRgnIndirect) \
706 SymI_HasProto(CreateRoundRectRgn) \
707 SymI_HasProto(DeleteDC) \
708 SymI_HasProto(Ellipse) \
709 SymI_HasProto(EndPath) \
710 SymI_HasProto(EqualRgn) \
711 SymI_HasProto(ExtSelectClipRgn) \
712 SymI_HasProto(FillPath) \
713 SymI_HasProto(FillRgn) \
714 SymI_HasProto(FlattenPath) \
715 SymI_HasProto(FrameRgn) \
716 SymI_HasProto(GetArcDirection) \
717 SymI_HasProto(GetBkColor) \
718 SymI_HasProto(GetBkMode) \
719 SymI_HasProto(GetBrushOrgEx) \
720 SymI_HasProto(GetCurrentObject) \
721 SymI_HasProto(GetDCOrgEx) \
722 SymI_HasProto(GetGraphicsMode) \
723 SymI_HasProto(GetMiterLimit) \
724 SymI_HasProto(GetPolyFillMode) \
725 SymI_HasProto(GetRgnBox) \
726 SymI_HasProto(GetStretchBltMode) \
727 SymI_HasProto(GetTextAlign) \
728 SymI_HasProto(GetTextCharacterExtra) \
729 SymI_HasProto(GetTextColor) \
730 SymI_HasProto(GetTextExtentPoint32W) \
731 SymI_HasProto(InvertRgn) \
732 SymI_HasProto(LineTo) \
733 SymI_HasProto(MaskBlt) \
734 SymI_HasProto(MoveToEx) \
735 SymI_HasProto(OffsetRgn) \
736 SymI_HasProto(PaintRgn) \
737 SymI_HasProto(PathToRegion) \
738 SymI_HasProto(Pie) \
739 SymI_HasProto(PlgBlt) \
740 SymI_HasProto(PolyBezier) \
741 SymI_HasProto(PolyBezierTo) \
742 SymI_HasProto(Polygon) \
743 SymI_HasProto(Polyline) \
744 SymI_HasProto(PolylineTo) \
745 SymI_HasProto(PtInRegion) \
746 SymI_HasProto(Rectangle) \
747 SymI_HasProto(RectInRegion) \
748 SymI_HasProto(RestoreDC) \
749 SymI_HasProto(RoundRect) \
750 SymI_HasProto(SaveDC) \
751 SymI_HasProto(SelectClipPath) \
752 SymI_HasProto(SelectClipRgn) \
753 SymI_HasProto(SelectObject) \
754 SymI_HasProto(SelectPalette) \
755 SymI_HasProto(SetArcDirection) \
756 SymI_HasProto(SetBkColor) \
757 SymI_HasProto(SetBkMode) \
758 SymI_HasProto(SetBrushOrgEx) \
759 SymI_HasProto(SetGraphicsMode) \
760 SymI_HasProto(SetMiterLimit) \
761 SymI_HasProto(SetPolyFillMode) \
762 SymI_HasProto(SetStretchBltMode) \
763 SymI_HasProto(SetTextAlign) \
764 SymI_HasProto(SetTextCharacterExtra) \
765 SymI_HasProto(SetTextColor) \
766 SymI_HasProto(StretchBlt) \
767 SymI_HasProto(StrokeAndFillPath) \
768 SymI_HasProto(StrokePath) \
769 SymI_HasProto(TextOutW) \
770 SymI_HasProto(timeGetTime) \
771 SymI_HasProto(WidenPath) \
772 SymI_HasProto(GetFileSecurityW) \
773 SymI_HasProto(RegCloseKey) \
774 SymI_HasProto(RegConnectRegistryW) \
775 SymI_HasProto(RegCreateKeyExW) \
776 SymI_HasProto(RegCreateKeyW) \
777 SymI_HasProto(RegDeleteKeyW) \
778 SymI_HasProto(RegDeleteValueW) \
779 SymI_HasProto(RegEnumKeyW) \
780 SymI_HasProto(RegEnumValueW) \
781 SymI_HasProto(RegFlushKey) \
782 SymI_HasProto(RegLoadKeyW) \
783 SymI_HasProto(RegNotifyChangeKeyValue) \
784 SymI_HasProto(RegOpenKeyExW) \
785 SymI_HasProto(RegOpenKeyW) \
786 SymI_HasProto(RegQueryInfoKeyW) \
787 SymI_HasProto(RegQueryValueExW) \
788 SymI_HasProto(RegQueryValueW) \
789 SymI_HasProto(RegReplaceKeyW) \
790 SymI_HasProto(RegRestoreKeyW) \
791 SymI_HasProto(RegSaveKeyW) \
792 SymI_HasProto(RegSetValueExW) \
793 SymI_HasProto(RegSetValueW) \
794 SymI_HasProto(RegUnLoadKeyW) \
795 SymI_HasProto(SHGetFolderPathW) \
796 RTS_WIN32_ONLY(SymI_HasProto(SetWindowLongW)) \
797 RTS_WIN32_ONLY(SymI_HasProto(GetWindowLongW)) \
798 RTS_WIN64_ONLY(SymI_HasProto(SetWindowLongPtrW)) \
799 RTS_WIN64_ONLY(SymI_HasProto(GetWindowLongPtrW)) \
800 SymI_HasProto(MenuItemFromPoint) \
801 SymI_HasProto(ChildWindowFromPoint) \
802 SymI_HasProto(ChildWindowFromPointEx) \
803 SymI_HasProto(UnmapViewOfFile) \
804 SymI_HasProto(CloseHandle) \
805 SymI_HasProto(FreeLibrary) \
806 SymI_HasProto(GetMessageW) \
807 SymI_HasProto(TranslateMessage) \
808 SymI_HasProto(DispatchMessageW) \
809 SymI_HasProto(DefWindowProcW) \
810 SymI_HasProto(GlobalAlloc) \
811 SymI_HasProto(GlobalFree) \
812 SymI_HasProto(CreateFileW) \
813 SymI_HasProto(WriteFile) \
814 SymI_HasProto(FormatMessageW) \
815 SymI_NeedsProto(_localtime64) \
816 SymI_NeedsProto(_tzname) \
817 SymI_NeedsProto(_timezone) \
818 SymI_HasProto(CreatePipe) \
819 SymI_HasProto(SetHandleInformation) \
820 SymI_HasProto(GetStdHandle) \
821 SymI_HasProto(GetCurrentProcess) \
822 SymI_HasProto(DuplicateHandle) \
823 SymI_HasProto(CreateProcessW) \
824 SymI_HasProto(TerminateProcess) \
825 SymI_HasProto(_open_osfhandle) \
826 SymI_HasProto(GetExitCodeProcess) \
827 RTS_MINGW_GETTIMEOFDAY_SYM \
828 SymI_NeedsProto(closedir)
829
830 #else
831 #define RTS_MINGW_ONLY_SYMBOLS /**/
832 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
833 #endif
834
835
836 #if defined(darwin_HOST_OS) && HAVE_PRINTF_LDBLSTUB
837 #define RTS_DARWIN_ONLY_SYMBOLS \
838 SymI_NeedsProto(asprintf$LDBLStub) \
839 SymI_NeedsProto(err$LDBLStub) \
840 SymI_NeedsProto(errc$LDBLStub) \
841 SymI_NeedsProto(errx$LDBLStub) \
842 SymI_NeedsProto(fprintf$LDBLStub) \
843 SymI_NeedsProto(fscanf$LDBLStub) \
844 SymI_NeedsProto(fwprintf$LDBLStub) \
845 SymI_NeedsProto(fwscanf$LDBLStub) \
846 SymI_NeedsProto(printf$LDBLStub) \
847 SymI_NeedsProto(scanf$LDBLStub) \
848 SymI_NeedsProto(snprintf$LDBLStub) \
849 SymI_NeedsProto(sprintf$LDBLStub) \
850 SymI_NeedsProto(sscanf$LDBLStub) \
851 SymI_NeedsProto(strtold$LDBLStub) \
852 SymI_NeedsProto(swprintf$LDBLStub) \
853 SymI_NeedsProto(swscanf$LDBLStub) \
854 SymI_NeedsProto(syslog$LDBLStub) \
855 SymI_NeedsProto(vasprintf$LDBLStub) \
856 SymI_NeedsProto(verr$LDBLStub) \
857 SymI_NeedsProto(verrc$LDBLStub) \
858 SymI_NeedsProto(verrx$LDBLStub) \
859 SymI_NeedsProto(vfprintf$LDBLStub) \
860 SymI_NeedsProto(vfscanf$LDBLStub) \
861 SymI_NeedsProto(vfwprintf$LDBLStub) \
862 SymI_NeedsProto(vfwscanf$LDBLStub) \
863 SymI_NeedsProto(vprintf$LDBLStub) \
864 SymI_NeedsProto(vscanf$LDBLStub) \
865 SymI_NeedsProto(vsnprintf$LDBLStub) \
866 SymI_NeedsProto(vsprintf$LDBLStub) \
867 SymI_NeedsProto(vsscanf$LDBLStub) \
868 SymI_NeedsProto(vswprintf$LDBLStub) \
869 SymI_NeedsProto(vswscanf$LDBLStub) \
870 SymI_NeedsProto(vsyslog$LDBLStub) \
871 SymI_NeedsProto(vwarn$LDBLStub) \
872 SymI_NeedsProto(vwarnc$LDBLStub) \
873 SymI_NeedsProto(vwarnx$LDBLStub) \
874 SymI_NeedsProto(vwprintf$LDBLStub) \
875 SymI_NeedsProto(vwscanf$LDBLStub) \
876 SymI_NeedsProto(warn$LDBLStub) \
877 SymI_NeedsProto(warnc$LDBLStub) \
878 SymI_NeedsProto(warnx$LDBLStub) \
879 SymI_NeedsProto(wcstold$LDBLStub) \
880 SymI_NeedsProto(wprintf$LDBLStub) \
881 SymI_NeedsProto(wscanf$LDBLStub)
882 #else
883 #define RTS_DARWIN_ONLY_SYMBOLS
884 #endif
885
886 #ifndef SMP
887 # define MAIN_CAP_SYM SymI_HasProto(MainCapability)
888 #else
889 # define MAIN_CAP_SYM
890 #endif
891
892 #if !defined(mingw32_HOST_OS)
893 #define RTS_USER_SIGNALS_SYMBOLS \
894 SymI_HasProto(setIOManagerControlFd) \
895 SymI_HasProto(setTimerManagerControlFd) \
896 SymI_HasProto(setIOManagerWakeupFd) \
897 SymI_HasProto(ioManagerWakeup) \
898 SymI_HasProto(blockUserSignals) \
899 SymI_HasProto(unblockUserSignals)
900 #else
901 #define RTS_USER_SIGNALS_SYMBOLS \
902 SymI_HasProto(ioManagerWakeup) \
903 SymI_HasProto(sendIOManagerEvent) \
904 SymI_HasProto(readIOManagerEvent) \
905 SymI_HasProto(getIOManagerEvent) \
906 SymI_HasProto(console_handler)
907 #endif
908
909 #define RTS_LIBFFI_SYMBOLS \
910 SymE_NeedsProto(ffi_prep_cif) \
911 SymE_NeedsProto(ffi_call) \
912 SymE_NeedsDataProto(ffi_type_void) \
913 SymE_NeedsDataProto(ffi_type_float) \
914 SymE_NeedsDataProto(ffi_type_double) \
915 SymE_NeedsDataProto(ffi_type_sint64) \
916 SymE_NeedsDataProto(ffi_type_uint64) \
917 SymE_NeedsDataProto(ffi_type_sint32) \
918 SymE_NeedsDataProto(ffi_type_uint32) \
919 SymE_NeedsDataProto(ffi_type_sint16) \
920 SymE_NeedsDataProto(ffi_type_uint16) \
921 SymE_NeedsDataProto(ffi_type_sint8) \
922 SymE_NeedsDataProto(ffi_type_uint8) \
923 SymE_NeedsDataProto(ffi_type_pointer)
924
925 #ifdef TABLES_NEXT_TO_CODE
926 #define RTS_RET_SYMBOLS /* nothing */
927 #else
928 #define RTS_RET_SYMBOLS \
929 SymI_HasProto(stg_enter_ret) \
930 SymI_HasProto(stg_gc_fun_ret) \
931 SymI_HasProto(stg_ap_v_ret) \
932 SymI_HasProto(stg_ap_f_ret) \
933 SymI_HasProto(stg_ap_d_ret) \
934 SymI_HasProto(stg_ap_l_ret) \
935 SymI_HasProto(stg_ap_v16_ret) \
936 SymI_HasProto(stg_ap_v32_ret) \
937 SymI_HasProto(stg_ap_v64_ret) \
938 SymI_HasProto(stg_ap_n_ret) \
939 SymI_HasProto(stg_ap_p_ret) \
940 SymI_HasProto(stg_ap_pv_ret) \
941 SymI_HasProto(stg_ap_pp_ret) \
942 SymI_HasProto(stg_ap_ppv_ret) \
943 SymI_HasProto(stg_ap_ppp_ret) \
944 SymI_HasProto(stg_ap_pppv_ret) \
945 SymI_HasProto(stg_ap_pppp_ret) \
946 SymI_HasProto(stg_ap_ppppp_ret) \
947 SymI_HasProto(stg_ap_pppppp_ret)
948 #endif
949
950 /* Modules compiled with -ticky may mention ticky counters */
951 /* This list should marry up with the one in $(TOP)/includes/stg/Ticky.h */
952 #define RTS_TICKY_SYMBOLS \
953 SymI_NeedsDataProto(ticky_entry_ctrs) \
954 SymI_NeedsDataProto(top_ct) \
955 \
956 SymI_HasProto(ENT_VIA_NODE_ctr) \
957 SymI_HasProto(ENT_STATIC_THK_SINGLE_ctr) \
958 SymI_HasProto(ENT_STATIC_THK_MANY_ctr) \
959 SymI_HasProto(ENT_DYN_THK_SINGLE_ctr) \
960 SymI_HasProto(ENT_DYN_THK_MANY_ctr) \
961 SymI_HasProto(ENT_STATIC_FUN_DIRECT_ctr) \
962 SymI_HasProto(ENT_DYN_FUN_DIRECT_ctr) \
963 SymI_HasProto(ENT_STATIC_CON_ctr) \
964 SymI_HasProto(ENT_DYN_CON_ctr) \
965 SymI_HasProto(ENT_STATIC_IND_ctr) \
966 SymI_HasProto(ENT_DYN_IND_ctr) \
967 SymI_HasProto(ENT_PERM_IND_ctr) \
968 SymI_HasProto(ENT_PAP_ctr) \
969 SymI_HasProto(ENT_AP_ctr) \
970 SymI_HasProto(ENT_AP_STACK_ctr) \
971 SymI_HasProto(ENT_BH_ctr) \
972 SymI_HasProto(ENT_LNE_ctr) \
973 SymI_HasProto(UNKNOWN_CALL_ctr) \
974 SymI_HasProto(SLOW_CALL_fast_v16_ctr) \
975 SymI_HasProto(SLOW_CALL_fast_v_ctr) \
976 SymI_HasProto(SLOW_CALL_fast_f_ctr) \
977 SymI_HasProto(SLOW_CALL_fast_d_ctr) \
978 SymI_HasProto(SLOW_CALL_fast_l_ctr) \
979 SymI_HasProto(SLOW_CALL_fast_n_ctr) \
980 SymI_HasProto(SLOW_CALL_fast_p_ctr) \
981 SymI_HasProto(SLOW_CALL_fast_pv_ctr) \
982 SymI_HasProto(SLOW_CALL_fast_pp_ctr) \
983 SymI_HasProto(SLOW_CALL_fast_ppv_ctr) \
984 SymI_HasProto(SLOW_CALL_fast_ppp_ctr) \
985 SymI_HasProto(SLOW_CALL_fast_pppv_ctr) \
986 SymI_HasProto(SLOW_CALL_fast_pppp_ctr) \
987 SymI_HasProto(SLOW_CALL_fast_ppppp_ctr) \
988 SymI_HasProto(SLOW_CALL_fast_pppppp_ctr) \
989 SymI_HasProto(VERY_SLOW_CALL_ctr) \
990 SymI_HasProto(ticky_slow_call_unevald) \
991 SymI_HasProto(SLOW_CALL_ctr) \
992 SymI_HasProto(MULTI_CHUNK_SLOW_CALL_ctr) \
993 SymI_HasProto(MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr) \
994 SymI_HasProto(KNOWN_CALL_ctr) \
995 SymI_HasProto(KNOWN_CALL_TOO_FEW_ARGS_ctr) \
996 SymI_HasProto(KNOWN_CALL_EXTRA_ARGS_ctr) \
997 SymI_HasProto(SLOW_CALL_FUN_TOO_FEW_ctr) \
998 SymI_HasProto(SLOW_CALL_FUN_CORRECT_ctr) \
999 SymI_HasProto(SLOW_CALL_FUN_TOO_MANY_ctr) \
1000 SymI_HasProto(SLOW_CALL_PAP_TOO_FEW_ctr) \
1001 SymI_HasProto(SLOW_CALL_PAP_CORRECT_ctr) \
1002 SymI_HasProto(SLOW_CALL_PAP_TOO_MANY_ctr) \
1003 SymI_HasProto(SLOW_CALL_UNEVALD_ctr) \
1004 SymI_HasProto(UPDF_OMITTED_ctr) \
1005 SymI_HasProto(UPDF_PUSHED_ctr) \
1006 SymI_HasProto(CATCHF_PUSHED_ctr) \
1007 SymI_HasProto(UPDF_RCC_PUSHED_ctr) \
1008 SymI_HasProto(UPDF_RCC_OMITTED_ctr) \
1009 SymI_HasProto(UPD_SQUEEZED_ctr) \
1010 SymI_HasProto(UPD_CON_IN_NEW_ctr) \
1011 SymI_HasProto(UPD_CON_IN_PLACE_ctr) \
1012 SymI_HasProto(UPD_PAP_IN_NEW_ctr) \
1013 SymI_HasProto(UPD_PAP_IN_PLACE_ctr) \
1014 SymI_HasProto(ALLOC_HEAP_ctr) \
1015 SymI_HasProto(ALLOC_HEAP_tot) \
1016 SymI_HasProto(HEAP_CHK_ctr) \
1017 SymI_HasProto(STK_CHK_ctr) \
1018 SymI_HasProto(ALLOC_RTS_ctr) \
1019 SymI_HasProto(ALLOC_RTS_tot) \
1020 SymI_HasProto(ALLOC_FUN_ctr) \
1021 SymI_HasProto(ALLOC_FUN_adm) \
1022 SymI_HasProto(ALLOC_FUN_gds) \
1023 SymI_HasProto(ALLOC_FUN_slp) \
1024 SymI_HasProto(UPD_NEW_IND_ctr) \
1025 SymI_HasProto(UPD_NEW_PERM_IND_ctr) \
1026 SymI_HasProto(UPD_OLD_IND_ctr) \
1027 SymI_HasProto(UPD_OLD_PERM_IND_ctr) \
1028 SymI_HasProto(UPD_CAF_BH_UPDATABLE_ctr) \
1029 SymI_HasProto(UPD_CAF_BH_SINGLE_ENTRY_ctr) \
1030 SymI_HasProto(GC_SEL_ABANDONED_ctr) \
1031 SymI_HasProto(GC_SEL_MINOR_ctr) \
1032 SymI_HasProto(GC_SEL_MAJOR_ctr) \
1033 SymI_HasProto(GC_FAILED_PROMOTION_ctr) \
1034 SymI_HasProto(ALLOC_UP_THK_ctr) \
1035 SymI_HasProto(ALLOC_SE_THK_ctr) \
1036 SymI_HasProto(ALLOC_THK_adm) \
1037 SymI_HasProto(ALLOC_THK_gds) \
1038 SymI_HasProto(ALLOC_THK_slp) \
1039 SymI_HasProto(ALLOC_CON_ctr) \
1040 SymI_HasProto(ALLOC_CON_adm) \
1041 SymI_HasProto(ALLOC_CON_gds) \
1042 SymI_HasProto(ALLOC_CON_slp) \
1043 SymI_HasProto(ALLOC_TUP_ctr) \
1044 SymI_HasProto(ALLOC_TUP_adm) \
1045 SymI_HasProto(ALLOC_TUP_gds) \
1046 SymI_HasProto(ALLOC_TUP_slp) \
1047 SymI_HasProto(ALLOC_BH_ctr) \
1048 SymI_HasProto(ALLOC_BH_adm) \
1049 SymI_HasProto(ALLOC_BH_gds) \
1050 SymI_HasProto(ALLOC_BH_slp) \
1051 SymI_HasProto(ALLOC_PRIM_ctr) \
1052 SymI_HasProto(ALLOC_PRIM_adm) \
1053 SymI_HasProto(ALLOC_PRIM_gds) \
1054 SymI_HasProto(ALLOC_PRIM_slp) \
1055 SymI_HasProto(ALLOC_PAP_ctr) \
1056 SymI_HasProto(ALLOC_PAP_adm) \
1057 SymI_HasProto(ALLOC_PAP_gds) \
1058 SymI_HasProto(ALLOC_PAP_slp) \
1059 SymI_HasProto(ALLOC_TSO_ctr) \
1060 SymI_HasProto(ALLOC_TSO_adm) \
1061 SymI_HasProto(ALLOC_TSO_gds) \
1062 SymI_HasProto(ALLOC_TSO_slp) \
1063 SymI_HasProto(RET_NEW_ctr) \
1064 SymI_HasProto(RET_OLD_ctr) \
1065 SymI_HasProto(RET_UNBOXED_TUP_ctr) \
1066 SymI_HasProto(RET_SEMI_loads_avoided)
1067
1068
1069 // On most platforms, the garbage collector rewrites references
1070 // to small integer and char objects to a set of common, shared ones.
1071 //
1072 // We don't do this when compiling to Windows DLLs at the moment because
1073 // it doesn't support cross package data references well.
1074 //
1075 #if defined(COMPILING_WINDOWS_DLL)
1076 #define RTS_INTCHAR_SYMBOLS
1077 #else
1078 #define RTS_INTCHAR_SYMBOLS \
1079 SymI_HasProto(stg_CHARLIKE_closure) \
1080 SymI_HasProto(stg_INTLIKE_closure)
1081 #endif
1082
1083
1084 #define RTS_SYMBOLS \
1085 Maybe_Stable_Names \
1086 RTS_TICKY_SYMBOLS \
1087 SymI_HasProto(StgReturn) \
1088 SymI_HasProto(stg_gc_noregs) \
1089 SymI_HasProto(stg_ret_v_info) \
1090 SymI_HasProto(stg_ret_p_info) \
1091 SymI_HasProto(stg_ret_n_info) \
1092 SymI_HasProto(stg_ret_f_info) \
1093 SymI_HasProto(stg_ret_d_info) \
1094 SymI_HasProto(stg_ret_l_info) \
1095 SymI_HasProto(stg_gc_prim_p) \
1096 SymI_HasProto(stg_gc_prim_pp) \
1097 SymI_HasProto(stg_gc_prim_n) \
1098 SymI_HasProto(stg_enter_info) \
1099 SymI_HasProto(__stg_gc_enter_1) \
1100 SymI_HasProto(stg_gc_unpt_r1) \
1101 SymI_HasProto(stg_gc_unbx_r1) \
1102 SymI_HasProto(stg_gc_f1) \
1103 SymI_HasProto(stg_gc_d1) \
1104 SymI_HasProto(stg_gc_l1) \
1105 SymI_HasProto(stg_gc_pp) \
1106 SymI_HasProto(stg_gc_ppp) \
1107 SymI_HasProto(stg_gc_pppp) \
1108 SymI_HasProto(__stg_gc_fun) \
1109 SymI_HasProto(stg_gc_fun_info) \
1110 SymI_HasProto(stg_yield_noregs) \
1111 SymI_HasProto(stg_yield_to_interpreter) \
1112 SymI_HasProto(stg_block_noregs) \
1113 SymI_HasProto(stg_block_takemvar) \
1114 SymI_HasProto(stg_block_readmvar) \
1115 SymI_HasProto(stg_block_putmvar) \
1116 MAIN_CAP_SYM \
1117 SymI_HasProto(addDLL) \
1118 SymI_HasProto(__int_encodeDouble) \
1119 SymI_HasProto(__word_encodeDouble) \
1120 SymI_HasProto(__int_encodeFloat) \
1121 SymI_HasProto(__word_encodeFloat) \
1122 SymI_HasProto(stg_atomicallyzh) \
1123 SymI_HasProto(barf) \
1124 SymI_HasProto(deRefStablePtr) \
1125 SymI_HasProto(debugBelch) \
1126 SymI_HasProto(errorBelch) \
1127 SymI_HasProto(sysErrorBelch) \
1128 SymI_HasProto(stg_getMaskingStatezh) \
1129 SymI_HasProto(stg_maskAsyncExceptionszh) \
1130 SymI_HasProto(stg_maskUninterruptiblezh) \
1131 SymI_HasProto(stg_catchzh) \
1132 SymI_HasProto(stg_catchRetryzh) \
1133 SymI_HasProto(stg_catchSTMzh) \
1134 SymI_HasProto(stg_checkzh) \
1135 SymI_HasProto(closure_flags) \
1136 SymI_HasProto(cmp_thread) \
1137 SymI_HasProto(createAdjustor) \
1138 SymI_HasProto(stg_decodeDoublezu2Intzh) \
1139 SymI_HasProto(stg_decodeDoublezuInt64zh) \
1140 SymI_HasProto(stg_decodeFloatzuIntzh) \
1141 SymI_HasProto(stg_delayzh) \
1142 SymI_HasProto(stg_deRefWeakzh) \
1143 SymI_HasProto(stg_deRefStablePtrzh) \
1144 SymI_HasProto(dirty_MUT_VAR) \
1145 SymI_HasProto(dirty_TVAR) \
1146 SymI_HasProto(stg_forkzh) \
1147 SymI_HasProto(stg_forkOnzh) \
1148 SymI_HasProto(forkProcess) \
1149 SymI_HasProto(forkOS_createThread) \
1150 SymI_HasProto(freeHaskellFunctionPtr) \
1151 SymI_HasProto(getOrSetGHCConcSignalSignalHandlerStore) \
1152 SymI_HasProto(getOrSetGHCConcWindowsPendingDelaysStore) \
1153 SymI_HasProto(getOrSetGHCConcWindowsIOManagerThreadStore) \
1154 SymI_HasProto(getOrSetGHCConcWindowsProddingStore) \
1155 SymI_HasProto(getOrSetSystemEventThreadEventManagerStore) \
1156 SymI_HasProto(getOrSetSystemEventThreadIOManagerThreadStore) \
1157 SymI_HasProto(getOrSetSystemTimerThreadEventManagerStore) \
1158 SymI_HasProto(getOrSetSystemTimerThreadIOManagerThreadStore) \
1159 SymI_HasProto(getOrSetLibHSghcFastStringTable) \
1160 SymI_HasProto(getGCStats) \
1161 SymI_HasProto(getGCStatsEnabled) \
1162 SymI_HasProto(genericRaise) \
1163 SymI_HasProto(getProgArgv) \
1164 SymI_HasProto(getFullProgArgv) \
1165 SymI_HasProto(getStablePtr) \
1166 SymI_HasProto(foreignExportStablePtr) \
1167 SymI_HasProto(hs_init) \
1168 SymI_HasProto(hs_exit) \
1169 SymI_HasProto(hs_set_argv) \
1170 SymI_HasProto(hs_add_root) \
1171 SymI_HasProto(hs_perform_gc) \
1172 SymI_HasProto(hs_lock_stable_tables) \
1173 SymI_HasProto(hs_unlock_stable_tables) \
1174 SymI_HasProto(hs_free_stable_ptr) \
1175 SymI_HasProto(hs_free_stable_ptr_unsafe) \
1176 SymI_HasProto(hs_free_fun_ptr) \
1177 SymI_HasProto(hs_hpc_rootModule) \
1178 SymI_HasProto(hs_hpc_module) \
1179 SymI_HasProto(initLinker) \
1180 SymI_HasProto(initLinker_) \
1181 SymI_HasProto(stg_unpackClosurezh) \
1182 SymI_HasProto(stg_getApStackValzh) \
1183 SymI_HasProto(stg_getSparkzh) \
1184 SymI_HasProto(stg_numSparkszh) \
1185 SymI_HasProto(stg_isCurrentThreadBoundzh) \
1186 SymI_HasProto(stg_isEmptyMVarzh) \
1187 SymI_HasProto(stg_killThreadzh) \
1188 SymI_HasProto(loadArchive) \
1189 SymI_HasProto(loadObj) \
1190 SymI_HasProto(insertSymbol) \
1191 SymI_HasProto(lookupSymbol) \
1192 SymI_HasProto(stg_makeStablePtrzh) \
1193 SymI_HasProto(stg_mkApUpd0zh) \
1194 SymI_HasProto(stg_myThreadIdzh) \
1195 SymI_HasProto(stg_labelThreadzh) \
1196 SymI_HasProto(stg_newArrayzh) \
1197 SymI_HasProto(stg_copyArrayzh) \
1198 SymI_HasProto(stg_copyMutableArrayzh) \
1199 SymI_HasProto(stg_copyArrayArrayzh) \
1200 SymI_HasProto(stg_copyMutableArrayArrayzh) \
1201 SymI_HasProto(stg_cloneArrayzh) \
1202 SymI_HasProto(stg_cloneMutableArrayzh) \
1203 SymI_HasProto(stg_freezzeArrayzh) \
1204 SymI_HasProto(stg_thawArrayzh) \
1205 SymI_HasProto(stg_newArrayArrayzh) \
1206 SymI_HasProto(stg_casArrayzh) \
1207 SymI_HasProto(stg_newSmallArrayzh) \
1208 SymI_HasProto(stg_unsafeThawSmallArrayzh) \
1209 SymI_HasProto(stg_cloneSmallArrayzh) \
1210 SymI_HasProto(stg_cloneSmallMutableArrayzh) \
1211 SymI_HasProto(stg_freezzeSmallArrayzh) \
1212 SymI_HasProto(stg_thawSmallArrayzh) \
1213 SymI_HasProto(stg_copySmallArrayzh) \
1214 SymI_HasProto(stg_copySmallMutableArrayzh) \
1215 SymI_HasProto(stg_casSmallArrayzh) \
1216 SymI_HasProto(stg_newBCOzh) \
1217 SymI_HasProto(stg_newByteArrayzh) \
1218 SymI_HasProto(stg_casIntArrayzh) \
1219 SymI_HasProto(stg_newMVarzh) \
1220 SymI_HasProto(stg_newMutVarzh) \
1221 SymI_HasProto(stg_newTVarzh) \
1222 SymI_HasProto(stg_noDuplicatezh) \
1223 SymI_HasProto(stg_atomicModifyMutVarzh) \
1224 SymI_HasProto(stg_casMutVarzh) \
1225 SymI_HasProto(stg_newPinnedByteArrayzh) \
1226 SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \
1227 SymI_HasProto(stg_shrinkMutableByteArrayzh) \
1228 SymI_HasProto(stg_resizzeMutableByteArrayzh) \
1229 SymI_HasProto(newSpark) \
1230 SymI_HasProto(performGC) \
1231 SymI_HasProto(performMajorGC) \
1232 SymI_HasProto(prog_argc) \
1233 SymI_HasProto(prog_argv) \
1234 SymI_HasProto(stg_putMVarzh) \
1235 SymI_HasProto(stg_raisezh) \
1236 SymI_HasProto(stg_raiseIOzh) \
1237 SymI_HasProto(stg_readTVarzh) \
1238 SymI_HasProto(stg_readTVarIOzh) \
1239 SymI_HasProto(resumeThread) \
1240 SymI_HasProto(setNumCapabilities) \
1241 SymI_HasProto(getNumberOfProcessors) \
1242 SymI_HasProto(resolveObjs) \
1243 SymI_HasProto(stg_retryzh) \
1244 SymI_HasProto(rts_apply) \
1245 SymI_HasProto(rts_checkSchedStatus) \
1246 SymI_HasProto(rts_eval) \
1247 SymI_HasProto(rts_evalIO) \
1248 SymI_HasProto(rts_evalLazyIO) \
1249 SymI_HasProto(rts_evalStableIO) \
1250 SymI_HasProto(rts_eval_) \
1251 SymI_HasProto(rts_getBool) \
1252 SymI_HasProto(rts_getChar) \
1253 SymI_HasProto(rts_getDouble) \
1254 SymI_HasProto(rts_getFloat) \
1255 SymI_HasProto(rts_getInt) \
1256 SymI_HasProto(rts_getInt8) \
1257 SymI_HasProto(rts_getInt16) \
1258 SymI_HasProto(rts_getInt32) \
1259 SymI_HasProto(rts_getInt64) \
1260 SymI_HasProto(rts_getPtr) \
1261 SymI_HasProto(rts_getFunPtr) \
1262 SymI_HasProto(rts_getStablePtr) \
1263 SymI_HasProto(rts_getThreadId) \
1264 SymI_HasProto(rts_getWord) \
1265 SymI_HasProto(rts_getWord8) \
1266 SymI_HasProto(rts_getWord16) \
1267 SymI_HasProto(rts_getWord32) \
1268 SymI_HasProto(rts_getWord64) \
1269 SymI_HasProto(rts_lock) \
1270 SymI_HasProto(rts_mkBool) \
1271 SymI_HasProto(rts_mkChar) \
1272 SymI_HasProto(rts_mkDouble) \
1273 SymI_HasProto(rts_mkFloat) \
1274 SymI_HasProto(rts_mkInt) \
1275 SymI_HasProto(rts_mkInt8) \
1276 SymI_HasProto(rts_mkInt16) \
1277 SymI_HasProto(rts_mkInt32) \
1278 SymI_HasProto(rts_mkInt64) \
1279 SymI_HasProto(rts_mkPtr) \
1280 SymI_HasProto(rts_mkFunPtr) \
1281 SymI_HasProto(rts_mkStablePtr) \
1282 SymI_HasProto(rts_mkString) \
1283 SymI_HasProto(rts_mkWord) \
1284 SymI_HasProto(rts_mkWord8) \
1285 SymI_HasProto(rts_mkWord16) \
1286 SymI_HasProto(rts_mkWord32) \
1287 SymI_HasProto(rts_mkWord64) \
1288 SymI_HasProto(rts_unlock) \
1289 SymI_HasProto(rts_unsafeGetMyCapability) \
1290 SymI_HasProto(rtsSupportsBoundThreads) \
1291 SymI_HasProto(rts_isProfiled) \
1292 SymI_HasProto(rts_isDynamic) \
1293 SymI_HasProto(rts_getThreadAllocationCounter) \
1294 SymI_HasProto(rts_setThreadAllocationCounter) \
1295 SymI_HasProto(rts_enableThreadAllocationLimit) \
1296 SymI_HasProto(rts_disableThreadAllocationLimit) \
1297 SymI_HasProto(setProgArgv) \
1298 SymI_HasProto(startupHaskell) \
1299 SymI_HasProto(shutdownHaskell) \
1300 SymI_HasProto(shutdownHaskellAndExit) \
1301 SymI_HasProto(stable_name_table) \
1302 SymI_HasProto(stable_ptr_table) \
1303 SymI_HasProto(stackOverflow) \
1304 SymI_HasProto(stg_CAF_BLACKHOLE_info) \
1305 SymI_HasProto(stg_BLACKHOLE_info) \
1306 SymI_HasProto(__stg_EAGER_BLACKHOLE_info) \
1307 SymI_HasProto(stg_BLOCKING_QUEUE_CLEAN_info) \
1308 SymI_HasProto(stg_BLOCKING_QUEUE_DIRTY_info) \
1309 SymI_HasProto(startTimer) \
1310 SymI_HasProto(stg_MVAR_CLEAN_info) \
1311 SymI_HasProto(stg_MVAR_DIRTY_info) \
1312 SymI_HasProto(stg_TVAR_CLEAN_info) \
1313 SymI_HasProto(stg_TVAR_DIRTY_info) \
1314 SymI_HasProto(stg_IND_STATIC_info) \
1315 SymI_HasProto(stg_ARR_WORDS_info) \
1316 SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info) \
1317 SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info) \
1318 SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN0_info) \
1319 SymI_HasProto(stg_SMALL_MUT_ARR_PTRS_DIRTY_info) \
1320 SymI_HasProto(stg_SMALL_MUT_ARR_PTRS_FROZEN_info) \
1321 SymI_HasProto(stg_SMALL_MUT_ARR_PTRS_FROZEN0_info) \
1322 SymI_HasProto(stg_MUT_VAR_CLEAN_info) \
1323 SymI_HasProto(stg_MUT_VAR_DIRTY_info) \
1324 SymI_HasProto(stg_WEAK_info) \
1325 SymI_HasProto(stg_ap_v_info) \
1326 SymI_HasProto(stg_ap_f_info) \
1327 SymI_HasProto(stg_ap_d_info) \
1328 SymI_HasProto(stg_ap_l_info) \
1329 SymI_HasProto(stg_ap_v16_info) \
1330 SymI_HasProto(stg_ap_v32_info) \
1331 SymI_HasProto(stg_ap_v64_info) \
1332 SymI_HasProto(stg_ap_n_info) \
1333 SymI_HasProto(stg_ap_p_info) \
1334 SymI_HasProto(stg_ap_pv_info) \
1335 SymI_HasProto(stg_ap_pp_info) \
1336 SymI_HasProto(stg_ap_ppv_info) \
1337 SymI_HasProto(stg_ap_ppp_info) \
1338 SymI_HasProto(stg_ap_pppv_info) \
1339 SymI_HasProto(stg_ap_pppp_info) \
1340 SymI_HasProto(stg_ap_ppppp_info) \
1341 SymI_HasProto(stg_ap_pppppp_info) \
1342 SymI_HasProto(stg_ap_0_fast) \
1343 SymI_HasProto(stg_ap_v_fast) \
1344 SymI_HasProto(stg_ap_f_fast) \
1345 SymI_HasProto(stg_ap_d_fast) \
1346 SymI_HasProto(stg_ap_l_fast) \
1347 SymI_HasProto(stg_ap_v16_fast) \
1348 SymI_HasProto(stg_ap_v32_fast) \
1349 SymI_HasProto(stg_ap_v64_fast) \
1350 SymI_HasProto(stg_ap_n_fast) \
1351 SymI_HasProto(stg_ap_p_fast) \
1352 SymI_HasProto(stg_ap_pv_fast) \
1353 SymI_HasProto(stg_ap_pp_fast) \
1354 SymI_HasProto(stg_ap_ppv_fast) \
1355 SymI_HasProto(stg_ap_ppp_fast) \
1356 SymI_HasProto(stg_ap_pppv_fast) \
1357 SymI_HasProto(stg_ap_pppp_fast) \
1358 SymI_HasProto(stg_ap_ppppp_fast) \
1359 SymI_HasProto(stg_ap_pppppp_fast) \
1360 SymI_HasProto(stg_ap_1_upd_info) \
1361 SymI_HasProto(stg_ap_2_upd_info) \
1362 SymI_HasProto(stg_ap_3_upd_info) \
1363 SymI_HasProto(stg_ap_4_upd_info) \
1364 SymI_HasProto(stg_ap_5_upd_info) \
1365 SymI_HasProto(stg_ap_6_upd_info) \
1366 SymI_HasProto(stg_ap_7_upd_info) \
1367 SymI_HasProto(stg_exit) \
1368 SymI_HasProto(stg_sel_0_upd_info) \
1369 SymI_HasProto(stg_sel_1_upd_info) \
1370 SymI_HasProto(stg_sel_2_upd_info) \
1371 SymI_HasProto(stg_sel_3_upd_info) \
1372 SymI_HasProto(stg_sel_4_upd_info) \
1373 SymI_HasProto(stg_sel_5_upd_info) \
1374 SymI_HasProto(stg_sel_6_upd_info) \
1375 SymI_HasProto(stg_sel_7_upd_info) \
1376 SymI_HasProto(stg_sel_8_upd_info) \
1377 SymI_HasProto(stg_sel_9_upd_info) \
1378 SymI_HasProto(stg_sel_10_upd_info) \
1379 SymI_HasProto(stg_sel_11_upd_info) \
1380 SymI_HasProto(stg_sel_12_upd_info) \
1381 SymI_HasProto(stg_sel_13_upd_info) \
1382 SymI_HasProto(stg_sel_14_upd_info) \
1383 SymI_HasProto(stg_sel_15_upd_info) \
1384 SymI_HasProto(stg_sel_0_noupd_info) \
1385 SymI_HasProto(stg_sel_1_noupd_info) \
1386 SymI_HasProto(stg_sel_2_noupd_info) \
1387 SymI_HasProto(stg_sel_3_noupd_info) \
1388 SymI_HasProto(stg_sel_4_noupd_info) \
1389 SymI_HasProto(stg_sel_5_noupd_info) \
1390 SymI_HasProto(stg_sel_6_noupd_info) \
1391 SymI_HasProto(stg_sel_7_noupd_info) \
1392 SymI_HasProto(stg_sel_8_noupd_info) \
1393 SymI_HasProto(stg_sel_9_noupd_info) \
1394 SymI_HasProto(stg_sel_10_noupd_info) \
1395 SymI_HasProto(stg_sel_11_noupd_info) \
1396 SymI_HasProto(stg_sel_12_noupd_info) \
1397 SymI_HasProto(stg_sel_13_noupd_info) \
1398 SymI_HasProto(stg_sel_14_noupd_info) \
1399 SymI_HasProto(stg_sel_15_noupd_info) \
1400 SymI_HasProto(stg_upd_frame_info) \
1401 SymI_HasProto(stg_bh_upd_frame_info) \
1402 SymI_HasProto(suspendThread) \
1403 SymI_HasProto(stg_takeMVarzh) \
1404 SymI_HasProto(stg_readMVarzh) \
1405 SymI_HasProto(stg_threadStatuszh) \
1406 SymI_HasProto(stg_tryPutMVarzh) \
1407 SymI_HasProto(stg_tryTakeMVarzh) \
1408 SymI_HasProto(stg_tryReadMVarzh) \
1409 SymI_HasProto(stg_unmaskAsyncExceptionszh) \
1410 SymI_HasProto(unloadObj) \
1411 SymI_HasProto(stg_unsafeThawArrayzh) \
1412 SymI_HasProto(stg_waitReadzh) \
1413 SymI_HasProto(stg_waitWritezh) \
1414 SymI_HasProto(stg_writeTVarzh) \
1415 SymI_HasProto(stg_yieldzh) \
1416 SymI_NeedsProto(stg_interp_constr_entry) \
1417 SymI_HasProto(stg_arg_bitmaps) \
1418 SymI_HasProto(large_alloc_lim) \
1419 SymI_HasProto(g0) \
1420 SymI_HasProto(allocate) \
1421 SymI_HasProto(allocateExec) \
1422 SymI_HasProto(flushExec) \
1423 SymI_HasProto(freeExec) \
1424 SymI_HasProto(getAllocations) \
1425 SymI_HasProto(revertCAFs) \
1426 SymI_HasProto(RtsFlags) \
1427 SymI_NeedsDataProto(rts_breakpoint_io_action) \
1428 SymI_NeedsDataProto(rts_stop_next_breakpoint) \
1429 SymI_NeedsDataProto(rts_stop_on_exception) \
1430 SymI_HasProto(stopTimer) \
1431 SymI_HasProto(n_capabilities) \
1432 SymI_HasProto(enabled_capabilities) \
1433 SymI_HasProto(stg_traceCcszh) \
1434 SymI_HasProto(stg_traceEventzh) \
1435 SymI_HasProto(stg_traceMarkerzh) \
1436 SymI_HasProto(getMonotonicNSec) \
1437 SymI_HasProto(lockFile) \
1438 SymI_HasProto(unlockFile) \
1439 SymI_HasProto(startProfTimer) \
1440 SymI_HasProto(stopProfTimer) \
1441 SymI_HasProto(atomic_inc) \
1442 SymI_HasProto(atomic_dec) \
1443 SymI_HasProto(hs_spt_lookup) \
1444 SymI_HasProto(hs_spt_insert) \
1445 SymI_HasProto(hs_spt_remove) \
1446 SymI_HasProto(hs_spt_keys) \
1447 SymI_HasProto(hs_spt_key_count) \
1448 RTS_USER_SIGNALS_SYMBOLS \
1449 RTS_INTCHAR_SYMBOLS
1450
1451
1452 // 64-bit support functions in libgcc.a
1453 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4 && !defined(_ABIN32)
1454 #define RTS_LIBGCC_SYMBOLS \
1455 SymI_NeedsProto(__divdi3) \
1456 SymI_NeedsProto(__udivdi3) \
1457 SymI_NeedsProto(__moddi3) \
1458 SymI_NeedsProto(__umoddi3) \
1459 SymI_NeedsProto(__muldi3) \
1460 SymI_NeedsProto(__ashldi3) \
1461 SymI_NeedsProto(__ashrdi3) \
1462 SymI_NeedsProto(__lshrdi3) \
1463 SymI_NeedsProto(__fixunsdfdi)
1464 #else
1465 #define RTS_LIBGCC_SYMBOLS
1466 #endif
1467
1468 #if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
1469 // Symbols that don't have a leading underscore
1470 // on Mac OS X. They have to receive special treatment,
1471 // see machoInitSymbolsWithoutUnderscore()
1472 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
1473 SymI_NeedsProto(saveFP) \
1474 SymI_NeedsProto(restFP)
1475 #endif
1476
1477 /* entirely bogus claims about types of these symbols */
1478 #define SymI_NeedsProto(vvv) extern void vvv(void);
1479 #define SymI_NeedsDataProto(vvv) extern StgWord vvv[];
1480 #if defined(COMPILING_WINDOWS_DLL)
1481 #define SymE_HasProto(vvv) SymE_HasProto(vvv);
1482 # if defined(x86_64_HOST_ARCH)
1483 # define SymE_NeedsProto(vvv) extern void __imp_ ## vvv (void);
1484 # define SymE_NeedsDataProto(vvv) SymE_NeedsProto(vvv)
1485 # else
1486 # define SymE_NeedsProto(vvv) extern void _imp__ ## vvv (void);
1487 # define SymE_NeedsDataProto(vvv) SymE_NeedsProto(vvv)
1488 # endif
1489 #else
1490 #define SymE_NeedsProto(vvv) SymI_NeedsProto(vvv);
1491 #define SymE_NeedsDataProto(vvv) SymI_NeedsDataProto(vvv);
1492 #define SymE_HasProto(vvv) SymI_HasProto(vvv)
1493 #endif
1494 #define SymI_HasProto(vvv) /**/
1495 #define SymI_HasProto_redirect(vvv,xxx) /**/
1496 RTS_SYMBOLS
1497 RTS_RET_SYMBOLS
1498 RTS_POSIX_ONLY_SYMBOLS
1499 RTS_MINGW_ONLY_SYMBOLS
1500 RTS_CYGWIN_ONLY_SYMBOLS
1501 RTS_DARWIN_ONLY_SYMBOLS
1502 RTS_LIBGCC_SYMBOLS
1503 RTS_LIBFFI_SYMBOLS
1504 #undef SymI_NeedsProto
1505 #undef SymI_NeedsDataProto
1506 #undef SymI_HasProto
1507 #undef SymI_HasProto_redirect
1508 #undef SymE_HasProto
1509 #undef SymE_HasDataProto
1510 #undef SymE_NeedsProto
1511 #undef SymE_NeedsDataProto
1512
1513 #ifdef LEADING_UNDERSCORE
1514 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
1515 #else
1516 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
1517 #endif
1518
1519 #define SymI_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1520 (void*)(&(vvv)) },
1521 #define SymI_HasDataProto(vvv) \
1522 SymI_HasProto(vvv)
1523 #define SymE_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1524 (void*)DLL_IMPORT_DATA_REF(vvv) },
1525 #define SymE_HasDataProto(vvv) \
1526 SymE_HasProto(vvv)
1527
1528 #define SymI_NeedsProto(vvv) SymI_HasProto(vvv)
1529 #define SymI_NeedsDataProto(vvv) SymI_HasDataProto(vvv)
1530 #define SymE_NeedsProto(vvv) SymE_HasProto(vvv)
1531 #define SymE_NeedsDataProto(vvv) SymE_HasDataProto(vvv)
1532
1533 // SymI_HasProto_redirect allows us to redirect references to one symbol to
1534 // another symbol. See newCAF/newRetainedCAF/newGCdCAF for an example.
1535 #define SymI_HasProto_redirect(vvv,xxx) \
1536 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1537 (void*)(&(xxx)) },
1538
1539 static RtsSymbolVal rtsSyms[] = {
1540 RTS_SYMBOLS
1541 RTS_RET_SYMBOLS
1542 RTS_POSIX_ONLY_SYMBOLS
1543 RTS_MINGW_ONLY_SYMBOLS
1544 RTS_CYGWIN_ONLY_SYMBOLS
1545 RTS_DARWIN_ONLY_SYMBOLS
1546 RTS_LIBGCC_SYMBOLS
1547 RTS_LIBFFI_SYMBOLS
1548 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
1549 // dyld stub code contains references to this,
1550 // but it should never be called because we treat
1551 // lazy pointers as nonlazy.
1552 { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
1553 #endif
1554 { 0, 0 } /* sentinel */
1555 };
1556
1557
1558 /* -----------------------------------------------------------------------------
1559 * Insert symbols into hash tables, checking for duplicates.
1560 *
1561 * Returns: 0 on failure, nonzero on success
1562 */
1563
1564 static int ghciInsertSymbolTable(
1565 pathchar* obj_name,
1566 HashTable *table,
1567 char* key,
1568 void *data,
1569 HsBool weak,
1570 ObjectCode *owner)
1571 {
1572 RtsSymbolInfo *pinfo = lookupStrHashTable(table, key);
1573 if (!pinfo) /* new entry */
1574 {
1575 pinfo = stgMallocBytes(sizeof (*pinfo), "ghciInsertToSymbolTable");
1576 pinfo->value = data;
1577 pinfo->owner = owner;
1578 pinfo->weak = weak;
1579 insertStrHashTable(table, key, pinfo);
1580 return 1;
1581 }
1582 else if ((!pinfo->weak || pinfo->value) && weak)
1583 {
1584 return 1; /* duplicate weak symbol, throw it away */
1585 }
1586 else if (pinfo->weak) /* weak symbol is in the table */
1587 {
1588 /* override the weak definition with the non-weak one */
1589 pinfo->value = data;
1590 pinfo->owner = owner;
1591 pinfo->weak = HS_BOOL_FALSE;
1592 return 1;
1593 }
1594 debugBelch(
1595 "GHC runtime linker: fatal error: I found a duplicate definition for symbol\n"
1596 " %s\n"
1597 "whilst processing object file\n"
1598 " %" PATH_FMT "\n"
1599 "This could be caused by:\n"
1600 " * Loading two different object files which export the same symbol\n"
1601 " * Specifying the same object file twice on the GHCi command line\n"
1602 " * An incorrect `package.conf' entry, causing some object to be\n"
1603 " loaded twice.\n",
1604 (char*)key,
1605 obj_name
1606 );
1607 return 0;
1608 }
1609
1610 static HsBool ghciLookupSymbolTable(HashTable *table,
1611 const char *key, void **result)
1612 {
1613 RtsSymbolInfo *pinfo = lookupStrHashTable(table, key);
1614 if (!pinfo) {
1615 *result = NULL;
1616 return HS_BOOL_FALSE;
1617 }
1618 if (pinfo->weak)
1619 IF_DEBUG(linker, debugBelch("lookup: promoting %s\n", key));
1620 /* Once it's looked up, it can no longer be overridden */
1621 pinfo->weak = HS_BOOL_FALSE;
1622
1623 *result = pinfo->value;
1624 return HS_BOOL_TRUE;
1625 }
1626
1627 static void ghciRemoveSymbolTable(HashTable *table, const char *key,
1628 ObjectCode *owner)
1629 {
1630 RtsSymbolInfo *pinfo = lookupStrHashTable(table, key);
1631 if (!pinfo || owner != pinfo->owner) return;
1632 removeStrHashTable(table, key, NULL);
1633 stgFree(pinfo);
1634 }
1635 /* -----------------------------------------------------------------------------
1636 * initialize the object linker
1637 */
1638
1639
1640 static int linker_init_done = 0 ;
1641
1642 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1643 static void *dl_prog_handle;
1644 static regex_t re_invalid;
1645 static regex_t re_realso;
1646 #ifdef THREADED_RTS
1647 static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
1648 #endif
1649 #elif defined(OBJFORMAT_PEi386)
1650 void addDLLHandle(pathchar* dll_name, HINSTANCE instance);
1651 #endif
1652
1653 void initLinker (void)
1654 {
1655 // default to retaining CAFs for backwards compatibility. Most
1656 // users will want initLinker_(0): otherwise unloadObj() will not
1657 // be able to unload object files when they contain CAFs.
1658 initLinker_(1);
1659 }
1660
1661 void
1662 initLinker_ (int retain_cafs)
1663 {
1664 RtsSymbolVal *sym;
1665 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1666 int compileResult;
1667 #endif
1668
1669 IF_DEBUG(linker, debugBelch("initLinker: start\n"));
1670
1671 /* Make initLinker idempotent, so we can call it
1672 before every relevant operation; that means we
1673 don't need to initialise the linker separately */
1674 if (linker_init_done == 1) {
1675 IF_DEBUG(linker, debugBelch("initLinker: idempotent return\n"));
1676 return;
1677 } else {
1678 linker_init_done = 1;
1679 }
1680
1681 objects = NULL;
1682 unloaded_objects = NULL;
1683
1684 #if defined(THREADED_RTS)
1685 initMutex(&linker_mutex);
1686 initMutex(&linker_unloaded_mutex);
1687 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1688 initMutex(&dl_mutex);
1689 #endif
1690 #endif
1691 symhash = allocStrHashTable();
1692
1693 /* populate the symbol table with stuff from the RTS */
1694 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
1695 if (! ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"),
1696 symhash, sym->lbl, sym->addr, HS_BOOL_FALSE, NULL)) {
1697 barf("ghciInsertSymbolTable failed");
1698 }
1699 IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr));
1700 }
1701 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
1702 machoInitSymbolsWithoutUnderscore();
1703 # endif
1704 /* GCC defines a special symbol __dso_handle which is resolved to NULL if
1705 referenced from a statically linked module. We need to mimic this, but
1706 we cannot use NULL because we use it to mean nonexistent symbols. So we
1707 use an arbitrary (hopefully unique) address here.
1708 */
1709 if (! ghciInsertSymbolTable(WSTR("(GHCi special symbols)"),
1710 symhash, "__dso_handle", (void *)0x12345687, HS_BOOL_FALSE, NULL)) {
1711 barf("ghciInsertSymbolTable failed");
1712 }
1713
1714 // Redirect newCAF to newRetainedCAF if retain_cafs is true.
1715 if (! ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"), symhash,
1716 MAYBE_LEADING_UNDERSCORE_STR("newCAF"),
1717 retain_cafs ? newRetainedCAF : newGCdCAF,
1718 HS_BOOL_FALSE, NULL)) {
1719 barf("ghciInsertSymbolTable failed");
1720 }
1721
1722 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1723 # if defined(RTLD_DEFAULT)
1724 dl_prog_handle = RTLD_DEFAULT;
1725 # else
1726 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
1727 # endif /* RTLD_DEFAULT */
1728
1729 compileResult = regcomp(&re_invalid,
1730 "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*(invalid ELF header|file too short)",
1731 REG_EXTENDED);
1732 if (compileResult != 0) {
1733 barf("Compiling re_invalid failed");
1734 }
1735 compileResult = regcomp(&re_realso,
1736 "(GROUP|INPUT) *\\( *([^ )]+)",
1737 REG_EXTENDED);
1738 if (compileResult != 0) {
1739 barf("Compiling re_realso failed");
1740 }
1741 # endif
1742
1743 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
1744 if (RtsFlags.MiscFlags.linkerMemBase != 0) {
1745 // User-override for mmap_32bit_base
1746 mmap_32bit_base = (void*)RtsFlags.MiscFlags.linkerMemBase;
1747 }
1748 #endif
1749
1750 #if defined(mingw32_HOST_OS)
1751 /*
1752 * These two libraries cause problems when added to the static link,
1753 * but are necessary for resolving symbols in GHCi, hence we load
1754 * them manually here.
1755 */
1756 addDLL(WSTR("msvcrt"));
1757 addDLL(WSTR("kernel32"));
1758 addDLLHandle(WSTR("*.exe"), GetModuleHandle(NULL));
1759 #endif
1760
1761 m32_allocator_init(&allocator);
1762
1763 IF_DEBUG(linker, debugBelch("initLinker: done\n"));
1764 return;
1765 }
1766
1767 void
1768 exitLinker( void ) {
1769 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1770 if (linker_init_done == 1) {
1771 regfree(&re_invalid);
1772 regfree(&re_realso);
1773 #ifdef THREADED_RTS
1774 closeMutex(&dl_mutex);
1775 #endif
1776 }
1777 #endif
1778 if (linker_init_done == 1) {
1779 freeHashTable(symhash, free);
1780 }
1781 #ifdef THREADED_RTS
1782 closeMutex(&linker_mutex);
1783 #endif
1784 }
1785
1786 /* -----------------------------------------------------------------------------
1787 * Loading DLL or .so dynamic libraries
1788 * -----------------------------------------------------------------------------
1789 *
1790 * Add a DLL from which symbols may be found. In the ELF case, just
1791 * do RTLD_GLOBAL-style add, so no further messing around needs to
1792 * happen in order that symbols in the loaded .so are findable --
1793 * lookupSymbol() will subsequently see them by dlsym on the program's
1794 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
1795 *
1796 * In the PEi386 case, open the DLLs and put handles to them in a
1797 * linked list. When looking for a symbol, try all handles in the
1798 * list. This means that we need to load even DLLs that are guaranteed
1799 * to be in the ghc.exe image already, just so we can get a handle
1800 * to give to loadSymbol, so that we can find the symbols. For such
1801 * libraries, the LoadLibrary call should be a no-op except for returning
1802 * the handle.
1803 *
1804 */
1805
1806 #if defined(OBJFORMAT_PEi386)
1807 /* A record for storing handles into DLLs. */
1808
1809 typedef
1810 struct _OpenedDLL {
1811 pathchar* name;
1812 struct _OpenedDLL* next;
1813 HINSTANCE instance;
1814 }
1815 OpenedDLL;
1816
1817 /* A list thereof. */
1818 static OpenedDLL* opened_dlls = NULL;
1819
1820 /* A record for storing indirectly linked functions from DLLs. */
1821 typedef
1822 struct _IndirectAddr {
1823 void* addr;
1824 struct _IndirectAddr* next;
1825 }
1826 IndirectAddr;
1827
1828 /* A list thereof. */
1829 static IndirectAddr* indirects = NULL;
1830
1831 /* Adds a DLL instance to the list of DLLs in which to search for symbols. */
1832 void addDLLHandle(pathchar* dll_name, HINSTANCE instance) {
1833 OpenedDLL* o_dll;
1834 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLLHandle" );
1835 o_dll->name = dll_name ? pathdup(dll_name) : NULL;
1836 o_dll->instance = instance;
1837 o_dll->next = opened_dlls;
1838 opened_dlls = o_dll;
1839 }
1840
1841 #endif
1842
1843 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1844
1845 /* Suppose in ghci we load a temporary SO for a module containing
1846 f = 1
1847 and then modify the module, recompile, and load another temporary
1848 SO with
1849 f = 2
1850 Then as we don't unload the first SO, dlsym will find the
1851 f = 1
1852 symbol whereas we want the
1853 f = 2
1854 symbol. We therefore need to keep our own SO handle list, and
1855 try SOs in the right order. */
1856
1857 typedef
1858 struct _OpenedSO {
1859 struct _OpenedSO* next;
1860 void *handle;
1861 }
1862 OpenedSO;
1863
1864 /* A list thereof. */
1865 static OpenedSO* openedSOs = NULL;
1866
1867 static const char *
1868 internal_dlopen(const char *dll_name)
1869 {
1870 OpenedSO* o_so;
1871 void *hdl;
1872 const char *errmsg;
1873 char *errmsg_copy;
1874
1875 // omitted: RTLD_NOW
1876 // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
1877 IF_DEBUG(linker,
1878 debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name));
1879
1880 //-------------- Begin critical section ------------------
1881 // This critical section is necessary because dlerror() is not
1882 // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008)
1883 // Also, the error message returned must be copied to preserve it
1884 // (see POSIX also)
1885
1886 ACQUIRE_LOCK(&dl_mutex);
1887 hdl = dlopen(dll_name, RTLD_LAZY|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */
1888
1889 errmsg = NULL;
1890 if (hdl == NULL) {
1891 /* dlopen failed; return a ptr to the error msg. */
1892 errmsg = dlerror();
1893 if (errmsg == NULL) errmsg = "addDLL: unknown error";
1894 errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL");
1895 strcpy(errmsg_copy, errmsg);
1896 errmsg = errmsg_copy;
1897 } else {
1898 o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL");
1899 o_so->handle = hdl;
1900 o_so->next = openedSOs;
1901 openedSOs = o_so;
1902 }
1903
1904 RELEASE_LOCK(&dl_mutex);
1905 //--------------- End critical section -------------------
1906
1907 return errmsg;
1908 }
1909
1910 /*
1911 Note [RTLD_LOCAL]
1912
1913 In GHCi we want to be able to override previous .so's with newly
1914 loaded .so's when we recompile something. This further implies that
1915 when we look up a symbol in internal_dlsym() we have to iterate
1916 through the loaded libraries (in order from most recently loaded to
1917 oldest) looking up the symbol in each one until we find it.
1918
1919 However, this can cause problems for some symbols that are copied
1920 by the linker into the executable image at runtime - see #8935 for a
1921 lengthy discussion. To solve that problem we need to look up
1922 symbols in the main executable *first*, before attempting to look
1923 them up in the loaded .so's. But in order to make that work, we
1924 have to always call dlopen with RTLD_LOCAL, so that the loaded
1925 libraries don't populate the global symbol table.
1926 */
1927
1928 static void *
1929 internal_dlsym(const char *symbol) {
1930 OpenedSO* o_so;
1931 void *v;
1932
1933 // We acquire dl_mutex as concurrent dl* calls may alter dlerror
1934 ACQUIRE_LOCK(&dl_mutex);
1935 dlerror();
1936 // look in program first
1937 v = dlsym(dl_prog_handle, symbol);
1938 if (dlerror() == NULL) {
1939 RELEASE_LOCK(&dl_mutex);
1940 return v;
1941 }
1942
1943 for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) {
1944 v = dlsym(o_so->handle, symbol);
1945 if (dlerror() == NULL) {
1946 RELEASE_LOCK(&dl_mutex);
1947 return v;
1948 }
1949 }
1950 RELEASE_LOCK(&dl_mutex);
1951 return v;
1952 }
1953 # endif
1954
1955 const char *
1956 addDLL( pathchar *dll_name )
1957 {
1958 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1959 /* ------------------- ELF DLL loader ------------------- */
1960
1961 #define NMATCH 5
1962 regmatch_t match[NMATCH];
1963 const char *errmsg;
1964 FILE* fp;
1965 size_t match_length;
1966 #define MAXLINE 1000
1967 char line[MAXLINE];
1968 int result;
1969
1970 IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name));
1971 errmsg = internal_dlopen(dll_name);
1972
1973 if (errmsg == NULL) {
1974 return NULL;
1975 }
1976
1977 // GHC Trac ticket #2615
1978 // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so)
1979 // contain linker scripts rather than ELF-format object code. This
1980 // code handles the situation by recognizing the real object code
1981 // file name given in the linker script.
1982 //
1983 // If an "invalid ELF header" error occurs, it is assumed that the
1984 // .so file contains a linker script instead of ELF object code.
1985 // In this case, the code looks for the GROUP ( ... ) linker
1986 // directive. If one is found, the first file name inside the
1987 // parentheses is treated as the name of a dynamic library and the
1988 // code attempts to dlopen that file. If this is also unsuccessful,
1989 // an error message is returned.
1990
1991 // see if the error message is due to an invalid ELF header
1992 IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg));
1993 result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0);
1994 IF_DEBUG(linker, debugBelch("result = %i\n", result));
1995 if (result == 0) {
1996 // success -- try to read the named file as a linker script
1997 match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so),
1998 MAXLINE-1);
1999 strncpy(line, (errmsg+(match[1].rm_so)),match_length);
2000 line[match_length] = '\0'; // make sure string is null-terminated
2001 IF_DEBUG(linker, debugBelch ("file name = '%s'\n", line));
2002 if ((fp = fopen(line, "r")) == NULL) {
2003 return errmsg; // return original error if open fails
2004 }
2005 // try to find a GROUP or INPUT ( ... ) command
2006 while (fgets(line, MAXLINE, fp) != NULL) {
2007 IF_DEBUG(linker, debugBelch("input line = %s", line));
2008 if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
2009 // success -- try to dlopen the first named file
2010 IF_DEBUG(linker, debugBelch("match%s\n",""));
2011 line[match[2].rm_eo] = '\0';
2012 stgFree((void*)errmsg); // Free old message before creating new one
2013 errmsg = internal_dlopen(line+match[2].rm_so);
2014 break;
2015 }
2016 // if control reaches here, no GROUP or INPUT ( ... ) directive
2017 // was found and the original error message is returned to the
2018 // caller
2019 }
2020 fclose(fp);
2021 }
2022 return errmsg;
2023
2024 # elif defined(OBJFORMAT_PEi386)
2025 /* ------------------- Win32 DLL loader ------------------- */
2026
2027 pathchar* buf;
2028 OpenedDLL* o_dll;
2029 HINSTANCE instance;
2030
2031 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
2032
2033 /* See if we've already got it, and ignore if so. */
2034 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
2035 if (0 == pathcmp(o_dll->name, dll_name))
2036 return NULL;
2037 }
2038
2039 /* The file name has no suffix (yet) so that we can try
2040 both foo.dll and foo.drv
2041
2042 The documentation for LoadLibrary says:
2043 If no file name extension is specified in the lpFileName
2044 parameter, the default library extension .dll is
2045 appended. However, the file name string can include a trailing
2046 point character (.) to indicate that the module name has no
2047 extension. */
2048
2049 size_t bufsize = pathlen(dll_name) + 10;
2050 buf = stgMallocBytes(bufsize * sizeof(wchar_t), "addDLL");
2051 snwprintf(buf, bufsize, L"%s.DLL", dll_name);
2052 instance = LoadLibraryW(buf);
2053 if (instance == NULL) {
2054 if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
2055 // KAA: allow loading of drivers (like winspool.drv)
2056 snwprintf(buf, bufsize, L"%s.DRV", dll_name);
2057 instance = LoadLibraryW(buf);
2058 if (instance == NULL) {
2059 if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
2060 // #1883: allow loading of unix-style libfoo.dll DLLs
2061 snwprintf(buf, bufsize, L"lib%s.DLL", dll_name);
2062 instance = LoadLibraryW(buf);
2063 if (instance == NULL) {
2064 goto error;
2065 }
2066 }
2067 }
2068 stgFree(buf);
2069
2070 addDLLHandle(dll_name, instance);
2071
2072 return NULL;
2073
2074 error:
2075 stgFree(buf);
2076 sysErrorBelch("%" PATH_FMT, dll_name);
2077
2078 /* LoadLibrary failed; return a ptr to the error msg. */
2079 return "addDLL: could not load DLL";
2080
2081 # else
2082 barf("addDLL: not implemented on this platform");
2083 # endif
2084 }
2085
2086 /* -----------------------------------------------------------------------------
2087 * insert a symbol in the hash table
2088 *
2089 * Returns: 0 on failure, nozero on success
2090 */
2091 HsInt insertSymbol(pathchar* obj_name, char* key, void* data)
2092 {
2093 return ghciInsertSymbolTable(obj_name, symhash, key, data, HS_BOOL_FALSE, NULL);
2094 }
2095
2096 /* -----------------------------------------------------------------------------
2097 * lookup a symbol in the hash table
2098 */
2099 static void* lookupSymbol_ (char *lbl)
2100 {
2101 void *val;
2102 IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl));
2103
2104 ASSERT(symhash != NULL);
2105
2106 if (!ghciLookupSymbolTable(symhash, lbl, &val)) {
2107 IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n"));
2108 # if defined(OBJFORMAT_ELF)
2109 return internal_dlsym(lbl);
2110 # elif defined(OBJFORMAT_MACHO)
2111 # if HAVE_DLFCN_H
2112 /* On OS X 10.3 and later, we use dlsym instead of the old legacy
2113 interface.
2114
2115 HACK: On OS X, all symbols are prefixed with an underscore.
2116 However, dlsym wants us to omit the leading underscore from the
2117 symbol name -- the dlsym routine puts it back on before searching
2118 for the symbol. For now, we simply strip it off here (and ONLY
2119 here).
2120 */
2121 IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n", lbl));
2122 ASSERT(lbl[0] == '_');
2123 return internal_dlsym(lbl + 1);
2124 # else
2125 if (NSIsSymbolNameDefined(lbl)) {
2126 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
2127 return NSAddressOfSymbol(symbol);
2128 } else {
2129 return NULL;
2130 }
2131 # endif /* HAVE_DLFCN_H */
2132 # elif defined(OBJFORMAT_PEi386)
2133 void* sym;
2134
2135 /* See Note [mingw-w64 name decoration scheme] */
2136 #ifndef x86_64_HOST_ARCH
2137 zapTrailingAtSign ( (unsigned char*)lbl );
2138 #endif
2139 sym = lookupSymbolInDLLs((unsigned char*)lbl);
2140 return sym; // might be NULL if not found
2141
2142 # else
2143 ASSERT(2+2 == 5);
2144 return NULL;
2145 # endif
2146 } else {
2147 IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p\n", lbl, val));
2148 return val;
2149 }
2150 }
2151
2152 void* lookupSymbol( char *lbl )
2153 {
2154 ACQUIRE_LOCK(&linker_mutex);
2155 char *r = lookupSymbol_(lbl);
2156 RELEASE_LOCK(&linker_mutex);
2157 return r;
2158 }
2159
2160 /* -----------------------------------------------------------------------------
2161 Create a StablePtr for a foreign export. This is normally called by
2162 a C function with __attribute__((constructor)), which is generated
2163 by GHC and linked into the module.
2164
2165 If the object code is being loaded dynamically, then we remember
2166 which StablePtrs were allocated by the constructors and free them
2167 again in unloadObj().
2168 -------------------------------------------------------------------------- */
2169
2170 static ObjectCode *loading_obj = NULL;
2171
2172 StgStablePtr foreignExportStablePtr (StgPtr p)
2173 {
2174 ForeignExportStablePtr *fe_sptr;
2175 StgStablePtr *sptr;
2176
2177 sptr = getStablePtr(p);
2178
2179 if (loading_obj != NULL) {
2180 fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr),
2181 "foreignExportStablePtr");
2182 fe_sptr->stable_ptr = sptr;
2183 fe_sptr->next = loading_obj->stable_ptrs;
2184 loading_obj->stable_ptrs = fe_sptr;
2185 }
2186
2187 return sptr;
2188 }
2189
2190
2191 /* -----------------------------------------------------------------------------
2192 * Debugging aid: look in GHCi's object symbol tables for symbols
2193 * within DELTA bytes of the specified address, and show their names.
2194 */
2195 #ifdef DEBUG
2196 void ghci_enquire ( char* addr );
2197
2198 void ghci_enquire ( char* addr )
2199 {
2200 int i;
2201 char* sym;
2202 char* a;
2203 const int DELTA = 64;
2204 ObjectCode* oc;
2205
2206 for (oc = objects; oc; oc = oc->next) {
2207 for (i = 0; i < oc->n_symbols; i++) {
2208 sym = oc->symbols[i];
2209 if (sym == NULL) continue;
2210 a = NULL;
2211 if (a == NULL) {
2212 ghciLookupSymbolTable(symhash, sym, (void **)&a);
2213 }
2214 if (a == NULL) {
2215 // debugBelch("ghci_enquire: can't find %s\n", sym);
2216 }
2217 else if (addr-DELTA <= a && a <= addr+DELTA) {
2218 debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym);
2219 }
2220 }
2221 }
2222 }
2223 #endif
2224
2225 #ifdef USE_MMAP
2226 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
2227 #define ROUND_DOWN(x,size) (x & ~(size - 1))
2228
2229 static StgWord getPageSize(void)
2230 {
2231 static StgWord pagesize = 0;
2232 if (pagesize == 0) {
2233 return sysconf(_SC_PAGESIZE);
2234 } else {
2235 return pagesize;
2236 }
2237 }
2238
2239 static StgWord roundUpToPage (StgWord size)
2240 {
2241 return ROUND_UP(size, getPageSize());
2242 }
2243
2244 #ifdef OBJFORMAT_ELF
2245 static StgWord roundDownToPage (StgWord size)
2246 {
2247 return ROUND_DOWN(size, getPageSize());
2248 }
2249 #endif
2250
2251 //
2252 // Returns NULL on failure.
2253 //
2254 static void * mmapForLinker (size_t bytes, nat flags, int fd, int offset)
2255 {
2256 void *map_addr = NULL;
2257 void *result;
2258 StgWord size;
2259 static nat fixed = 0;
2260
2261 IF_DEBUG(linker, debugBelch("mmapForLinker: start\n"));
2262 size = roundUpToPage(bytes);
2263
2264 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
2265 mmap_again:
2266
2267 if (mmap_32bit_base != 0) {
2268 map_addr = mmap_32bit_base;
2269 }
2270 #endif
2271
2272 IF_DEBUG(linker,
2273 debugBelch("mmapForLinker: \tprotection %#0x\n",
2274 PROT_EXEC | PROT_READ | PROT_WRITE));
2275 IF_DEBUG(linker,
2276 debugBelch("mmapForLinker: \tflags %#0x\n",
2277 MAP_PRIVATE | TRY_MAP_32BIT | fixed | flags));
2278
2279 result = mmap(map_addr, size,
2280 PROT_EXEC|PROT_READ|PROT_WRITE,
2281 MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, offset);
2282
2283 if (result == MAP_FAILED) {
2284 sysErrorBelch("mmap %" FMT_Word " bytes at %p",(W_)size,map_addr);
2285 errorBelch("Try specifying an address with +RTS -xm<addr> -RTS");
2286 return NULL;
2287 }
2288
2289 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
2290 if (mmap_32bit_base != 0) {
2291 if (result == map_addr) {
2292 mmap_32bit_base = (StgWord8*)map_addr + size;
2293 } else {
2294 if ((W_)result > 0x80000000) {
2295 // oops, we were given memory over 2Gb
2296 munmap(result,size);
2297 #if defined(freebsd_HOST_OS) || \
2298 defined(kfreebsdgnu_HOST_OS) || \
2299 defined(dragonfly_HOST_OS)
2300 // Some platforms require MAP_FIXED. This is normally
2301 // a bad idea, because MAP_FIXED will overwrite
2302 // existing mappings.
2303 fixed = MAP_FIXED;
2304 goto mmap_again;
2305 #else
2306 errorBelch("loadObj: failed to mmap() memory below 2Gb; "
2307 "asked for %lu bytes at %p. "
2308 "Try specifying an address with +RTS -xm<addr> -RTS",
2309 size, map_addr);
2310 return NULL;
2311 #endif
2312 } else {
2313 // hmm, we were given memory somewhere else, but it's
2314 // still under 2Gb so we can use it. Next time, ask
2315 // for memory right after the place we just got some
2316 mmap_32bit_base = (StgWord8*)result + size;
2317 }
2318 }
2319 } else {
2320 if ((W_)result > 0x80000000) {
2321 // oops, we were given memory over 2Gb
2322 // ... try allocating memory somewhere else?;
2323 debugTrace(DEBUG_linker,
2324 "MAP_32BIT didn't work; gave us %lu bytes at 0x%p",
2325 bytes, result);
2326 munmap(result, size);
2327
2328 // Set a base address and try again... (guess: 1Gb)
2329 mmap_32bit_base = (void*)0x40000000;
2330 goto mmap_again;
2331 }
2332 }
2333 #endif
2334
2335 IF_DEBUG(linker,
2336 debugBelch("mmapForLinker: mapped %" FMT_Word
2337 " bytes starting at %p\n", (W_)size, result));
2338 IF_DEBUG(linker,
2339 debugBelch("mmapForLinker: done\n"));
2340
2341 return result;
2342 }
2343
2344 /*
2345
2346 Note [M32 Allocator]
2347 ~~~~~~~~~~~~~~~~~~~~
2348
2349 A memory allocator that allocates only pages in the 32-bit range (lower 2GB).
2350 This is useful on 64-bit platforms to ensure that addresses of allocated
2351 objects can be referenced with a 32-bit relative offset.
2352
2353 Initially, the linker used `mmap` to allocate a page per object. Hence it
2354 wasted a lot of space for small objects (see #9314). With this allocator, we
2355 try to fill pages as much as we can for small objects.
2356
2357 How does it work?
2358 -----------------
2359
2360 For small objects, a Word64 counter is added at the beginning of the page they
2361 are stored in. It indicates the number of objects that are still alive in the
2362 page. When the counter drops down to zero, the page is freed. The counter is
2363 atomically decremented, hence the deallocation is thread-safe.
2364
2365 During the allocation phase, the allocator keeps track of some pages that are
2366 not totally filled: the number of pages in the "filling" list is configurable
2367 with M32_MAX_PAGES. Allocation consists in finding some place in one of these
2368 pages or starting a new one, then increasing the page counter. If none of the
2369 pages in the "filling" list has enough free space, the most filled one is
2370 flushed (see below) and a new one is allocated.
2371
2372 The allocator holds a reference on pages in the "filling" list: the counter in
2373 these pages is 1+n where n is the current number of objects allocated in the
2374 page. Hence allocated objects can be freed while the allocator is using
2375 (filling) the page. Flushing a page consists in decreasing its counter and
2376 removing it from the "filling" list. By extension, flushing the allocator
2377 consists in flushing all the pages in the "filling" list. Don't forget to
2378 flush the allocator at the end of the allocation phase in order to avoid space
2379 leaks!
2380
2381 Large objects are objects that are larger than a page (minus the bytes required
2382 for the counter and the optional padding). These objects are allocated into
2383 their own set of pages. We can differentiate large and small objects from
2384 their address: large objects are aligned on page size while small objects never
2385 are (because of the space reserved for the page's object counter).
2386
2387 For large objects, the remaining space at the end of the last page is left
2388 unused by the allocator. It can be used with care as it will be freed with the
2389 associated large object. GHC linker uses this feature/hack, hence changing the
2390 implementation of the M32 allocator must be done with care (i.e. do not try to
2391 improve the allocator to avoid wasting this space without modifying the linker
2392 code accordingly).
2393
2394 Object allocation is *not* thread-safe (however it could be done easily with a
2395 lock in the allocator structure). Object deallocation is thread-safe.
2396
2397 */
2398
2399 /****************************************************************************
2400 * M32 ALLOCATOR (see Note [M32 Allocator]
2401 ***************************************************************************/
2402
2403 /**
2404 * Wrapper for `unmap` that handles error cases.
2405 */
2406 static void munmapForLinker (void * addr, size_t size)
2407 {
2408 int r = munmap(addr,size);
2409 if (r == -1) {
2410 // Should we abort here?
2411 sysErrorBelch("munmap");
2412 }
2413 }
2414
2415 /**
2416 * Initialize the allocator structure
2417 */
2418 static void m32_allocator_init(m32_allocator m32) {
2419 memset(m32, 0, sizeof(struct m32_allocator_t));
2420 }
2421
2422 /**
2423 * Atomically decrement the object counter on the given page and release the
2424 * page if necessary. The given address must be the *base address* of the page.
2425 *
2426 * You shouldn't have to use this method. Use `m32_free` instead.
2427 */
2428 static void m32_free_internal(void * addr) {
2429 uint64_t c = __sync_sub_and_fetch((uint64_t*)addr, 1);
2430 if (c == 0) {
2431 munmapForLinker(addr, getPageSize());
2432 }
2433 }
2434
2435 /**
2436 * Release the allocator's reference to pages on the "filling" list. This
2437 * should be called when it is believed that no more allocations will be needed
2438 * from the allocator to ensure that empty pages waiting to be filled aren't
2439 * unnecessarily held.
2440 */
2441 static void m32_allocator_flush(m32_allocator m32) {
2442 int i;
2443 for (i=0; i<M32_MAX_PAGES; i++) {
2444 void * addr = __sync_fetch_and_and(&m32->pages[i].base_addr, 0x0);
2445 if (addr != 0) {
2446 m32_free_internal(addr);
2447 }
2448 }
2449 }
2450
2451 // Return true if the object has its own dedicated set of pages
2452 #define m32_is_large_object(size,alignment) \
2453 (size >= getPageSize() - ROUND_UP(8,alignment))
2454
2455 // Return true if the object has its own dedicated set of pages
2456 #define m32_is_large_object_addr(addr) \
2457 ((uintptr_t) addr % getPageSize() == 0)
2458
2459 /**
2460 * Free the memory associated with an object.
2461 *
2462 * If the object is "small", the object counter of the page it is allocated in
2463 * is decremented and the page is not freed until all of its objects are freed.
2464 */
2465 static void m32_free(void *addr, unsigned int size) {
2466 uintptr_t m = (uintptr_t) addr % getPageSize();
2467
2468 if (m == 0) {
2469 // large object
2470 munmapForLinker(addr,ROUND_UP(size,getPageSize()));
2471 }
2472 else {
2473 // small object
2474 void * page_addr = (void*)((uintptr_t)addr - m);
2475 m32_free_internal(page_addr);
2476 }
2477 }
2478
2479 /**
2480 * Allocate `size` bytes of memory with the given alignment
2481 */
2482 static void *
2483 m32_alloc(m32_allocator m32, unsigned int size,
2484 unsigned int alignment) {
2485
2486 unsigned int pgsz = (unsigned int)getPageSize();
2487
2488 if (m32_is_large_object(size,alignment)) {
2489 // large object
2490 return mmapForLinker(size,MAP_ANONYMOUS,-1,0);
2491 }
2492 else {
2493 // small object
2494 // Try to find a page that can contain it
2495 int empty = -1;
2496 int most_filled = -1;
2497 int i;
2498 for (i=0; i<M32_MAX_PAGES; i++) {
2499 // empty page
2500 if (m32->pages[i].base_addr == 0) {
2501 empty = empty == -1 ? i : empty;
2502 continue;
2503 }
2504 // page can contain the buffer?
2505 unsigned int alsize = ROUND_UP(m32->pages[i].current_size, alignment);
2506 if (size <= pgsz - alsize) {
2507 void * addr = (char*)m32->pages[i].base_addr + alsize;
2508 m32->pages[i].current_size = alsize + size;
2509 // increment the counter atomically
2510 __sync_fetch_and_add((uint64_t*)m32->pages[i].base_addr, 1);
2511 return addr;
2512 }
2513 // most filled?
2514 if (most_filled == -1
2515 || m32->pages[most_filled].current_size < m32->pages[i].current_size)
2516 {
2517 most_filled = i;
2518 }
2519 }
2520
2521 // If we haven't found an empty page, flush the most filled one
2522 if (empty == -1) {
2523 m32_free_internal(m32->pages[most_filled].base_addr);
2524 m32->pages[most_filled].base_addr = 0;
2525 m32->pages[most_filled].current_size = 0;
2526 empty = most_filled;
2527 }
2528
2529 // Allocate a new page
2530 void * addr = mmapForLinker(pgsz,MAP_ANONYMOUS,-1,0);
2531 if (addr == NULL) {
2532 return NULL;
2533 }
2534 m32->pages[empty].base_addr = addr;
2535 // Add 8 bytes for the counter + padding
2536 m32->pages[empty].current_size = size+ROUND_UP(8,alignment);
2537 // Initialize the counter:
2538 // 1 for the allocator + 1 for the returned allocated memory
2539 *((uint64_t*)addr) = 2;
2540 return (char*)addr + ROUND_UP(8,alignment);
2541 }
2542 }
2543
2544 /****************************************************************************
2545 * END (M32 ALLOCATOR)
2546 ***************************************************************************/
2547
2548 #endif // USE_MMAP
2549
2550 /*
2551 * Remove symbols from the symbol table, and free oc->symbols.
2552 * This operation is idempotent.
2553 */
2554 static void removeOcSymbols (ObjectCode *oc)
2555 {
2556 if (oc->symbols == NULL) return;
2557
2558 // Remove all the mappings for the symbols within this object..
2559 int i;
2560 for (i = 0; i < oc->n_symbols; i++) {
2561 if (oc->symbols[i] != NULL) {
2562 ghciRemoveSymbolTable(symhash, oc->symbols[i], oc);
2563 }
2564 }
2565
2566 stgFree(oc->symbols);
2567 oc->symbols = NULL;
2568 }
2569
2570 /*
2571 * Release StablePtrs and free oc->stable_ptrs.
2572 * This operation is idempotent.
2573 */
2574 static void freeOcStablePtrs (ObjectCode *oc)
2575 {
2576 // Release any StablePtrs that were created when this
2577 // object module was initialized.
2578 ForeignExportStablePtr *fe_ptr, *next;
2579
2580 for (fe_ptr = oc->stable_ptrs; fe_ptr != NULL; fe_ptr = next) {
2581 next = fe_ptr->next;
2582 freeStablePtr(fe_ptr->stable_ptr);
2583 stgFree(fe_ptr);
2584 }
2585 oc->stable_ptrs = NULL;
2586 }
2587
2588 static void
2589 freePreloadObjectFile (ObjectCode *oc)
2590 {
2591 #ifdef USE_MMAP
2592
2593 if (oc->imageMapped) {
2594 munmap(oc->image, oc->fileSize);
2595 } else {
2596 stgFree(oc->image);
2597 }
2598
2599 #elif defined(mingw32_HOST_OS)
2600
2601 VirtualFree(oc->image - PEi386_IMAGE_OFFSET, 0, MEM_RELEASE);
2602
2603 IndirectAddr *ia, *ia_next;
2604 ia = indirects;
2605 while (ia != NULL) {
2606 ia_next = ia->next;
2607 stgFree(ia);
2608 ia = ia_next;
2609 }
2610 indirects = NULL;
2611
2612 #else
2613
2614 stgFree(oc->image);
2615
2616 #endif
2617
2618 oc->image = NULL;
2619 oc->fileSize = 0;
2620 }
2621
2622 /*
2623 * freeObjectCode() releases all the pieces of an ObjectCode. It is called by
2624 * the GC when a previously unloaded ObjectCode has been determined to be
2625 * unused, and when an error occurs during loadObj().
2626 */
2627 void freeObjectCode (ObjectCode *oc)
2628 {
2629 freePreloadObjectFile(oc);
2630
2631 if (oc->symbols != NULL) {
2632 stgFree(oc->symbols);
2633 oc->symbols = NULL;
2634 }
2635
2636 if (oc->sections != NULL) {
2637 int i;
2638 for (i=0; i < oc->n_sections; i++) {
2639 if (oc->sections[i].start != NULL) {
2640 switch(oc->sections[i].alloc){
2641 #ifdef USE_MMAP
2642 case SECTION_MMAP:
2643 munmap(oc->sections[i].mapped_start,
2644 oc->sections[i].mapped_size);
2645 break;
2646 case SECTION_M32:
2647 m32_free(oc->sections[i].start,
2648 oc->sections[i].size);
2649 break;
2650 #endif
2651 case SECTION_MALLOC:
2652 stgFree(oc->sections[i].start);
2653 break;
2654 default:
2655 break;
2656 }
2657 }
2658 }
2659 stgFree(oc->sections);
2660 }
2661
2662 freeProddableBlocks(oc);
2663
2664 /* Free symbol_extras. On x86_64 Windows, symbol_extras are allocated
2665 * alongside the image, so we don't need to free. */
2666 #if NEED_SYMBOL_EXTRAS && (!defined(x86_64_HOST_ARCH) || !defined(mingw32_HOST_OS))
2667 #ifdef USE_MMAP
2668 if (!USE_CONTIGUOUS_MMAP && oc->symbol_extras != NULL)
2669 {
2670 m32_free(oc->symbol_extras, sizeof(SymbolExtra) * oc->n_symbol_extras);
2671 }
2672 #else // !USE_MMAP
2673 stgFree(oc->symbol_extras);
2674 #endif
2675 #endif
2676
2677 stgFree(oc->fileName);
2678 stgFree(oc->archiveMemberName);
2679 stgFree(oc);
2680 }
2681
2682
2683 static ObjectCode*
2684 mkOc( pathchar *path, char *image, int imageSize,
2685 rtsBool mapped, char *archiveMemberName
2686 #ifndef USE_MMAP
2687 #ifdef darwin_HOST_OS
2688 , int misalignment
2689 #endif
2690 #endif
2691 ) {
2692 ObjectCode* oc;
2693
2694 IF_DEBUG(linker, debugBelch("mkOc: start\n"));
2695 oc = stgMallocBytes(sizeof(ObjectCode), "mkOc(oc)");
2696
2697 # if defined(OBJFORMAT_ELF)
2698 oc->formatName = "ELF";
2699 # elif defined(OBJFORMAT_PEi386)
2700 oc->formatName = "PEi386";
2701 # elif defined(OBJFORMAT_MACHO)
2702 oc->formatName = "Mach-O";
2703 # else
2704 stgFree(oc);
2705 barf("loadObj: not implemented on this platform");
2706 # endif
2707
2708 oc->image = image;
2709 oc->fileName = pathdup(path);
2710
2711 if (archiveMemberName) {
2712 oc->archiveMemberName = stgMallocBytes( strlen(archiveMemberName)+1, "loadObj" );
2713 strcpy(oc->archiveMemberName, archiveMemberName);
2714 }
2715 else {
2716 oc->archiveMemberName = NULL;
2717 }
2718
2719 oc->fileSize = imageSize;
2720 oc->symbols = NULL;
2721 oc->n_sections = 0;
2722 oc->sections = NULL;
2723 oc->proddables = NULL;
2724 oc->stable_ptrs = NULL;
2725 #if NEED_SYMBOL_EXTRAS
2726 oc->symbol_extras = NULL;
2727 #endif
2728 oc->imageMapped = mapped;
2729
2730 #ifndef USE_MMAP
2731 #ifdef darwin_HOST_OS
2732 oc->misalignment = misalignment;
2733 #endif
2734 #endif
2735
2736 /* chain it onto the list of objects */
2737 oc->next = NULL;
2738
2739 IF_DEBUG(linker, debugBelch("mkOc: done\n"));
2740 return oc;
2741 }
2742
2743 /* -----------------------------------------------------------------------------
2744 * Check if an object or archive is already loaded.
2745 *
2746 * Returns: 1 if the path is already loaded, 0 otherwise.
2747 */
2748 static HsInt
2749 isAlreadyLoaded( pathchar *path )
2750 {
2751 ObjectCode *o;
2752 for (o = objects; o; o = o->next) {
2753 if (0 == pathcmp(o->fileName, path)) {
2754 return 1; /* already loaded */
2755 }
2756 }
2757 return 0; /* not loaded yet */
2758 }
2759
2760 static HsInt loadArchive_ (pathchar *path)
2761 {
2762 ObjectCode* oc;
2763 char *image;
2764 int memberSize;
2765 FILE *f;
2766 int n;
2767 size_t thisFileNameSize;
2768 char *fileName;
2769 size_t fileNameSize;
2770 int isObject, isGnuIndex, isThin;
2771 char tmp[20];
2772 char *gnuFileIndex;
2773 int gnuFileIndexSize;
2774 #if defined(darwin_HOST_OS)
2775 int i;
2776 uint32_t nfat_arch, nfat_offset, cputype, cpusubtype;
2777 #if defined(i386_HOST_ARCH)
2778 const uint32_t mycputype = CPU_TYPE_X86;
2779 const uint32_t mycpusubtype = CPU_SUBTYPE_X86_ALL;
2780 #elif defined(x86_64_HOST_ARCH)
2781 const uint32_t mycputype = CPU_TYPE_X86_64;
2782 const uint32_t mycpusubtype = CPU_SUBTYPE_X86_64_ALL;
2783 #elif defined(powerpc_HOST_ARCH)
2784 const uint32_t mycputype = CPU_TYPE_POWERPC;
2785 const uint32_t mycpusubtype = CPU_SUBTYPE_POWERPC_ALL;
2786 #elif defined(powerpc64_HOST_ARCH)
2787 const uint32_t mycputype = CPU_TYPE_POWERPC64;
2788 const uint32_t mycpusubtype = CPU_SUBTYPE_POWERPC_ALL;
2789 #else
2790 #error Unknown Darwin architecture
2791 #endif
2792 #if !defined(USE_MMAP)
2793 int misalignment;
2794 #endif
2795 #endif
2796
2797 /* TODO: don't call barf() on error, instead return an error code, freeing
2798 * all resources correctly. This function is pretty complex, so it needs
2799 * to be refactored to make this practical. */
2800
2801 IF_DEBUG(linker, debugBelch("loadArchive: start\n"));
2802 IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%" PATH_FMT" '\n", path));
2803
2804 /* Check that we haven't already loaded this archive.
2805 Ignore requests to load multiple times */
2806 if (isAlreadyLoaded(path)) {
2807 IF_DEBUG(linker,
2808 debugBelch("ignoring repeated load of %" PATH_FMT "\n", path));
2809 return 1; /* success */
2810 }
2811
2812 gnuFileIndex = NULL;
2813 gnuFileIndexSize = 0;
2814
2815 fileNameSize = 32;
2816 fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)");
2817
2818 isThin = 0;
2819
2820 f = pathopen(path, WSTR("rb"));
2821 if (!f)
2822 barf("loadObj: can't read `%s'", path);
2823
2824 /* Check if this is an archive by looking for the magic "!<arch>\n"
2825 * string. Usually, if this fails, we barf and quit. On Darwin however,
2826 * we may have a fat archive, which contains archives for more than
2827 * one architecture. Fat archives start with the magic number 0xcafebabe,
2828 * always stored big endian. If we find a fat_header, we scan through
2829 * the fat_arch structs, searching through for one for our host
2830 * architecture. If a matching struct is found, we read the offset
2831 * of our archive data (nfat_offset) and seek forward nfat_offset bytes
2832 * from the start of the file.
2833 *
2834 * A subtlety is that all of the members of the fat_header and fat_arch
2835 * structs are stored big endian, so we need to call byte order
2836 * conversion functions.
2837 *
2838 * If we find the appropriate architecture in a fat archive, we gobble
2839 * its magic "!<arch>\n" string and continue processing just as if
2840 * we had a single architecture archive.
2841 */
2842
2843 n = fread ( tmp, 1, 8, f );
2844 if (n != 8)
2845 barf("loadArchive: Failed reading header from `%s'", path);
2846 if (strncmp(tmp, "!<arch>\n", 8) == 0) {}
2847 #if !defined(mingw32_HOST_OS)
2848 /* See Note [thin archives on Windows] */
2849 else if (strncmp(tmp, "!<thin>\n", 8) == 0) {
2850 isThin = 1;
2851 }
2852 #endif
2853 #if defined(darwin_HOST_OS)
2854 /* Not a standard archive, look for a fat archive magic number: */
2855 else if (ntohl(*(uint32_t *)tmp) == FAT_MAGIC) {
2856 nfat_arch = ntohl(*(uint32_t *)(tmp + 4));
2857 IF_DEBUG(linker, debugBelch("loadArchive: found a fat archive containing %d architectures\n", nfat_arch));
2858 nfat_offset = 0;
2859
2860 for (i = 0; i < (int)nfat_arch; i++) {
2861 /* search for the right arch */
2862 n = fread( tmp, 1, 20, f );
2863 if (n != 8)
2864 barf("loadArchive: Failed reading arch from `%s'", path);
2865 cputype = ntohl(*(uint32_t *)tmp);
2866 cpusubtype = ntohl(*(uint32_t *)(tmp + 4));
2867
2868 if (cputype == mycputype && cpusubtype == mycpusubtype) {
2869 IF_DEBUG(linker, debugBelch("loadArchive: found my archive in a fat archive\n"));
2870 nfat_offset = ntohl(*(uint32_t *)(tmp + 8));
2871 break;
2872 }
2873 }
2874
2875 if (nfat_offset == 0) {
2876 barf ("loadArchive: searched %d architectures, but no host arch found", (int)nfat_arch);
2877 }
2878 else {
2879 n = fseek( f, nfat_offset, SEEK_SET );
2880 if (n != 0)
2881 barf("loadArchive: Failed to seek to arch in `%s'", path);
2882 n = fread ( tmp, 1, 8, f );
2883 if (n != 8)
2884 barf("loadArchive: Failed reading header from `%s'", path);
2885 if (strncmp(tmp, "!<arch>\n", 8) != 0) {
2886 barf("loadArchive: couldn't find archive in `%s' at offset %d", path, nfat_offset);
2887 }
2888 }
2889 }
2890 else {
2891 barf("loadArchive: Neither an archive, nor a fat archive: `%s'", path);
2892 }
2893 #else
2894 else {
2895 barf("loadArchive: Not an archive: `%s'", path);
2896 }
2897 #endif
2898
2899 IF_DEBUG(linker, debugBelch("loadArchive: loading archive contents\n"));
2900
2901 while(1) {
2902 n = fread ( fileName, 1, 16, f );
2903 if (n != 16) {
2904 if (feof(f)) {
2905 IF_DEBUG(linker, debugBelch("loadArchive: EOF while reading from '%" PATH_FMT "'\n", path));
2906 break;
2907 }
2908 else {
2909 barf("loadArchive: Failed reading file name from `%s'", path);
2910 }
2911 }
2912
2913 #if defined(darwin_HOST_OS)
2914 if (strncmp(fileName, "!<arch>\n", 8) == 0) {
2915 IF_DEBUG(linker, debugBelch("loadArchive: found the start of another archive, breaking\n"));
2916 break;
2917 }
2918 #endif
2919
2920 n = fread ( tmp, 1, 12, f );
2921 if (n != 12)
2922 barf("loadArchive: Failed reading mod time from `%s'", path);
2923 n = fread ( tmp, 1, 6, f );
2924 if (n != 6)
2925 barf("loadArchive: Failed reading owner from `%s'", path);
2926 n = fread ( tmp, 1, 6, f );
2927 if (n != 6)
2928 barf("loadArchive: Failed reading group from `%s'", path);
2929 n = fread ( tmp, 1, 8, f );
2930 if (n != 8)
2931 barf("loadArchive: Failed reading mode from `%s'", path);
2932 n = fread ( tmp, 1, 10, f );
2933 if (n != 10)
2934 barf("loadArchive: Failed reading size from `%s'", path);
2935 tmp[10] = '\0';
2936 for (n = 0; isdigit(tmp[n]); n++);
2937 tmp[n] = '\0';
2938 memberSize = atoi(tmp);
2939
2940 IF_DEBUG(linker, debugBelch("loadArchive: size of this archive member is %d\n", memberSize));
2941 n = fread ( tmp, 1, 2, f );
2942 if (n != 2)
2943 barf("loadArchive: Failed reading magic from `%s'", path);
2944 if (strncmp(tmp, "\x60\x0A", 2) != 0)
2945 barf("loadArchive: Failed reading magic from `%s' at %ld. Got %c%c",
2946 path, ftell(f), tmp[0], tmp[1]);
2947
2948 isGnuIndex = 0;
2949 /* Check for BSD-variant large filenames */
2950 if (0 == strncmp(fileName, "#1/", 3)) {
2951 fileName[16] = '\0';
2952 if (isdigit(fileName[3])) {
2953 for (n = 4; isdigit(fileName[n]); n++);
2954 fileName[n] = '\0';
2955 thisFileNameSize = atoi(fileName + 3);
2956 memberSize -= thisFileNameSize;
2957 if (thisFileNameSize >= fileNameSize) {
2958 /* Double it to avoid potentially continually
2959 increasing it by 1 */
2960 fileNameSize = thisFileNameSize * 2;
2961 fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
2962 }
2963 n = fread ( fileName, 1, thisFileNameSize, f );
2964 if (n != (int)thisFileNameSize) {
2965 barf("loadArchive: Failed reading filename from `%s'",
2966 path);
2967 }
2968 fileName[thisFileNameSize] = 0;
2969
2970 /* On OS X at least, thisFileNameSize is the size of the
2971 fileName field, not the length of the fileName
2972 itself. */
2973 thisFileNameSize = strlen(fileName);
2974 }
2975 else {
2976 barf("loadArchive: BSD-variant filename size not found while reading filename from `%s'", path);
2977 }
2978 }
2979 /* Check for GNU file index file */
2980 else if (0 == strncmp(fileName, "//", 2)) {
2981 fileName[0] = '\0';
2982 thisFileNameSize = 0;
2983 isGnuIndex = 1;
2984 }
2985 /* Check for a file in the GNU file index */
2986 else if (fileName[0] == '/') {
2987 if (isdigit(fileName[1])) {
2988 int i;
2989
2990 for (n = 2; isdigit(fileName[n]); n++);
2991 fileName[n] = '\0';
2992 n = atoi(fileName + 1);
2993
2994 if (gnuFileIndex == NULL) {
2995 barf("loadArchive: GNU-variant filename without an index while reading from `%s'", path);
2996 }
2997 if (n < 0 || n > gnuFileIndexSize) {
2998 barf("loadArchive: GNU-variant filename offset %d out of range [0..%d] while reading filename from `%s'", n, gnuFileIndexSize, path);
2999 }
3000 if (n != 0 && gnuFileIndex[n - 1] != '\n') {
3001 barf("loadArchive: GNU-variant filename offset %d invalid (range [0..%d]) while reading filename from `%s'", n, gnuFileIndexSize, path);
3002 }
3003 for (i = n; gnuFileIndex[i] != '\n'; i++);
3004 thisFileNameSize = i - n - 1;
3005 if (thisFileNameSize >= fileNameSize) {
3006 /* Double it to avoid potentially continually
3007 increasing it by 1 */
3008 fileNameSize = thisFileNameSize * 2;
3009 fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
3010 }
3011 memcpy(fileName, gnuFileIndex + n, thisFileNameSize);
3012 fileName[thisFileNameSize] = '\0';
3013 }
3014 else if (fileName[1] == ' ') {
3015 fileName[0] = '\0';
3016 thisFileNameSize = 0;
3017 }
3018 else {
3019 barf("loadArchive: GNU-variant filename offset not found while reading filename from `%s'", path);
3020 }
3021 }
3022 /* Finally, the case where the filename field actually contains
3023 the filename */
3024 else {
3025 /* GNU ar terminates filenames with a '/', this allowing
3026 spaces in filenames. So first look to see if there is a
3027 terminating '/'. */
3028 for (thisFileNameSize = 0;
3029 thisFileNameSize < 16;
3030 thisFileNameSize++) {
3031 if (fileName[thisFileNameSize] == '/') {
3032 fileName[thisFileNameSize] = '\0';
3033 break;
3034 }
3035 }
3036 /* If we didn't find a '/', then a space teminates the
3037 filename. Note that if we don't find one, then
3038 thisFileNameSize ends up as 16, and we already have the
3039 '\0' at the end. */
3040 if (thisFileNameSize == 16) {
3041 for (thisFileNameSize = 0;
3042 thisFileNameSize < 16;
3043 thisFileNameSize++) {
3044 if (fileName[thisFileNameSize] == ' ') {
3045 fileName[thisFileNameSize] = '\0';
3046 break;
3047 }
3048 }
3049 }
3050 }
3051
3052 IF_DEBUG(linker,
3053 debugBelch("loadArchive: Found member file `%s'\n", fileName));
3054
3055 isObject = thisFileNameSize >= 2
3056 && fileName[thisFileNameSize - 2] == '.'
3057 && fileName[thisFileNameSize - 1] == 'o';
3058
3059 IF_DEBUG(linker, debugBelch("loadArchive: \tthisFileNameSize = %d\n", (int)thisFileNameSize));
3060 IF_DEBUG(linker, debugBelch("loadArchive: \tisObject = %d\n", isObject));
3061
3062 if (isObject) {
3063 char *archiveMemberName;
3064
3065 IF_DEBUG(linker, debugBelch("loadArchive: Member is an object file...loading...\n"));
3066
3067 #if defined(mingw32_HOST_OS)
3068 // TODO: We would like to use allocateExec here, but allocateExec
3069 // cannot currently allocate blocks large enough.
3070 image = allocateImageAndTrampolines(path, fileName,
3071 #if defined(x86_64_HOST_ARCH)
3072 f,
3073 #endif
3074 memberSize);
3075 #elif defined(darwin_HOST_OS)
3076 #if defined(USE_MMAP)
3077 image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1, 0);
3078 #else
3079 /* See loadObj() */
3080 misalignment = machoGetMisalignment(f);
3081 image = stgMallocBytes(memberSize + misalignment, "loadArchive(image)");
3082 image += misalignment;
3083 #endif // USE_MMAP
3084
3085 #else // not windows or darwin
3086 image = stgMallocBytes(memberSize, "loadArchive(image)");
3087 #endif
3088
3089 #if !defined(mingw32_HOST_OS)
3090 /*
3091 * Note [thin archives on Windows]
3092 * This doesn't compile on Windows because it assumes
3093 * char* pathnames, and we use wchar_t* on Windows. It's
3094 * not trivial to fix, so I'm leaving it disabled on
3095 * Windows for now --SDM
3096 */
3097 if (isThin) {
3098 FILE *member;
3099 char *pathCopy, *dirName, *memberPath;
3100
3101 /* Allocate and setup the dirname of the archive. We'll need
3102 this to locate the thin member */
3103 pathCopy = stgMallocBytes(strlen(path) + 1, "loadArchive(file)");
3104 strcpy(pathCopy, path);
3105 dirName = dirname(pathCopy);
3106
3107 /* Append the relative member name to the dirname. This should be
3108 be the full path to the actual thin member. */
3109 memberPath = stgMallocBytes(
3110 strlen(path) + 1 + strlen(fileName) + 1, "loadArchive(file)");
3111 strcpy(memberPath, dirName);
3112 memberPath[strlen(dirName)] = '/';
3113 strcpy(memberPath + strlen(dirName) + 1, fileName);
3114
3115 member = pathopen(memberPath, WSTR("rb"));
3116 if (!member)
3117 barf("loadObj: can't read `%s'", path);
3118
3119 n = fread ( image, 1, memberSize, member );
3120 if (n != memberSize) {
3121 barf("loadArchive: error whilst reading `%s'", fileName);
3122 }
3123
3124 fclose(member);
3125 stgFree(memberPath);
3126 stgFree(pathCopy);
3127 }
3128 else
3129 #endif
3130 {
3131 n = fread ( image, 1, memberSize, f );
3132 if (n != memberSize) {
3133 barf("loadArchive: error whilst reading `%s'", path);
3134 }
3135 }
3136
3137 archiveMemberName = stgMallocBytes(pathlen(path) + thisFileNameSize + 3,
3138 "loadArchive(file)");
3139 sprintf(archiveMemberName, "%" PATH_FMT "(%.*s)",
3140 path, (int)thisFileNameSize, fileName);
3141
3142 oc = mkOc(path, image, memberSize, rtsFalse, archiveMemberName
3143 #if !defined(USE_MMAP) && defined(darwin_HOST_OS)
3144 , misalignment
3145 #endif
3146 );
3147
3148 stgFree(archiveMemberName);
3149
3150 if (0 == loadOc(oc)) {
3151 stgFree(fileName);
3152 fclose(f);
3153 return 0;
3154 } else {
3155 oc->next = objects;
3156 objects = oc;
3157 }
3158 }
3159 else if (isGnuIndex) {
3160 if (gnuFileIndex != NULL) {
3161 barf("loadArchive: GNU-variant index found, but already have an index, while reading filename from `%s'", path);
3162 }
3163 IF_DEBUG(linker, debugBelch("loadArchive: Found GNU-variant file index\n"));
3164 #ifdef USE_MMAP
3165 gnuFileIndex = mmapForLinker(memberSize + 1, MAP_ANONYMOUS, -1, 0);
3166 #else
3167 gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)");
3168 #endif
3169 n = fread ( gnuFileIndex, 1, memberSize, f );
3170 if (n != memberSize) {
3171 barf("loadArchive: error whilst reading `%s'", path);
3172 }
3173 gnuFileIndex[memberSize] = '/';
3174 gnuFileIndexSize = memberSize;
3175 }
3176 else {
3177 IF_DEBUG(linker, debugBelch("loadArchive: '%s' does not appear to be an object file\n", fileName));
3178 if (!isThin || thisFileNameSize == 0) {
3179 n = fseek(f, memberSize, SEEK_CUR);
3180 if (n != 0)
3181 barf("loadArchive: error whilst seeking by %d in `%s'",
3182 memberSize, path);
3183 }
3184 }
3185
3186 /* .ar files are 2-byte aligned */
3187 if (!(isThin && thisFileNameSize > 0) && memberSize % 2) {
3188 IF_DEBUG(linker, debugBelch("loadArchive: trying to read one pad byte\n"));
3189 n = fread ( tmp, 1, 1, f );
3190 if (n != 1) {
3191 if (feof(f)) {
3192 IF_DEBUG(linker, debugBelch("loadArchive: found EOF while reading one pad byte\n"));
3193 break;
3194 }
3195 else {
3196 barf("loadArchive: Failed reading padding from `%s'", path);
3197 }
3198 }
3199 IF_DEBUG(linker, debugBelch("loadArchive: successfully read one pad byte\n"));
3200 }
3201 IF_DEBUG(linker, debugBelch("loadArchive: reached end of archive loading while loop\n"));
3202 }
3203
3204 fclose(f);
3205
3206 stgFree(fileName);
3207 if (gnuFileIndex != NULL) {
3208 #ifdef USE_MMAP
3209 munmap(gnuFileIndex, gnuFileIndexSize + 1);
3210 #else
3211 stgFree(gnuFileIndex);
3212 #endif
3213 }
3214
3215 #ifdef USE_MMAP
3216 m32_allocator_flush(&allocator);
3217 #endif
3218
3219 IF_DEBUG(linker, debugBelch("loadArchive: done\n"));
3220 return 1;
3221 }
3222
3223 HsInt loadArchive (pathchar *path)
3224 {
3225 ACQUIRE_LOCK(&linker_mutex);
3226 HsInt r = loadArchive_(path);
3227 RELEASE_LOCK(&linker_mutex);
3228 return r;
3229 }
3230
3231 //
3232 // Load the object file into memory. This will not be its final resting place,
3233 // as on 64-bit platforms we need to map its segments into the low 2Gb of the
3234 // address space, properly aligned.
3235 //
3236 static ObjectCode *
3237 preloadObjectFile (pathchar *path)
3238 {
3239 int fileSize;
3240 struct_stat st;
3241 int r;
3242 void *image;
3243 ObjectCode *oc;
3244 #if !defined(USE_MMAP) && defined(darwin_HOST_OS)
3245 int misalignment;
3246 #endif
3247
3248 r = pathstat(path, &st);
3249 if (r == -1) {
3250 errorBelch("loadObj: %" PATH_FMT ": file doesn't exist", path);
3251 return NULL;
3252 }
3253
3254 fileSize = st.st_size;
3255
3256 #ifdef USE_MMAP
3257 int fd;
3258
3259 /* On many architectures malloc'd memory isn't executable, so we need to use
3260 * mmap. */
3261
3262 #if defined(openbsd_HOST_OS)
3263 fd = open(path, O_RDONLY, S_IRUSR);
3264 #else
3265 fd = open(path, O_RDONLY);
3266 #endif
3267 if (fd == -1) {
3268 errorBelch("loadObj: can't open %s", path);
3269 return NULL;
3270 }
3271
3272 image = mmap(NULL, fileSize, PROT_READ|PROT_WRITE|PROT_EXEC,
3273 MAP_PRIVATE, fd, 0);
3274 // not 32-bit yet, we'll remap later
3275 close(fd);
3276
3277 #else /* !USE_MMAP */
3278 FILE *f;
3279
3280 /* load the image into memory */
3281 /* coverity[toctou] */
3282 f = pathopen(path, WSTR("rb"));
3283 if (!f) {
3284 errorBelch("loadObj: can't read `%" PATH_FMT "'", path);
3285 return NULL;
3286 }
3287
3288 # if defined(mingw32_HOST_OS)
3289
3290 // TODO: We would like to use allocateExec here, but allocateExec
3291 // cannot currently allocate blocks large enough.
3292 image = allocateImageAndTrampolines(path, "itself",
3293 #if defined(x86_64_HOST_ARCH)
3294 f,
3295 #endif
3296 fileSize);
3297 if (image == NULL) {
3298 fclose(f);
3299 return NULL;
3300 }
3301
3302 # elif defined(darwin_HOST_OS)
3303
3304 // In a Mach-O .o file, all sections can and will be misaligned
3305 // if the total size of the headers is not a multiple of the
3306 // desired alignment. This is fine for .o files that only serve
3307 // as input for the static linker, but it's not fine for us,
3308 // as SSE (used by gcc for floating point) and Altivec require
3309 // 16-byte alignment.
3310 // We calculate the correct alignment from the header before
3311 // reading the file, and then we misalign image on purpose so
3312 // that the actual sections end up aligned again.
3313 misalignment = machoGetMisalignment(f);
3314 image = stgMallocBytes(fileSize + misalignment, "loadObj(image)");
3315 image += misalignment;
3316
3317 # else /* !defined(mingw32_HOST_OS) */
3318
3319 image = stgMallocBytes(fileSize, "loadObj(image)");
3320
3321 #endif
3322
3323 int n;
3324 n = fread ( image, 1, fileSize, f );
3325 fclose(f);
3326 if (n != fileSize) {
3327 errorBelch("loadObj: error whilst reading `%" PATH_FMT "'", path);
3328 stgFree(image);
3329 return NULL;
3330 }
3331
3332 #endif /* USE_MMAP */
3333
3334 oc = mkOc(path, image, fileSize, rtsTrue, NULL
3335 #if !defined(USE_MMAP) && defined(darwin_HOST_OS)
3336 , misalignment
3337 #endif
3338 );
3339
3340 return oc;
3341 }
3342
3343 /* -----------------------------------------------------------------------------
3344 * Load an obj (populate the global symbol table, but don't resolve yet)
3345 *
3346 * Returns: 1 if ok, 0 on error.
3347 */
3348 static HsInt loadObj_ (pathchar *path)
3349 {
3350 ObjectCode* oc;
3351 IF_DEBUG(linker, debugBelch("loadObj %" PATH_FMT "\n", path));
3352
3353 /* debugBelch("loadObj %s\n", path ); */
3354
3355 /* Check that we haven't already loaded this object.
3356 Ignore requests to load multiple times */
3357
3358 if (isAlreadyLoaded(path)) {
3359 IF_DEBUG(linker,
3360 debugBelch("ignoring repeated load of %" PATH_FMT "\n", path));
3361 return 1; /* success */
3362 }
3363
3364 oc = preloadObjectFile(path);
3365 if (oc == NULL) return 0;
3366
3367 if (! loadOc(oc)) {
3368 // failed; free everything we've allocated
3369 removeOcSymbols(oc);
3370 // no need to freeOcStablePtrs, they aren't created until resolveObjs()
3371 freeObjectCode(oc);
3372 return 0;
3373 }
3374
3375 oc->next = objects;
3376 objects = oc;
3377 return 1;
3378 }
3379
3380 HsInt loadObj (pathchar *path)
3381 {
3382 ACQUIRE_LOCK(&linker_mutex);
3383 HsInt r = loadObj_(path);
3384 RELEASE_LOCK(&linker_mutex);
3385 return r;
3386 }
3387
3388 static HsInt loadOc (ObjectCode* oc)
3389 {
3390 int r;
3391
3392 IF_DEBUG(linker, debugBelch("loadOc: start\n"));
3393
3394 /* verify the in-memory image */
3395 # if defined(OBJFORMAT_ELF)
3396 r = ocVerifyImage_ELF ( oc );
3397 # elif defined(OBJFORMAT_PEi386)
3398 r = ocVerifyImage_PEi386 ( oc );
3399 # elif defined(OBJFORMAT_MACHO)
3400 r = ocVerifyImage_MachO ( oc );
3401 # else
3402 barf("loadObj: no verify method");
3403 # endif
3404 if (!r) {
3405 IF_DEBUG(linker, debugBelch("loadOc: ocVerifyImage_* failed\n"));
3406 return r;
3407 }
3408
3409 #if NEED_SYMBOL_EXTRAS
3410 # if defined(OBJFORMAT_MACHO)
3411 r = ocAllocateSymbolExtras_MachO ( oc );
3412 if (!r) {
3413 IF_DEBUG(linker, debugBelch("loadOc: ocAllocateSymbolExtras_MachO failed\n"));
3414 return r;
3415 }
3416 # elif defined(OBJFORMAT_ELF)
3417 r = ocAllocateSymbolExtras_ELF ( oc );
3418 if (!r) {
3419 IF_DEBUG(linker, debugBelch("loadOc: ocAllocateSymbolExtras_ELF failed\n"));
3420 return r;
3421 }
3422 # elif defined(OBJFORMAT_PEi386)
3423 ocAllocateSymbolExtras_PEi386 ( oc );
3424 # endif
3425 #endif
3426
3427 /* build the symbol list for this image */
3428 # if defined(OBJFORMAT_ELF)
3429 r = ocGetNames_ELF ( oc );
3430 # elif defined(OBJFORMAT_PEi386)
3431 r = ocGetNames_PEi386 ( oc );
3432 # elif defined(OBJFORMAT_MACHO)
3433 r = ocGetNames_MachO ( oc );
3434 # else
3435 barf("loadObj: no getNames method");
3436 # endif
3437 if (!r) {
3438 IF_DEBUG(linker, debugBelch("loadOc: ocGetNames_* failed\n"));
3439 return r;
3440 }
3441
3442 /* loaded, but not resolved yet */
3443 oc->status = OBJECT_LOADED;
3444 IF_DEBUG(linker, debugBelch("loadOc: done.\n"));
3445
3446 return 1;
3447 }
3448
3449 /* -----------------------------------------------------------------------------
3450 * resolve all the currently unlinked objects in memory
3451 *
3452 * Returns: 1 if ok, 0 on error.
3453 */
3454 static HsInt resolveObjs_ (void)
3455 {
3456 ObjectCode *oc;
3457 int r;
3458
3459 IF_DEBUG(linker, debugBelch("resolveObjs: start\n"));
3460
3461 for (oc = objects; oc; oc = oc->next) {
3462 if (oc->status != OBJECT_RESOLVED) {
3463 # if defined(OBJFORMAT_ELF)
3464 r = ocResolve_ELF ( oc );
3465 # elif defined(OBJFORMAT_PEi386)
3466 r = ocResolve_PEi386 ( oc );
3467 # elif defined(OBJFORMAT_MACHO)
3468 r = ocResolve_MachO ( oc );
3469 # else
3470 barf("resolveObjs: not implemented on this platform");
3471 # endif
3472 if (!r) { return r; }
3473
3474 // run init/init_array/ctors/mod_init_func
3475
3476 loading_obj = oc; // tells foreignExportStablePtr what to do
3477 #if defined(OBJFORMAT_ELF)
3478 r = ocRunInit_ELF ( oc );
3479 #elif defined(OBJFORMAT_PEi386)
3480 r = ocRunInit_PEi386 ( oc );
3481 #elif defined(OBJFORMAT_MACHO)
3482 r = ocRunInit_MachO ( oc );
3483 #else
3484 barf("resolveObjs: initializers not implemented on this platform");
3485 #endif
3486 loading_obj = NULL;
3487
3488 if (!r) { return r; }
3489
3490 oc->status = OBJECT_RESOLVED;
3491 }
3492 }
3493 IF_DEBUG(linker, debugBelch("resolveObjs: done\n"));
3494 return 1;
3495 }
3496
3497 HsInt resolveObjs (void)
3498 {
3499 ACQUIRE_LOCK(&linker_mutex);
3500 HsInt r = resolveObjs_();
3501 RELEASE_LOCK(&linker_mutex);
3502 return r;
3503 }
3504
3505 /* -----------------------------------------------------------------------------
3506 * delete an object from the pool
3507 */
3508 static HsInt unloadObj_ (pathchar *path, rtsBool just_purge)
3509 {
3510 ObjectCode *oc, *prev, *next;
3511 HsBool unloadedAnyObj = HS_BOOL_FALSE;
3512
3513 ASSERT(symhash != NULL);
3514 ASSERT(objects != NULL);
3515
3516 IF_DEBUG(linker, debugBelch("unloadObj: %" PATH_FMT "\n", path));
3517
3518 prev = NULL;
3519 for (oc = objects; oc; oc = next) {
3520 next = oc->next; // oc might be freed
3521
3522 if (!pathcmp(oc->fileName,path)) {
3523
3524 // these are both idempotent, so in just_purge mode we can
3525 // later call unloadObj() to really unload the object.
3526 removeOcSymbols(oc);
3527 freeOcStablePtrs(oc);
3528
3529 if (!just_purge) {
3530 if (prev == NULL) {
3531 objects = oc->next;
3532 } else {
3533 prev->next = oc->next;
3534 }
3535 ACQUIRE_LOCK(&linker_unloaded_mutex);
3536 oc->next = unloaded_objects;
3537 unloaded_objects = oc;
3538 oc->status = OBJECT_UNLOADED;
3539 RELEASE_LOCK(&linker_unloaded_mutex);
3540 // We do not own oc any more; it can be released at any time by
3541 // the GC in checkUnload().
3542 } else {
3543 prev = oc;
3544 }
3545
3546 /* This could be a member of an archive so continue
3547 * unloading other members. */
3548 unloadedAnyObj = HS_BOOL_TRUE;
3549 } else {
3550 prev = oc;
3551 }
3552 }
3553
3554 if (unloadedAnyObj) {
3555 return 1;
3556 }
3557 else {
3558 errorBelch("unloadObj: can't find `%" PATH_FMT "' to unload", path);
3559 return 0;
3560 }
3561 }
3562
3563 HsInt unloadObj (pathchar *path)
3564 {
3565 ACQUIRE_LOCK(&linker_mutex);
3566 HsInt r = unloadObj_(path, rtsFalse);
3567 RELEASE_LOCK(&linker_mutex);
3568 return r;
3569 }
3570
3571 HsInt purgeObj (pathchar *path)
3572 {
3573 ACQUIRE_LOCK(&linker_mutex);
3574 HsInt r = unloadObj_(path, rtsTrue);
3575 RELEASE_LOCK(&linker_mutex);
3576 return r;
3577 }
3578
3579 /* -----------------------------------------------------------------------------
3580 * Sanity checking. For each ObjectCode, maintain a list of address ranges
3581 * which may be prodded during relocation, and abort if we try and write
3582 * outside any of these.
3583 */
3584 static void
3585 addProddableBlock ( ObjectCode* oc, void* start, int size )
3586 {
3587 ProddableBlock* pb
3588 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
3589
3590 IF_DEBUG(linker, debugBelch("addProddableBlock: %p %p %d\n", oc, start, size));
3591 ASSERT(size > 0);
3592 pb->start = start;
3593 pb->size = size;
3594 pb->next = oc->proddables;
3595 oc->proddables = pb;
3596 }
3597
3598 static void
3599 checkProddableBlock (ObjectCode *oc, void *addr, size_t size )
3600 {
3601 ProddableBlock* pb;
3602
3603 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
3604 char* s = (char*)(pb->start);
3605 char* e = s + pb->size;
3606 char* a = (char*)addr;
3607 if (a >= s && (a+size) <= e) return;
3608 }
3609 barf("checkProddableBlock: invalid fixup in runtime linker: %p", addr);
3610 }
3611
3612 static void freeProddableBlocks (ObjectCode *oc)
3613 {
3614 ProddableBlock *pb, *next;
3615
3616 for (pb = oc->proddables; pb != NULL; pb = next) {
3617 next = pb->next;
3618 stgFree(pb);
3619 }
3620 oc->proddables = NULL;
3621 }
3622
3623 /* -----------------------------------------------------------------------------
3624 * Section management.
3625 */
3626 static void
3627 addSection (Section *s, SectionKind kind, SectionAlloc alloc,
3628 void* start, StgWord size, StgWord mapped_offset,
3629 void* mapped_start, StgWord mapped_size)
3630 {
3631 s->start = start; /* actual start of section in memory */
3632 s->size = size; /* actual size of section in memory */
3633 s->kind = kind;
3634 s->alloc = alloc;
3635 s->mapped_offset = mapped_offset; /* offset from the image of mapped_start */
3636
3637 s->mapped_start = mapped_start; /* start of mmap() block */
3638 s->mapped_size = mapped_size; /* size of mmap() block */
3639
3640 IF_DEBUG(linker,
3641 debugBelch("addSection: %p-%p (size %" FMT_Word "), kind %d\n",
3642 start, (void*)((StgWord)start + size),
3643 size, kind ));
3644 }
3645
3646
3647 /* --------------------------------------------------------------------------
3648 * Symbol Extras.
3649 * This is about allocating a small chunk of memory for every symbol in the
3650 * object file. We make sure that the SymboLExtras are always "in range" of
3651 * limited-range PC-relative instructions on various platforms by allocating
3652 * them right next to the object code itself.
3653 */
3654
3655 #if NEED_SYMBOL_EXTRAS
3656 #if !defined(x86_64_HOST_ARCH) || !defined(mingw32_HOST_OS)
3657
3658 /*
3659 ocAllocateSymbolExtras
3660
3661 Allocate additional space at the end of the object file image to make room
3662 for jump islands (powerpc, x86_64, arm) and GOT entries (x86_64).
3663
3664 PowerPC relative branch instructions have a 24 bit displacement field.
3665 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
3666 If a particular imported symbol is outside this range, we have to redirect
3667 the jump to a short piece of new code that just loads the 32bit absolute
3668 address and jumps there.
3669 On x86_64, PC-relative jumps and PC-relative accesses to the GOT are limited
3670 to 32 bits (+-2GB).
3671
3672 This function just allocates space for one SymbolExtra for every
3673 undefined symbol in the object file. The code for the jump islands is
3674 filled in by makeSymbolExtra below.
3675 */
3676
3677 static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
3678 {
3679 StgWord n;
3680 #ifndef USE_MMAP
3681 int misalignment = 0;
3682 #ifdef darwin_HOST_OS
3683 int aligned;
3684 #endif
3685 #endif
3686
3687 #ifdef USE_MMAP
3688 if (USE_CONTIGUOUS_MMAP)
3689 {
3690 n = roundUpToPage(oc->fileSize);
3691
3692 /* Keep image and symbol_extras contiguous */
3693 void *new = mmapForLinker(n + (sizeof(SymbolExtra) * count),
3694 MAP_ANONYMOUS, -1, 0);
3695 if (new)
3696 {
3697 memcpy(new, oc->image, oc->fileSize);
3698 if (oc->imageMapped) {
3699 munmap(oc->image, n);
3700 }
3701 oc->image = new;
3702 oc->imageMapped = rtsTrue;
3703 oc->fileSize = n + (sizeof(SymbolExtra) * count);
3704 oc->symbol_extras = (SymbolExtra *) (oc->image + n);
3705 }
3706 else {
3707 oc->symbol_extras = NULL;
3708 return 0;
3709 }
3710 }
3711 else
3712 #endif
3713
3714 if( count > 0 )
3715 {
3716 #ifdef USE_MMAP
3717 n = roundUpToPage(oc->fileSize);
3718
3719 oc->symbol_extras = m32_alloc(&allocator,
3720 sizeof(SymbolExtra) * count, 8);
3721 if (oc->symbol_extras == NULL) return 0;
3722 #else
3723 // round up to the nearest 4
3724 aligned = (oc->fileSize + 3) & ~3;
3725
3726 misalignment = oc->misalignment;
3727
3728 oc->image -= misalignment;
3729 oc->image = stgReallocBytes( oc->image,
3730 misalignment +
3731 aligned + sizeof (SymbolExtra) * count,
3732 "ocAllocateSymbolExtras" );
3733 oc->image += misalignment;
3734
3735 oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
3736 #endif /* USE_MMAP */
3737 }
3738
3739 if (oc->symbol_extras != NULL) {
3740 memset( oc->symbol_extras, 0, sizeof (SymbolExtra) * count );
3741 }
3742
3743 oc->first_symbol_extra = first;
3744 oc->n_symbol_extras = count;
3745
3746 return 1;
3747 }
3748
3749 #endif
3750 #endif // NEED_SYMBOL_EXTRAS
3751
3752 #if defined(arm_HOST_ARCH)
3753
3754 static void
3755 ocFlushInstructionCache( ObjectCode *oc )
3756 {
3757 // Object code
3758 __clear_cache(oc->image, oc->image + oc->fileSize);
3759 // Jump islands
3760 __clear_cache(oc->symbol_extras, &oc->symbol_extras[oc->n_symbol_extras]);
3761 }
3762
3763 #endif
3764
3765 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3766 #if !defined(x86_64_HOST_ARCH) || !defined(mingw32_HOST_OS)
3767
3768 static SymbolExtra* makeSymbolExtra( ObjectCode* oc,
3769 unsigned long symbolNumber,
3770 unsigned long target )
3771 {
3772 SymbolExtra *extra;
3773
3774 ASSERT( symbolNumber >= oc->first_symbol_extra
3775 && symbolNumber - oc->first_symbol_extra < oc->n_symbol_extras);
3776
3777 extra = &oc->symbol_extras[symbolNumber - oc->first_symbol_extra];
3778
3779 #ifdef powerpc_HOST_ARCH
3780 // lis r12, hi16(target)
3781 extra->jumpIsland.lis_r12 = 0x3d80;
3782 extra->jumpIsland.hi_addr = target >> 16;
3783
3784 // ori r12, r12, lo16(target)
3785 extra->jumpIsland.ori_r12_r12 = 0x618c;
3786 extra->jumpIsland.lo_addr = target & 0xffff;
3787
3788 // mtctr r12
3789 extra->jumpIsland.mtctr_r12 = 0x7d8903a6;
3790
3791 // bctr
3792 extra->jumpIsland.bctr = 0x4e800420;
3793 #endif
3794 #ifdef x86_64_HOST_ARCH
3795 // jmp *-14(%rip)
3796 static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
3797 extra->addr = target;
3798 memcpy(extra->jumpIsland, jmp, 6);
3799 #endif
3800
3801 return extra;
3802 }
3803
3804 #endif
3805 #endif // defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3806
3807 #ifdef arm_HOST_ARCH
3808 static SymbolExtra* makeArmSymbolExtra( ObjectCode* oc,
3809 unsigned long symbolNumber,
3810 unsigned long target,
3811 int fromThumb,
3812 int toThumb )
3813 {
3814 SymbolExtra *extra;
3815
3816 ASSERT( symbolNumber >= oc->first_symbol_extra
3817 && symbolNumber - oc->first_symbol_extra < oc->n_symbol_extras);
3818
3819 extra = &oc->symbol_extras[symbolNumber - oc->first_symbol_extra];
3820
3821 // Make sure instruction mode bit is set properly
3822 if (toThumb)
3823 target |= 1;
3824 else
3825 target &= ~1;
3826
3827 if (!fromThumb) {
3828 // In ARM encoding:
3829 // movw r12, #0
3830 // movt r12, #0
3831 // bx r12
3832 uint32_t code[] = { 0xe300c000, 0xe340c000, 0xe12fff1c };
3833
3834 // Patch lower half-word into movw
3835 code[0] |= ((target>>12) & 0xf) << 16;
3836 code[0] |= target & 0xfff;
3837 // Patch upper half-word into movt
3838 target >>= 16;
3839 code[1] |= ((target>>12) & 0xf) << 16;
3840 code[1] |= target & 0xfff;
3841
3842 memcpy(extra->jumpIsland, code, 12);
3843
3844 } else {
3845 // In Thumb encoding:
3846 // movw r12, #0
3847 // movt r12, #0
3848 // bx r12
3849 uint16_t code[] = { 0xf240, 0x0c00,
3850 0xf2c0, 0x0c00,
3851 0x4760 };
3852
3853 // Patch lower half-word into movw
3854 code[0] |= (target>>12) & 0xf;
3855 code[0] |= ((target>>11) & 0x1) << 10;
3856 code[1] |= ((target>>8) & 0x7) << 12;
3857 code[1] |= target & 0xff;
3858 // Patch upper half-word into movt
3859 target >>= 16;
3860 code[2] |= (target>>12) & 0xf;
3861 code[2] |= ((target>>11) & 0x1) << 10;
3862 code[3] |= ((target>>8) & 0x7) << 12;
3863 code[3] |= target & 0xff;
3864
3865 memcpy(extra->jumpIsland, code, 10);
3866 }
3867
3868 return extra;
3869 }
3870 #endif // arm_HOST_ARCH
3871
3872 /* --------------------------------------------------------------------------
3873 * PowerPC specifics (instruction cache flushing)
3874 * ------------------------------------------------------------------------*/
3875
3876 #ifdef powerpc_HOST_ARCH
3877 /*
3878 ocFlushInstructionCache
3879
3880 Flush the data & instruction caches.
3881 Because the PPC has split data/instruction caches, we have to
3882 do that whenever we modify code at runtime.
3883 */
3884
3885 static void
3886 ocFlushInstructionCacheFrom(void* begin, size_t length)
3887 {
3888 size_t n = (length + 3) / 4;
3889 unsigned long* p = begin;
3890
3891 while (n--)
3892 {
3893 __asm__ volatile ( "dcbf 0,%0\n\t"
3894 "sync\n\t"
3895 "icbi 0,%0"
3896 :
3897 : "r" (p)
3898 );
3899 p++;
3900 }
3901 __asm__ volatile ( "sync\n\t"
3902 "isync"
3903 );
3904 }
3905
3906 static void
3907 ocFlushInstructionCache( ObjectCode *oc )
3908 {
3909 /* The main object code */
3910 ocFlushInstructionCacheFrom(oc->image
3911 #ifdef darwin_HOST_OS
3912 + oc->misalignment
3913 #endif
3914 , oc->fileSize);
3915
3916 /* Jump Islands */
3917 ocFlushInstructionCacheFrom(oc->symbol_extras, sizeof(SymbolExtra) * oc->n_symbol_extras);
3918 }
3919 #endif /* powerpc_HOST_ARCH */
3920
3921
3922 /* --------------------------------------------------------------------------
3923 * PEi386(+) specifics (Win32 targets)
3924 * ------------------------------------------------------------------------*/
3925
3926 /* The information for this linker comes from
3927 Microsoft Portable Executable
3928 and Common Object File Format Specification
3929 revision 8.3 February 2013
3930
3931 It can be found online at:
3932
3933 https://msdn.microsoft.com/en-us/windows/hardware/gg463119.aspx
3934
3935 Things move, so if that fails, try searching for it via
3936
3937 http://www.google.com/search?q=PE+COFF+specification
3938
3939 The ultimate reference for the PE format is the Winnt.h
3940 header file that comes with the Platform SDKs; as always,
3941 implementations will drift wrt their documentation.
3942
3943 A good background article on the PE format is Matt Pietrek's
3944 March 1994 article in Microsoft System Journal (MSJ)
3945 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
3946 Win32 Portable Executable File Format." The info in there
3947 has recently been updated in a two part article in
3948 MSDN magazine, issues Feb and March 2002,
3949 "Inside Windows: An In-Depth Look into the Win32 Portable
3950 Executable File Format"
3951
3952 John Levine's book "Linkers and Loaders" contains useful
3953 info on PE too.
3954
3955 The PE specification doesn't specify how to do the actual
3956 relocations. For this reason, and because both PE and ELF are
3957 based on COFF, the relocations for the PEi386+ code is based on
3958 the ELF relocations for the equivalent relocation type.
3959
3960 The ELF ABI can be found at
3961
3962 http://www.x86-64.org/documentation/abi.pdf
3963
3964 The current code is based on version 0.99.6 - October 2013
3965 */
3966
3967
3968 #if defined(OBJFORMAT_PEi386)
3969
3970
3971
3972 typedef unsigned char UChar;
3973 typedef unsigned short UInt16;
3974 typedef unsigned int UInt32;
3975 typedef int Int32;
3976 typedef unsigned long long int UInt64;
3977
3978
3979 typedef
3980 struct {
3981 UInt16 Machine;
3982 UInt16 NumberOfSections;
3983 UInt32 TimeDateStamp;
3984 UInt32 PointerToSymbolTable;
3985 UInt32 NumberOfSymbols;
3986 UInt16 SizeOfOptionalHeader;
3987 UInt16 Characteristics;
3988 }
3989 COFF_header;
3990
3991 #define sizeof_COFF_header 20
3992
3993
3994 typedef
3995 struct {
3996 UChar Name[8];
3997 UInt32 VirtualSize;
3998 UInt32 VirtualAddress;
3999 UInt32 SizeOfRawData;
4000 UInt32 PointerToRawData;
4001 UInt32 PointerToRelocations;
4002 UInt32 PointerToLinenumbers;
4003 UInt16 NumberOfRelocations;
4004 UInt16 NumberOfLineNumbers;
4005 UInt32 Characteristics;
4006 }
4007 COFF_section;
4008
4009 #define sizeof_COFF_section 40
4010
4011
4012 typedef
4013 struct {
4014 UChar Name[8];
4015 UInt32 Value;
4016 UInt16 SectionNumber;
4017 UInt16 Type;
4018 UChar StorageClass;
4019 UChar NumberOfAuxSymbols;
4020 }
4021 COFF_symbol;
4022
4023 #define sizeof_COFF_symbol 18
4024
4025
4026 typedef
4027 struct {
4028 UInt32 VirtualAddress;
4029 UInt32 SymbolTableIndex;
4030 UInt16 Type;
4031 }
4032 COFF_reloc;
4033
4034 #define sizeof_COFF_reloc 10
4035
4036
4037 /* From PE spec doc, section 3.3.2 */
4038 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
4039 windows.h -- for the same purpose, but I want to know what I'm
4040 getting, here. */
4041 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
4042 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
4043 #define MYIMAGE_FILE_DLL 0x2000
4044 #define MYIMAGE_FILE_SYSTEM 0x1000
4045 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
4046 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
4047 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
4048
4049 /* From PE spec doc, section 5.4.2 and 5.4.4 */
4050 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
4051 #define MYIMAGE_SYM_CLASS_STATIC 3
4052 #define MYIMAGE_SYM_UNDEFINED 0
4053
4054 /* From PE spec doc, section 3.1 */
4055 #define MYIMAGE_SCN_CNT_CODE 0x00000020
4056 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
4057 #define MYIMAGE_SCN_CNT_UNINITIALIZED_DATA 0x00000080
4058 #define MYIMAGE_SCN_LNK_COMDAT 0x00001000
4059 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
4060 #define MYIMAGE_SCN_LNK_REMOVE 0x00000800
4061 #define MYIMAGE_SCN_MEM_DISCARDABLE 0x02000000
4062
4063 /* From PE spec doc, section 5.2.1 */
4064 #define MYIMAGE_REL_I386_DIR32 0x0006
4065 #define MYIMAGE_REL_I386_REL32 0x0014
4066
4067 static int verifyCOFFHeader ( COFF_header *hdr, pathchar *filename);
4068
4069 /* We assume file pointer is right at the
4070 beginning of COFF object.
4071 */
4072 static char *
4073 allocateImageAndTrampolines (
4074 pathchar* arch_name, char* member_name,
4075 #if defined(x86_64_HOST_ARCH)
4076 FILE* f,
4077 #endif
4078 int size )
4079 {
4080 char* image;
4081 #if defined(x86_64_HOST_ARCH)
4082 /* PeCoff contains number of symbols right in it's header, so
4083 we can reserve the room for symbolExtras right here. */
4084 COFF_header hdr;
4085 size_t n;
4086
4087 n = fread ( &hdr, 1, sizeof_COFF_header, f );
4088 if (n != sizeof( COFF_header )) {
4089 errorBelch("getNumberOfSymbols: error whilst reading `%s' header in `%S'",
4090 member_name, arch_name);
4091 return NULL;
4092 }
4093 fseek( f, -sizeof_COFF_header, SEEK_CUR );
4094
4095 if (!verifyCOFFHeader(&hdr, arch_name)) {
4096 return 0;
4097 }
4098
4099 /* We get back 8-byte aligned memory (is that guaranteed?), but
4100 the offsets to the sections within the file are all 4 mod 8
4101 (is that guaranteed?). We therefore need to offset the image
4102 by 4, so that all the pointers are 8-byte aligned, so that
4103 pointer tagging works. */
4104 /* For 32-bit case we don't need this, hence we use macro PEi386_IMAGE_OFFSET,