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