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