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