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