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