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