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