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