1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 2000-2004
7 * ---------------------------------------------------------------------------*/
10 #include "PosixSource.h"
13 /* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and
14 MREMAP_MAYMOVE from <sys/mman.h>.
23 #include "sm/Storage.h"
26 #include "LinkerInternals.h"
29 #include "StgPrimFloat.h" // for __int_encodeFloat etc.
32 #if !defined(mingw32_HOST_OS)
33 #include "posix/Signals.h"
36 // get protos for is*()
39 #ifdef HAVE_SYS_TYPES_H
40 #include <sys/types.h>
48 #ifdef HAVE_SYS_STAT_H
52 #if defined(HAVE_DLFCN_H)
56 #if defined(cygwin32_HOST_OS)
61 #ifdef HAVE_SYS_TIME_H
65 #include <sys/fcntl.h>
66 #include <sys/termios.h>
67 #include <sys/utime.h>
68 #include <sys/utsname.h>
72 #if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS) || defined(darwin_HOST_OS)
83 #if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
84 # define OBJFORMAT_ELF
85 # include <regex.h> // regex is already used by dlopen() so this is OK
86 // to use here without requiring an additional lib
87 #elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
88 # define OBJFORMAT_PEi386
91 #elif defined(darwin_HOST_OS)
92 # define OBJFORMAT_MACHO
94 # include <mach-o/loader.h>
95 # include <mach-o/nlist.h>
96 # include <mach-o/reloc.h>
97 #if !defined(HAVE_DLFCN_H)
98 # include <mach-o/dyld.h>
100 #if defined(powerpc_HOST_ARCH)
101 # include <mach-o/ppc/reloc.h>
103 #if defined(x86_64_HOST_ARCH)
104 # include <mach-o/x86_64/reloc.h>
108 #if defined(x86_64_HOST_ARCH) && defined(darwin_HOST_OS)
112 /* Hash table mapping symbol names to Symbol */
113 static /*Str*/HashTable *symhash;
115 /* Hash table mapping symbol names to StgStablePtr */
116 static /*Str*/HashTable *stablehash;
118 /* List of currently loaded objects */
119 ObjectCode *objects = NULL; /* initially empty */
121 static HsInt loadOc( ObjectCode* oc );
122 static ObjectCode* mkOc( char *path, char *image, int imageSize
124 #ifdef darwin_HOST_OS
130 #if defined(OBJFORMAT_ELF)
131 static int ocVerifyImage_ELF ( ObjectCode* oc );
132 static int ocGetNames_ELF ( ObjectCode* oc );
133 static int ocResolve_ELF ( ObjectCode* oc );
134 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
135 static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc );
137 #elif defined(OBJFORMAT_PEi386)
138 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
139 static int ocGetNames_PEi386 ( ObjectCode* oc );
140 static int ocResolve_PEi386 ( ObjectCode* oc );
141 static void *lookupSymbolInDLLs ( unsigned char *lbl );
142 static void zapTrailingAtSign ( unsigned char *sym );
143 #elif defined(OBJFORMAT_MACHO)
144 static int ocVerifyImage_MachO ( ObjectCode* oc );
145 static int ocGetNames_MachO ( ObjectCode* oc );
146 static int ocResolve_MachO ( ObjectCode* oc );
149 static int machoGetMisalignment( FILE * );
151 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
152 static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
154 #ifdef powerpc_HOST_ARCH
155 static void machoInitSymbolsWithoutUnderscore( void );
159 /* on x86_64 we have a problem with relocating symbol references in
160 * code that was compiled without -fPIC. By default, the small memory
161 * model is used, which assumes that symbol references can fit in a
162 * 32-bit slot. The system dynamic linker makes this work for
163 * references to shared libraries by either (a) allocating a jump
164 * table slot for code references, or (b) moving the symbol at load
165 * time (and copying its contents, if necessary) for data references.
167 * We unfortunately can't tell whether symbol references are to code
168 * or data. So for now we assume they are code (the vast majority
169 * are), and allocate jump-table slots. Unfortunately this will
170 * SILENTLY generate crashing code for data references. This hack is
171 * enabled by X86_64_ELF_NONPIC_HACK.
173 * One workaround is to use shared Haskell libraries. This is
174 * coming. Another workaround is to keep the static libraries but
175 * compile them with -fPIC, because that will generate PIC references
176 * to data which can be relocated. The PIC code is still too green to
177 * do this systematically, though.
180 * See thread http://www.haskell.org/pipermail/cvs-ghc/2007-September/038458.html
182 * Naming Scheme for Symbol Macros
184 * SymI_*: symbol is internal to the RTS. It resides in an object
185 * file/library that is statically.
186 * SymE_*: symbol is external to the RTS library. It might be linked
189 * Sym*_HasProto : the symbol prototype is imported in an include file
190 * or defined explicitly
191 * Sym*_NeedsProto: the symbol is undefined and we add a dummy
192 * default proto extern void sym(void);
194 #define X86_64_ELF_NONPIC_HACK 1
196 /* Link objects into the lower 2Gb on x86_64. GHC assumes the
197 * small memory model on this architecture (see gcc docs,
200 * MAP_32BIT not available on OpenBSD/amd64
202 #if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
203 #define TRY_MAP_32BIT MAP_32BIT
205 #define TRY_MAP_32BIT 0
209 * Due to the small memory model (see above), on x86_64 we have to map
210 * all our non-PIC object files into the low 2Gb of the address space
211 * (why 2Gb and not 4Gb? Because all addresses must be reachable
212 * using a 32-bit signed PC-relative offset). On Linux we can do this
213 * using the MAP_32BIT flag to mmap(), however on other OSs
214 * (e.g. *BSD, see #2063, and also on Linux inside Xen, see #2512), we
215 * can't do this. So on these systems, we have to pick a base address
216 * in the low 2Gb of the address space and try to allocate memory from
219 * We pick a default address based on the OS, but also make this
220 * configurable via an RTS flag (+RTS -xm)
222 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
224 #if defined(MAP_32BIT)
225 // Try to use MAP_32BIT
226 #define MMAP_32BIT_BASE_DEFAULT 0
229 #define MMAP_32BIT_BASE_DEFAULT 0x40000000
232 static void *mmap_32bit_base = (void *)MMAP_32BIT_BASE_DEFAULT;
235 /* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
236 #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
237 #define MAP_ANONYMOUS MAP_ANON
240 /* -----------------------------------------------------------------------------
241 * Built-in symbols from the RTS
244 typedef struct _RtsSymbolVal {
249 #define Maybe_Stable_Names SymI_HasProto(stg_mkWeakzh) \
250 SymI_HasProto(stg_mkWeakForeignEnvzh) \
251 SymI_HasProto(stg_makeStableNamezh) \
252 SymI_HasProto(stg_finalizzeWeakzh)
254 #if !defined (mingw32_HOST_OS)
255 #define RTS_POSIX_ONLY_SYMBOLS \
256 SymI_HasProto(__hscore_get_saved_termios) \
257 SymI_HasProto(__hscore_set_saved_termios) \
258 SymI_HasProto(shutdownHaskellAndSignal) \
259 SymI_HasProto(lockFile) \
260 SymI_HasProto(unlockFile) \
261 SymI_HasProto(signal_handlers) \
262 SymI_HasProto(stg_sig_install) \
263 SymI_NeedsProto(nocldstop)
266 #if defined (cygwin32_HOST_OS)
267 #define RTS_MINGW_ONLY_SYMBOLS /**/
268 /* Don't have the ability to read import libs / archives, so
269 * we have to stupidly list a lot of what libcygwin.a
272 #define RTS_CYGWIN_ONLY_SYMBOLS \
273 SymI_HasProto(regfree) \
274 SymI_HasProto(regexec) \
275 SymI_HasProto(regerror) \
276 SymI_HasProto(regcomp) \
277 SymI_HasProto(__errno) \
278 SymI_HasProto(access) \
279 SymI_HasProto(chmod) \
280 SymI_HasProto(chdir) \
281 SymI_HasProto(close) \
282 SymI_HasProto(creat) \
284 SymI_HasProto(dup2) \
285 SymI_HasProto(fstat) \
286 SymI_HasProto(fcntl) \
287 SymI_HasProto(getcwd) \
288 SymI_HasProto(getenv) \
289 SymI_HasProto(lseek) \
290 SymI_HasProto(open) \
291 SymI_HasProto(fpathconf) \
292 SymI_HasProto(pathconf) \
293 SymI_HasProto(stat) \
295 SymI_HasProto(tanh) \
296 SymI_HasProto(cosh) \
297 SymI_HasProto(sinh) \
298 SymI_HasProto(atan) \
299 SymI_HasProto(acos) \
300 SymI_HasProto(asin) \
306 SymI_HasProto(sqrt) \
307 SymI_HasProto(localtime_r) \
308 SymI_HasProto(gmtime_r) \
309 SymI_HasProto(mktime) \
310 SymI_NeedsProto(_imp___tzname) \
311 SymI_HasProto(gettimeofday) \
312 SymI_HasProto(timezone) \
313 SymI_HasProto(tcgetattr) \
314 SymI_HasProto(tcsetattr) \
315 SymI_HasProto(memcpy) \
316 SymI_HasProto(memmove) \
317 SymI_HasProto(realloc) \
318 SymI_HasProto(malloc) \
319 SymI_HasProto(free) \
320 SymI_HasProto(fork) \
321 SymI_HasProto(lstat) \
322 SymI_HasProto(isatty) \
323 SymI_HasProto(mkdir) \
324 SymI_HasProto(opendir) \
325 SymI_HasProto(readdir) \
326 SymI_HasProto(rewinddir) \
327 SymI_HasProto(closedir) \
328 SymI_HasProto(link) \
329 SymI_HasProto(mkfifo) \
330 SymI_HasProto(pipe) \
331 SymI_HasProto(read) \
332 SymI_HasProto(rename) \
333 SymI_HasProto(rmdir) \
334 SymI_HasProto(select) \
335 SymI_HasProto(system) \
336 SymI_HasProto(write) \
337 SymI_HasProto(strcmp) \
338 SymI_HasProto(strcpy) \
339 SymI_HasProto(strncpy) \
340 SymI_HasProto(strerror) \
341 SymI_HasProto(sigaddset) \
342 SymI_HasProto(sigemptyset) \
343 SymI_HasProto(sigprocmask) \
344 SymI_HasProto(umask) \
345 SymI_HasProto(uname) \
346 SymI_HasProto(unlink) \
347 SymI_HasProto(utime) \
348 SymI_HasProto(waitpid)
350 #elif !defined(mingw32_HOST_OS)
351 #define RTS_MINGW_ONLY_SYMBOLS /**/
352 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
353 #else /* defined(mingw32_HOST_OS) */
354 #define RTS_POSIX_ONLY_SYMBOLS /**/
355 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
357 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
359 #define RTS_MINGW_EXTRA_SYMS \
360 SymI_NeedsProto(_imp____mb_cur_max) \
361 SymI_NeedsProto(_imp___pctype)
363 #define RTS_MINGW_EXTRA_SYMS
366 #if HAVE_GETTIMEOFDAY
367 #define RTS_MINGW_GETTIMEOFDAY_SYM SymI_NeedsProto(gettimeofday)
369 #define RTS_MINGW_GETTIMEOFDAY_SYM /**/
372 #if HAVE___MINGW_VFPRINTF
373 #define RTS___MINGW_VFPRINTF_SYM SymI_HasProto(__mingw_vfprintf)
375 #define RTS___MINGW_VFPRINTF_SYM /**/
378 /* These are statically linked from the mingw libraries into the ghc
379 executable, so we have to employ this hack. */
380 #define RTS_MINGW_ONLY_SYMBOLS \
381 SymI_HasProto(stg_asyncReadzh) \
382 SymI_HasProto(stg_asyncWritezh) \
383 SymI_HasProto(stg_asyncDoProczh) \
384 SymI_HasProto(memset) \
385 SymI_HasProto(inet_ntoa) \
386 SymI_HasProto(inet_addr) \
387 SymI_HasProto(htonl) \
388 SymI_HasProto(recvfrom) \
389 SymI_HasProto(listen) \
390 SymI_HasProto(bind) \
391 SymI_HasProto(shutdown) \
392 SymI_HasProto(connect) \
393 SymI_HasProto(htons) \
394 SymI_HasProto(ntohs) \
395 SymI_HasProto(getservbyname) \
396 SymI_HasProto(getservbyport) \
397 SymI_HasProto(getprotobynumber) \
398 SymI_HasProto(getprotobyname) \
399 SymI_HasProto(gethostbyname) \
400 SymI_HasProto(gethostbyaddr) \
401 SymI_HasProto(gethostname) \
402 SymI_HasProto(strcpy) \
403 SymI_HasProto(strncpy) \
404 SymI_HasProto(abort) \
405 SymI_NeedsProto(_alloca) \
406 SymI_HasProto(isxdigit) \
407 SymI_HasProto(isupper) \
408 SymI_HasProto(ispunct) \
409 SymI_HasProto(islower) \
410 SymI_HasProto(isspace) \
411 SymI_HasProto(isprint) \
412 SymI_HasProto(isdigit) \
413 SymI_HasProto(iscntrl) \
414 SymI_HasProto(isalpha) \
415 SymI_HasProto(isalnum) \
416 SymI_HasProto(isascii) \
417 RTS___MINGW_VFPRINTF_SYM \
418 SymI_HasProto(strcmp) \
419 SymI_HasProto(memmove) \
420 SymI_HasProto(realloc) \
421 SymI_HasProto(malloc) \
423 SymI_HasProto(tanh) \
424 SymI_HasProto(cosh) \
425 SymI_HasProto(sinh) \
426 SymI_HasProto(atan) \
427 SymI_HasProto(acos) \
428 SymI_HasProto(asin) \
434 SymI_HasProto(sqrt) \
435 SymI_HasProto(powf) \
436 SymI_HasProto(tanhf) \
437 SymI_HasProto(coshf) \
438 SymI_HasProto(sinhf) \
439 SymI_HasProto(atanf) \
440 SymI_HasProto(acosf) \
441 SymI_HasProto(asinf) \
442 SymI_HasProto(tanf) \
443 SymI_HasProto(cosf) \
444 SymI_HasProto(sinf) \
445 SymI_HasProto(expf) \
446 SymI_HasProto(logf) \
447 SymI_HasProto(sqrtf) \
449 SymI_HasProto(erfc) \
450 SymI_HasProto(erff) \
451 SymI_HasProto(erfcf) \
452 SymI_HasProto(memcpy) \
453 SymI_HasProto(rts_InstallConsoleEvent) \
454 SymI_HasProto(rts_ConsoleHandlerDone) \
455 SymI_NeedsProto(mktime) \
456 SymI_NeedsProto(_imp___timezone) \
457 SymI_NeedsProto(_imp___tzname) \
458 SymI_NeedsProto(_imp__tzname) \
459 SymI_NeedsProto(_imp___iob) \
460 SymI_NeedsProto(_imp___osver) \
461 SymI_NeedsProto(localtime) \
462 SymI_NeedsProto(gmtime) \
463 SymI_NeedsProto(opendir) \
464 SymI_NeedsProto(readdir) \
465 SymI_NeedsProto(rewinddir) \
466 RTS_MINGW_EXTRA_SYMS \
467 RTS_MINGW_GETTIMEOFDAY_SYM \
468 SymI_NeedsProto(closedir)
471 #if defined(darwin_HOST_OS) && HAVE_PRINTF_LDBLSTUB
472 #define RTS_DARWIN_ONLY_SYMBOLS \
473 SymI_NeedsProto(asprintf$LDBLStub) \
474 SymI_NeedsProto(err$LDBLStub) \
475 SymI_NeedsProto(errc$LDBLStub) \
476 SymI_NeedsProto(errx$LDBLStub) \
477 SymI_NeedsProto(fprintf$LDBLStub) \
478 SymI_NeedsProto(fscanf$LDBLStub) \
479 SymI_NeedsProto(fwprintf$LDBLStub) \
480 SymI_NeedsProto(fwscanf$LDBLStub) \
481 SymI_NeedsProto(printf$LDBLStub) \
482 SymI_NeedsProto(scanf$LDBLStub) \
483 SymI_NeedsProto(snprintf$LDBLStub) \
484 SymI_NeedsProto(sprintf$LDBLStub) \
485 SymI_NeedsProto(sscanf$LDBLStub) \
486 SymI_NeedsProto(strtold$LDBLStub) \
487 SymI_NeedsProto(swprintf$LDBLStub) \
488 SymI_NeedsProto(swscanf$LDBLStub) \
489 SymI_NeedsProto(syslog$LDBLStub) \
490 SymI_NeedsProto(vasprintf$LDBLStub) \
491 SymI_NeedsProto(verr$LDBLStub) \
492 SymI_NeedsProto(verrc$LDBLStub) \
493 SymI_NeedsProto(verrx$LDBLStub) \
494 SymI_NeedsProto(vfprintf$LDBLStub) \
495 SymI_NeedsProto(vfscanf$LDBLStub) \
496 SymI_NeedsProto(vfwprintf$LDBLStub) \
497 SymI_NeedsProto(vfwscanf$LDBLStub) \
498 SymI_NeedsProto(vprintf$LDBLStub) \
499 SymI_NeedsProto(vscanf$LDBLStub) \
500 SymI_NeedsProto(vsnprintf$LDBLStub) \
501 SymI_NeedsProto(vsprintf$LDBLStub) \
502 SymI_NeedsProto(vsscanf$LDBLStub) \
503 SymI_NeedsProto(vswprintf$LDBLStub) \
504 SymI_NeedsProto(vswscanf$LDBLStub) \
505 SymI_NeedsProto(vsyslog$LDBLStub) \
506 SymI_NeedsProto(vwarn$LDBLStub) \
507 SymI_NeedsProto(vwarnc$LDBLStub) \
508 SymI_NeedsProto(vwarnx$LDBLStub) \
509 SymI_NeedsProto(vwprintf$LDBLStub) \
510 SymI_NeedsProto(vwscanf$LDBLStub) \
511 SymI_NeedsProto(warn$LDBLStub) \
512 SymI_NeedsProto(warnc$LDBLStub) \
513 SymI_NeedsProto(warnx$LDBLStub) \
514 SymI_NeedsProto(wcstold$LDBLStub) \
515 SymI_NeedsProto(wprintf$LDBLStub) \
516 SymI_NeedsProto(wscanf$LDBLStub)
518 #define RTS_DARWIN_ONLY_SYMBOLS
522 # define MAIN_CAP_SYM SymI_HasProto(MainCapability)
524 # define MAIN_CAP_SYM
527 #if !defined(mingw32_HOST_OS)
528 #define RTS_USER_SIGNALS_SYMBOLS \
529 SymI_HasProto(setIOManagerControlFd) \
530 SymI_HasProto(setIOManagerWakeupFd) \
531 SymI_HasProto(ioManagerWakeup) \
532 SymI_HasProto(blockUserSignals) \
533 SymI_HasProto(unblockUserSignals)
535 #define RTS_USER_SIGNALS_SYMBOLS \
536 SymI_HasProto(ioManagerWakeup) \
537 SymI_HasProto(sendIOManagerEvent) \
538 SymI_HasProto(readIOManagerEvent) \
539 SymI_HasProto(getIOManagerEvent) \
540 SymI_HasProto(console_handler)
543 #define RTS_LIBFFI_SYMBOLS \
544 SymE_NeedsProto(ffi_prep_cif) \
545 SymE_NeedsProto(ffi_call) \
546 SymE_NeedsProto(ffi_type_void) \
547 SymE_NeedsProto(ffi_type_float) \
548 SymE_NeedsProto(ffi_type_double) \
549 SymE_NeedsProto(ffi_type_sint64) \
550 SymE_NeedsProto(ffi_type_uint64) \
551 SymE_NeedsProto(ffi_type_sint32) \
552 SymE_NeedsProto(ffi_type_uint32) \
553 SymE_NeedsProto(ffi_type_sint16) \
554 SymE_NeedsProto(ffi_type_uint16) \
555 SymE_NeedsProto(ffi_type_sint8) \
556 SymE_NeedsProto(ffi_type_uint8) \
557 SymE_NeedsProto(ffi_type_pointer)
559 #ifdef TABLES_NEXT_TO_CODE
560 #define RTS_RET_SYMBOLS /* nothing */
562 #define RTS_RET_SYMBOLS \
563 SymI_HasProto(stg_enter_ret) \
564 SymI_HasProto(stg_gc_fun_ret) \
565 SymI_HasProto(stg_ap_v_ret) \
566 SymI_HasProto(stg_ap_f_ret) \
567 SymI_HasProto(stg_ap_d_ret) \
568 SymI_HasProto(stg_ap_l_ret) \
569 SymI_HasProto(stg_ap_n_ret) \
570 SymI_HasProto(stg_ap_p_ret) \
571 SymI_HasProto(stg_ap_pv_ret) \
572 SymI_HasProto(stg_ap_pp_ret) \
573 SymI_HasProto(stg_ap_ppv_ret) \
574 SymI_HasProto(stg_ap_ppp_ret) \
575 SymI_HasProto(stg_ap_pppv_ret) \
576 SymI_HasProto(stg_ap_pppp_ret) \
577 SymI_HasProto(stg_ap_ppppp_ret) \
578 SymI_HasProto(stg_ap_pppppp_ret)
581 /* Modules compiled with -ticky may mention ticky counters */
582 /* This list should marry up with the one in $(TOP)/includes/stg/Ticky.h */
583 #define RTS_TICKY_SYMBOLS \
584 SymI_NeedsProto(ticky_entry_ctrs) \
585 SymI_NeedsProto(top_ct) \
587 SymI_HasProto(ENT_VIA_NODE_ctr) \
588 SymI_HasProto(ENT_STATIC_THK_ctr) \
589 SymI_HasProto(ENT_DYN_THK_ctr) \
590 SymI_HasProto(ENT_STATIC_FUN_DIRECT_ctr) \
591 SymI_HasProto(ENT_DYN_FUN_DIRECT_ctr) \
592 SymI_HasProto(ENT_STATIC_CON_ctr) \
593 SymI_HasProto(ENT_DYN_CON_ctr) \
594 SymI_HasProto(ENT_STATIC_IND_ctr) \
595 SymI_HasProto(ENT_DYN_IND_ctr) \
596 SymI_HasProto(ENT_PERM_IND_ctr) \
597 SymI_HasProto(ENT_PAP_ctr) \
598 SymI_HasProto(ENT_AP_ctr) \
599 SymI_HasProto(ENT_AP_STACK_ctr) \
600 SymI_HasProto(ENT_BH_ctr) \
601 SymI_HasProto(UNKNOWN_CALL_ctr) \
602 SymI_HasProto(SLOW_CALL_v_ctr) \
603 SymI_HasProto(SLOW_CALL_f_ctr) \
604 SymI_HasProto(SLOW_CALL_d_ctr) \
605 SymI_HasProto(SLOW_CALL_l_ctr) \
606 SymI_HasProto(SLOW_CALL_n_ctr) \
607 SymI_HasProto(SLOW_CALL_p_ctr) \
608 SymI_HasProto(SLOW_CALL_pv_ctr) \
609 SymI_HasProto(SLOW_CALL_pp_ctr) \
610 SymI_HasProto(SLOW_CALL_ppv_ctr) \
611 SymI_HasProto(SLOW_CALL_ppp_ctr) \
612 SymI_HasProto(SLOW_CALL_pppv_ctr) \
613 SymI_HasProto(SLOW_CALL_pppp_ctr) \
614 SymI_HasProto(SLOW_CALL_ppppp_ctr) \
615 SymI_HasProto(SLOW_CALL_pppppp_ctr) \
616 SymI_HasProto(SLOW_CALL_OTHER_ctr) \
617 SymI_HasProto(ticky_slow_call_unevald) \
618 SymI_HasProto(SLOW_CALL_ctr) \
619 SymI_HasProto(MULTI_CHUNK_SLOW_CALL_ctr) \
620 SymI_HasProto(MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr) \
621 SymI_HasProto(KNOWN_CALL_ctr) \
622 SymI_HasProto(KNOWN_CALL_TOO_FEW_ARGS_ctr) \
623 SymI_HasProto(KNOWN_CALL_EXTRA_ARGS_ctr) \
624 SymI_HasProto(SLOW_CALL_FUN_TOO_FEW_ctr) \
625 SymI_HasProto(SLOW_CALL_FUN_CORRECT_ctr) \
626 SymI_HasProto(SLOW_CALL_FUN_TOO_MANY_ctr) \
627 SymI_HasProto(SLOW_CALL_PAP_TOO_FEW_ctr) \
628 SymI_HasProto(SLOW_CALL_PAP_CORRECT_ctr) \
629 SymI_HasProto(SLOW_CALL_PAP_TOO_MANY_ctr) \
630 SymI_HasProto(SLOW_CALL_UNEVALD_ctr) \
631 SymI_HasProto(UPDF_OMITTED_ctr) \
632 SymI_HasProto(UPDF_PUSHED_ctr) \
633 SymI_HasProto(CATCHF_PUSHED_ctr) \
634 SymI_HasProto(UPDF_RCC_PUSHED_ctr) \
635 SymI_HasProto(UPDF_RCC_OMITTED_ctr) \
636 SymI_HasProto(UPD_SQUEEZED_ctr) \
637 SymI_HasProto(UPD_CON_IN_NEW_ctr) \
638 SymI_HasProto(UPD_CON_IN_PLACE_ctr) \
639 SymI_HasProto(UPD_PAP_IN_NEW_ctr) \
640 SymI_HasProto(UPD_PAP_IN_PLACE_ctr) \
641 SymI_HasProto(ALLOC_HEAP_ctr) \
642 SymI_HasProto(ALLOC_HEAP_tot) \
643 SymI_HasProto(ALLOC_FUN_ctr) \
644 SymI_HasProto(ALLOC_FUN_adm) \
645 SymI_HasProto(ALLOC_FUN_gds) \
646 SymI_HasProto(ALLOC_FUN_slp) \
647 SymI_HasProto(UPD_NEW_IND_ctr) \
648 SymI_HasProto(UPD_NEW_PERM_IND_ctr) \
649 SymI_HasProto(UPD_OLD_IND_ctr) \
650 SymI_HasProto(UPD_OLD_PERM_IND_ctr) \
651 SymI_HasProto(UPD_BH_UPDATABLE_ctr) \
652 SymI_HasProto(UPD_BH_SINGLE_ENTRY_ctr) \
653 SymI_HasProto(UPD_CAF_BH_UPDATABLE_ctr) \
654 SymI_HasProto(UPD_CAF_BH_SINGLE_ENTRY_ctr) \
655 SymI_HasProto(GC_SEL_ABANDONED_ctr) \
656 SymI_HasProto(GC_SEL_MINOR_ctr) \
657 SymI_HasProto(GC_SEL_MAJOR_ctr) \
658 SymI_HasProto(GC_FAILED_PROMOTION_ctr) \
659 SymI_HasProto(ALLOC_UP_THK_ctr) \
660 SymI_HasProto(ALLOC_SE_THK_ctr) \
661 SymI_HasProto(ALLOC_THK_adm) \
662 SymI_HasProto(ALLOC_THK_gds) \
663 SymI_HasProto(ALLOC_THK_slp) \
664 SymI_HasProto(ALLOC_CON_ctr) \
665 SymI_HasProto(ALLOC_CON_adm) \
666 SymI_HasProto(ALLOC_CON_gds) \
667 SymI_HasProto(ALLOC_CON_slp) \
668 SymI_HasProto(ALLOC_TUP_ctr) \
669 SymI_HasProto(ALLOC_TUP_adm) \
670 SymI_HasProto(ALLOC_TUP_gds) \
671 SymI_HasProto(ALLOC_TUP_slp) \
672 SymI_HasProto(ALLOC_BH_ctr) \
673 SymI_HasProto(ALLOC_BH_adm) \
674 SymI_HasProto(ALLOC_BH_gds) \
675 SymI_HasProto(ALLOC_BH_slp) \
676 SymI_HasProto(ALLOC_PRIM_ctr) \
677 SymI_HasProto(ALLOC_PRIM_adm) \
678 SymI_HasProto(ALLOC_PRIM_gds) \
679 SymI_HasProto(ALLOC_PRIM_slp) \
680 SymI_HasProto(ALLOC_PAP_ctr) \
681 SymI_HasProto(ALLOC_PAP_adm) \
682 SymI_HasProto(ALLOC_PAP_gds) \
683 SymI_HasProto(ALLOC_PAP_slp) \
684 SymI_HasProto(ALLOC_TSO_ctr) \
685 SymI_HasProto(ALLOC_TSO_adm) \
686 SymI_HasProto(ALLOC_TSO_gds) \
687 SymI_HasProto(ALLOC_TSO_slp) \
688 SymI_HasProto(RET_NEW_ctr) \
689 SymI_HasProto(RET_OLD_ctr) \
690 SymI_HasProto(RET_UNBOXED_TUP_ctr) \
691 SymI_HasProto(RET_SEMI_loads_avoided)
694 // On most platforms, the garbage collector rewrites references
695 // to small integer and char objects to a set of common, shared ones.
697 // We don't do this when compiling to Windows DLLs at the moment because
698 // it doesn't support cross package data references well.
700 #if defined(__PIC__) && defined(mingw32_HOST_OS)
701 #define RTS_INTCHAR_SYMBOLS
703 #define RTS_INTCHAR_SYMBOLS \
704 SymI_HasProto(stg_CHARLIKE_closure) \
705 SymI_HasProto(stg_INTLIKE_closure)
709 #define RTS_SYMBOLS \
712 SymI_HasProto(StgReturn) \
713 SymI_HasProto(stg_enter_info) \
714 SymI_HasProto(stg_gc_void_info) \
715 SymI_HasProto(__stg_gc_enter_1) \
716 SymI_HasProto(stg_gc_noregs) \
717 SymI_HasProto(stg_gc_unpt_r1_info) \
718 SymI_HasProto(stg_gc_unpt_r1) \
719 SymI_HasProto(stg_gc_unbx_r1_info) \
720 SymI_HasProto(stg_gc_unbx_r1) \
721 SymI_HasProto(stg_gc_f1_info) \
722 SymI_HasProto(stg_gc_f1) \
723 SymI_HasProto(stg_gc_d1_info) \
724 SymI_HasProto(stg_gc_d1) \
725 SymI_HasProto(stg_gc_l1_info) \
726 SymI_HasProto(stg_gc_l1) \
727 SymI_HasProto(__stg_gc_fun) \
728 SymI_HasProto(stg_gc_fun_info) \
729 SymI_HasProto(stg_gc_gen) \
730 SymI_HasProto(stg_gc_gen_info) \
731 SymI_HasProto(stg_gc_gen_hp) \
732 SymI_HasProto(stg_gc_ut) \
733 SymI_HasProto(stg_gen_yield) \
734 SymI_HasProto(stg_yield_noregs) \
735 SymI_HasProto(stg_yield_to_interpreter) \
736 SymI_HasProto(stg_gen_block) \
737 SymI_HasProto(stg_block_noregs) \
738 SymI_HasProto(stg_block_1) \
739 SymI_HasProto(stg_block_takemvar) \
740 SymI_HasProto(stg_block_putmvar) \
742 SymI_HasProto(MallocFailHook) \
743 SymI_HasProto(OnExitHook) \
744 SymI_HasProto(OutOfHeapHook) \
745 SymI_HasProto(StackOverflowHook) \
746 SymI_HasProto(addDLL) \
747 SymI_HasProto(__int_encodeDouble) \
748 SymI_HasProto(__word_encodeDouble) \
749 SymI_HasProto(__2Int_encodeDouble) \
750 SymI_HasProto(__int_encodeFloat) \
751 SymI_HasProto(__word_encodeFloat) \
752 SymI_HasProto(stg_atomicallyzh) \
753 SymI_HasProto(barf) \
754 SymI_HasProto(debugBelch) \
755 SymI_HasProto(errorBelch) \
756 SymI_HasProto(sysErrorBelch) \
757 SymI_HasProto(stg_getMaskingStatezh) \
758 SymI_HasProto(stg_maskAsyncExceptionszh) \
759 SymI_HasProto(stg_maskUninterruptiblezh) \
760 SymI_HasProto(stg_catchzh) \
761 SymI_HasProto(stg_catchRetryzh) \
762 SymI_HasProto(stg_catchSTMzh) \
763 SymI_HasProto(stg_checkzh) \
764 SymI_HasProto(closure_flags) \
765 SymI_HasProto(cmp_thread) \
766 SymI_HasProto(createAdjustor) \
767 SymI_HasProto(stg_decodeDoublezu2Intzh) \
768 SymI_HasProto(stg_decodeFloatzuIntzh) \
769 SymI_HasProto(defaultsHook) \
770 SymI_HasProto(stg_delayzh) \
771 SymI_HasProto(stg_deRefWeakzh) \
772 SymI_HasProto(stg_deRefStablePtrzh) \
773 SymI_HasProto(dirty_MUT_VAR) \
774 SymI_HasProto(stg_forkzh) \
775 SymI_HasProto(stg_forkOnzh) \
776 SymI_HasProto(forkProcess) \
777 SymI_HasProto(forkOS_createThread) \
778 SymI_HasProto(freeHaskellFunctionPtr) \
779 SymI_HasProto(getOrSetTypeableStore) \
780 SymI_HasProto(getOrSetGHCConcSignalSignalHandlerStore) \
781 SymI_HasProto(getOrSetGHCConcWindowsPendingDelaysStore) \
782 SymI_HasProto(getOrSetGHCConcWindowsIOManagerThreadStore) \
783 SymI_HasProto(getOrSetGHCConcWindowsProddingStore) \
784 SymI_HasProto(getOrSetSystemEventThreadEventManagerStore) \
785 SymI_HasProto(getOrSetSystemEventThreadIOManagerThreadStore) \
786 SymI_HasProto(genSymZh) \
787 SymI_HasProto(genericRaise) \
788 SymI_HasProto(getProgArgv) \
789 SymI_HasProto(getFullProgArgv) \
790 SymI_HasProto(getStablePtr) \
791 SymI_HasProto(hs_init) \
792 SymI_HasProto(hs_exit) \
793 SymI_HasProto(hs_set_argv) \
794 SymI_HasProto(hs_add_root) \
795 SymI_HasProto(hs_perform_gc) \
796 SymI_HasProto(hs_free_stable_ptr) \
797 SymI_HasProto(hs_free_fun_ptr) \
798 SymI_HasProto(hs_hpc_rootModule) \
799 SymI_HasProto(hs_hpc_module) \
800 SymI_HasProto(initLinker) \
801 SymI_HasProto(stg_unpackClosurezh) \
802 SymI_HasProto(stg_getApStackValzh) \
803 SymI_HasProto(stg_getSparkzh) \
804 SymI_HasProto(stg_numSparkszh) \
805 SymI_HasProto(stg_isCurrentThreadBoundzh) \
806 SymI_HasProto(stg_isEmptyMVarzh) \
807 SymI_HasProto(stg_killThreadzh) \
808 SymI_HasProto(loadArchive) \
809 SymI_HasProto(loadObj) \
810 SymI_HasProto(insertStableSymbol) \
811 SymI_HasProto(insertSymbol) \
812 SymI_HasProto(lookupSymbol) \
813 SymI_HasProto(stg_makeStablePtrzh) \
814 SymI_HasProto(stg_mkApUpd0zh) \
815 SymI_HasProto(stg_myThreadIdzh) \
816 SymI_HasProto(stg_labelThreadzh) \
817 SymI_HasProto(stg_newArrayzh) \
818 SymI_HasProto(stg_newBCOzh) \
819 SymI_HasProto(stg_newByteArrayzh) \
820 SymI_HasProto_redirect(newCAF, newDynCAF) \
821 SymI_HasProto(stg_newMVarzh) \
822 SymI_HasProto(stg_newMutVarzh) \
823 SymI_HasProto(stg_newTVarzh) \
824 SymI_HasProto(stg_noDuplicatezh) \
825 SymI_HasProto(stg_atomicModifyMutVarzh) \
826 SymI_HasProto(stg_newPinnedByteArrayzh) \
827 SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \
828 SymI_HasProto(newSpark) \
829 SymI_HasProto(performGC) \
830 SymI_HasProto(performMajorGC) \
831 SymI_HasProto(prog_argc) \
832 SymI_HasProto(prog_argv) \
833 SymI_HasProto(stg_putMVarzh) \
834 SymI_HasProto(stg_raisezh) \
835 SymI_HasProto(stg_raiseIOzh) \
836 SymI_HasProto(stg_readTVarzh) \
837 SymI_HasProto(stg_readTVarIOzh) \
838 SymI_HasProto(resumeThread) \
839 SymI_HasProto(resolveObjs) \
840 SymI_HasProto(stg_retryzh) \
841 SymI_HasProto(rts_apply) \
842 SymI_HasProto(rts_checkSchedStatus) \
843 SymI_HasProto(rts_eval) \
844 SymI_HasProto(rts_evalIO) \
845 SymI_HasProto(rts_evalLazyIO) \
846 SymI_HasProto(rts_evalStableIO) \
847 SymI_HasProto(rts_eval_) \
848 SymI_HasProto(rts_getBool) \
849 SymI_HasProto(rts_getChar) \
850 SymI_HasProto(rts_getDouble) \
851 SymI_HasProto(rts_getFloat) \
852 SymI_HasProto(rts_getInt) \
853 SymI_HasProto(rts_getInt8) \
854 SymI_HasProto(rts_getInt16) \
855 SymI_HasProto(rts_getInt32) \
856 SymI_HasProto(rts_getInt64) \
857 SymI_HasProto(rts_getPtr) \
858 SymI_HasProto(rts_getFunPtr) \
859 SymI_HasProto(rts_getStablePtr) \
860 SymI_HasProto(rts_getThreadId) \
861 SymI_HasProto(rts_getWord) \
862 SymI_HasProto(rts_getWord8) \
863 SymI_HasProto(rts_getWord16) \
864 SymI_HasProto(rts_getWord32) \
865 SymI_HasProto(rts_getWord64) \
866 SymI_HasProto(rts_lock) \
867 SymI_HasProto(rts_mkBool) \
868 SymI_HasProto(rts_mkChar) \
869 SymI_HasProto(rts_mkDouble) \
870 SymI_HasProto(rts_mkFloat) \
871 SymI_HasProto(rts_mkInt) \
872 SymI_HasProto(rts_mkInt8) \
873 SymI_HasProto(rts_mkInt16) \
874 SymI_HasProto(rts_mkInt32) \
875 SymI_HasProto(rts_mkInt64) \
876 SymI_HasProto(rts_mkPtr) \
877 SymI_HasProto(rts_mkFunPtr) \
878 SymI_HasProto(rts_mkStablePtr) \
879 SymI_HasProto(rts_mkString) \
880 SymI_HasProto(rts_mkWord) \
881 SymI_HasProto(rts_mkWord8) \
882 SymI_HasProto(rts_mkWord16) \
883 SymI_HasProto(rts_mkWord32) \
884 SymI_HasProto(rts_mkWord64) \
885 SymI_HasProto(rts_unlock) \
886 SymI_HasProto(rts_unsafeGetMyCapability) \
887 SymI_HasProto(rtsSupportsBoundThreads) \
888 SymI_HasProto(rts_isProfiled) \
889 SymI_HasProto(setProgArgv) \
890 SymI_HasProto(startupHaskell) \
891 SymI_HasProto(shutdownHaskell) \
892 SymI_HasProto(shutdownHaskellAndExit) \
893 SymI_HasProto(stable_ptr_table) \
894 SymI_HasProto(stackOverflow) \
895 SymI_HasProto(stg_CAF_BLACKHOLE_info) \
896 SymI_HasProto(stg_BLACKHOLE_info) \
897 SymI_HasProto(__stg_EAGER_BLACKHOLE_info) \
898 SymI_HasProto(stg_BLOCKING_QUEUE_CLEAN_info) \
899 SymI_HasProto(stg_BLOCKING_QUEUE_DIRTY_info) \
900 SymI_HasProto(startTimer) \
901 SymI_HasProto(stg_MVAR_CLEAN_info) \
902 SymI_HasProto(stg_MVAR_DIRTY_info) \
903 SymI_HasProto(stg_IND_STATIC_info) \
904 SymI_HasProto(stg_ARR_WORDS_info) \
905 SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info) \
906 SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info) \
907 SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN0_info) \
908 SymI_HasProto(stg_WEAK_info) \
909 SymI_HasProto(stg_ap_v_info) \
910 SymI_HasProto(stg_ap_f_info) \
911 SymI_HasProto(stg_ap_d_info) \
912 SymI_HasProto(stg_ap_l_info) \
913 SymI_HasProto(stg_ap_n_info) \
914 SymI_HasProto(stg_ap_p_info) \
915 SymI_HasProto(stg_ap_pv_info) \
916 SymI_HasProto(stg_ap_pp_info) \
917 SymI_HasProto(stg_ap_ppv_info) \
918 SymI_HasProto(stg_ap_ppp_info) \
919 SymI_HasProto(stg_ap_pppv_info) \
920 SymI_HasProto(stg_ap_pppp_info) \
921 SymI_HasProto(stg_ap_ppppp_info) \
922 SymI_HasProto(stg_ap_pppppp_info) \
923 SymI_HasProto(stg_ap_0_fast) \
924 SymI_HasProto(stg_ap_v_fast) \
925 SymI_HasProto(stg_ap_f_fast) \
926 SymI_HasProto(stg_ap_d_fast) \
927 SymI_HasProto(stg_ap_l_fast) \
928 SymI_HasProto(stg_ap_n_fast) \
929 SymI_HasProto(stg_ap_p_fast) \
930 SymI_HasProto(stg_ap_pv_fast) \
931 SymI_HasProto(stg_ap_pp_fast) \
932 SymI_HasProto(stg_ap_ppv_fast) \
933 SymI_HasProto(stg_ap_ppp_fast) \
934 SymI_HasProto(stg_ap_pppv_fast) \
935 SymI_HasProto(stg_ap_pppp_fast) \
936 SymI_HasProto(stg_ap_ppppp_fast) \
937 SymI_HasProto(stg_ap_pppppp_fast) \
938 SymI_HasProto(stg_ap_1_upd_info) \
939 SymI_HasProto(stg_ap_2_upd_info) \
940 SymI_HasProto(stg_ap_3_upd_info) \
941 SymI_HasProto(stg_ap_4_upd_info) \
942 SymI_HasProto(stg_ap_5_upd_info) \
943 SymI_HasProto(stg_ap_6_upd_info) \
944 SymI_HasProto(stg_ap_7_upd_info) \
945 SymI_HasProto(stg_exit) \
946 SymI_HasProto(stg_sel_0_upd_info) \
947 SymI_HasProto(stg_sel_10_upd_info) \
948 SymI_HasProto(stg_sel_11_upd_info) \
949 SymI_HasProto(stg_sel_12_upd_info) \
950 SymI_HasProto(stg_sel_13_upd_info) \
951 SymI_HasProto(stg_sel_14_upd_info) \
952 SymI_HasProto(stg_sel_15_upd_info) \
953 SymI_HasProto(stg_sel_1_upd_info) \
954 SymI_HasProto(stg_sel_2_upd_info) \
955 SymI_HasProto(stg_sel_3_upd_info) \
956 SymI_HasProto(stg_sel_4_upd_info) \
957 SymI_HasProto(stg_sel_5_upd_info) \
958 SymI_HasProto(stg_sel_6_upd_info) \
959 SymI_HasProto(stg_sel_7_upd_info) \
960 SymI_HasProto(stg_sel_8_upd_info) \
961 SymI_HasProto(stg_sel_9_upd_info) \
962 SymI_HasProto(stg_upd_frame_info) \
963 SymI_HasProto(stg_bh_upd_frame_info) \
964 SymI_HasProto(suspendThread) \
965 SymI_HasProto(stg_takeMVarzh) \
966 SymI_HasProto(stg_threadStatuszh) \
967 SymI_HasProto(stg_tryPutMVarzh) \
968 SymI_HasProto(stg_tryTakeMVarzh) \
969 SymI_HasProto(stg_unmaskAsyncExceptionszh) \
970 SymI_HasProto(unloadObj) \
971 SymI_HasProto(stg_unsafeThawArrayzh) \
972 SymI_HasProto(stg_waitReadzh) \
973 SymI_HasProto(stg_waitWritezh) \
974 SymI_HasProto(stg_writeTVarzh) \
975 SymI_HasProto(stg_yieldzh) \
976 SymI_NeedsProto(stg_interp_constr_entry) \
977 SymI_HasProto(stg_arg_bitmaps) \
978 SymI_HasProto(alloc_blocks_lim) \
980 SymI_HasProto(allocate) \
981 SymI_HasProto(allocateExec) \
982 SymI_HasProto(freeExec) \
983 SymI_HasProto(getAllocations) \
984 SymI_HasProto(revertCAFs) \
985 SymI_HasProto(RtsFlags) \
986 SymI_NeedsProto(rts_breakpoint_io_action) \
987 SymI_NeedsProto(rts_stop_next_breakpoint) \
988 SymI_NeedsProto(rts_stop_on_exception) \
989 SymI_HasProto(stopTimer) \
990 SymI_HasProto(n_capabilities) \
991 SymI_HasProto(stg_traceCcszh) \
992 SymI_HasProto(stg_traceEventzh) \
993 RTS_USER_SIGNALS_SYMBOLS \
997 // 64-bit support functions in libgcc.a
998 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
999 #define RTS_LIBGCC_SYMBOLS \
1000 SymI_NeedsProto(__divdi3) \
1001 SymI_NeedsProto(__udivdi3) \
1002 SymI_NeedsProto(__moddi3) \
1003 SymI_NeedsProto(__umoddi3) \
1004 SymI_NeedsProto(__muldi3) \
1005 SymI_NeedsProto(__ashldi3) \
1006 SymI_NeedsProto(__ashrdi3) \
1007 SymI_NeedsProto(__lshrdi3)
1009 #define RTS_LIBGCC_SYMBOLS
1012 #if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
1013 // Symbols that don't have a leading underscore
1014 // on Mac OS X. They have to receive special treatment,
1015 // see machoInitSymbolsWithoutUnderscore()
1016 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
1017 SymI_NeedsProto(saveFP) \
1018 SymI_NeedsProto(restFP)
1021 /* entirely bogus claims about types of these symbols */
1022 #define SymI_NeedsProto(vvv) extern void vvv(void);
1023 #if defined(__PIC__) && defined(mingw32_HOST_OS)
1024 #define SymE_HasProto(vvv) SymE_HasProto(vvv);
1025 #define SymE_NeedsProto(vvv) extern void _imp__ ## vvv (void);
1027 #define SymE_NeedsProto(vvv) SymI_NeedsProto(vvv);
1028 #define SymE_HasProto(vvv) SymI_HasProto(vvv)
1030 #define SymI_HasProto(vvv) /**/
1031 #define SymI_HasProto_redirect(vvv,xxx) /**/
1034 RTS_POSIX_ONLY_SYMBOLS
1035 RTS_MINGW_ONLY_SYMBOLS
1036 RTS_CYGWIN_ONLY_SYMBOLS
1037 RTS_DARWIN_ONLY_SYMBOLS
1040 #undef SymI_NeedsProto
1041 #undef SymI_HasProto
1042 #undef SymI_HasProto_redirect
1043 #undef SymE_HasProto
1044 #undef SymE_NeedsProto
1046 #ifdef LEADING_UNDERSCORE
1047 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
1049 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
1052 #define SymI_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1054 #define SymE_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1055 (void*)DLL_IMPORT_DATA_REF(vvv) },
1057 #define SymI_NeedsProto(vvv) SymI_HasProto(vvv)
1058 #define SymE_NeedsProto(vvv) SymE_HasProto(vvv)
1060 // SymI_HasProto_redirect allows us to redirect references to one symbol to
1061 // another symbol. See newCAF/newDynCAF for an example.
1062 #define SymI_HasProto_redirect(vvv,xxx) \
1063 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1066 static RtsSymbolVal rtsSyms[] = {
1069 RTS_POSIX_ONLY_SYMBOLS
1070 RTS_MINGW_ONLY_SYMBOLS
1071 RTS_CYGWIN_ONLY_SYMBOLS
1072 RTS_DARWIN_ONLY_SYMBOLS
1075 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
1076 // dyld stub code contains references to this,
1077 // but it should never be called because we treat
1078 // lazy pointers as nonlazy.
1079 { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
1081 { 0, 0 } /* sentinel */
1086 /* -----------------------------------------------------------------------------
1087 * Insert symbols into hash tables, checking for duplicates.
1090 static void ghciInsertStrHashTable ( char* obj_name,
1096 if (lookupHashTable(table, (StgWord)key) == NULL)
1098 insertStrHashTable(table, (StgWord)key, data);
1103 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
1105 "whilst processing object file\n"
1107 "This could be caused by:\n"
1108 " * Loading two different object files which export the same symbol\n"
1109 " * Specifying the same object file twice on the GHCi command line\n"
1110 " * An incorrect `package.conf' entry, causing some object to be\n"
1112 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
1119 /* -----------------------------------------------------------------------------
1120 * initialize the object linker
1124 static int linker_init_done = 0 ;
1126 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1127 static void *dl_prog_handle;
1128 static regex_t re_invalid;
1129 static regex_t re_realso;
1131 static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
1139 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1143 /* Make initLinker idempotent, so we can call it
1144 before evey relevant operation; that means we
1145 don't need to initialise the linker separately */
1146 if (linker_init_done == 1) { return; } else {
1147 linker_init_done = 1;
1150 #if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO))
1151 initMutex(&dl_mutex);
1153 stablehash = allocStrHashTable();
1154 symhash = allocStrHashTable();
1156 /* populate the symbol table with stuff from the RTS */
1157 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
1158 ghciInsertStrHashTable("(GHCi built-in symbols)",
1159 symhash, sym->lbl, sym->addr);
1161 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
1162 machoInitSymbolsWithoutUnderscore();
1165 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1166 # if defined(RTLD_DEFAULT)
1167 dl_prog_handle = RTLD_DEFAULT;
1169 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
1170 # endif /* RTLD_DEFAULT */
1172 compileResult = regcomp(&re_invalid,
1173 "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*invalid ELF header",
1175 ASSERT( compileResult == 0 );
1176 compileResult = regcomp(&re_realso,
1177 "GROUP *\\( *(([^ )])+)",
1179 ASSERT( compileResult == 0 );
1182 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
1183 if (RtsFlags.MiscFlags.linkerMemBase != 0) {
1184 // User-override for mmap_32bit_base
1185 mmap_32bit_base = (void*)RtsFlags.MiscFlags.linkerMemBase;
1189 #if defined(mingw32_HOST_OS)
1191 * These two libraries cause problems when added to the static link,
1192 * but are necessary for resolving symbols in GHCi, hence we load
1193 * them manually here.
1201 exitLinker( void ) {
1202 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1203 if (linker_init_done == 1) {
1204 regfree(&re_invalid);
1205 regfree(&re_realso);
1207 closeMutex(&dl_mutex);
1213 /* -----------------------------------------------------------------------------
1214 * Loading DLL or .so dynamic libraries
1215 * -----------------------------------------------------------------------------
1217 * Add a DLL from which symbols may be found. In the ELF case, just
1218 * do RTLD_GLOBAL-style add, so no further messing around needs to
1219 * happen in order that symbols in the loaded .so are findable --
1220 * lookupSymbol() will subsequently see them by dlsym on the program's
1221 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
1223 * In the PEi386 case, open the DLLs and put handles to them in a
1224 * linked list. When looking for a symbol, try all handles in the
1225 * list. This means that we need to load even DLLs that are guaranteed
1226 * to be in the ghc.exe image already, just so we can get a handle
1227 * to give to loadSymbol, so that we can find the symbols. For such
1228 * libraries, the LoadLibrary call should be a no-op except for returning
1233 #if defined(OBJFORMAT_PEi386)
1234 /* A record for storing handles into DLLs. */
1239 struct _OpenedDLL* next;
1244 /* A list thereof. */
1245 static OpenedDLL* opened_dlls = NULL;
1248 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1251 internal_dlopen(const char *dll_name)
1257 // omitted: RTLD_NOW
1258 // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
1260 debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name));
1262 //-------------- Begin critical section ------------------
1263 // This critical section is necessary because dlerror() is not
1264 // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008)
1265 // Also, the error message returned must be copied to preserve it
1268 ACQUIRE_LOCK(&dl_mutex);
1269 hdl = dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
1273 /* dlopen failed; return a ptr to the error msg. */
1275 if (errmsg == NULL) errmsg = "addDLL: unknown error";
1276 errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL");
1277 strcpy(errmsg_copy, errmsg);
1278 errmsg = errmsg_copy;
1280 RELEASE_LOCK(&dl_mutex);
1281 //--------------- End critical section -------------------
1288 addDLL( char *dll_name )
1290 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1291 /* ------------------- ELF DLL loader ------------------- */
1294 regmatch_t match[NMATCH];
1297 size_t match_length;
1298 #define MAXLINE 1000
1304 IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name));
1305 errmsg = internal_dlopen(dll_name);
1307 if (errmsg == NULL) {
1311 // GHC Trac ticket #2615
1312 // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so)
1313 // contain linker scripts rather than ELF-format object code. This
1314 // code handles the situation by recognizing the real object code
1315 // file name given in the linker script.
1317 // If an "invalid ELF header" error occurs, it is assumed that the
1318 // .so file contains a linker script instead of ELF object code.
1319 // In this case, the code looks for the GROUP ( ... ) linker
1320 // directive. If one is found, the first file name inside the
1321 // parentheses is treated as the name of a dynamic library and the
1322 // code attempts to dlopen that file. If this is also unsuccessful,
1323 // an error message is returned.
1325 // see if the error message is due to an invalid ELF header
1326 IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg));
1327 result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0);
1328 IF_DEBUG(linker, debugBelch("result = %i\n", result));
1330 // success -- try to read the named file as a linker script
1331 match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so),
1333 strncpy(line, (errmsg+(match[1].rm_so)),match_length);
1334 line[match_length] = '\0'; // make sure string is null-terminated
1335 IF_DEBUG(linker, debugBelch ("file name = '%s'\n", line));
1336 if ((fp = fopen(line, "r")) == NULL) {
1337 return errmsg; // return original error if open fails
1339 // try to find a GROUP ( ... ) command
1340 while (fgets(line, MAXLINE, fp) != NULL) {
1341 IF_DEBUG(linker, debugBelch("input line = %s", line));
1342 if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
1343 // success -- try to dlopen the first named file
1344 IF_DEBUG(linker, debugBelch("match%s\n",""));
1345 line[match[1].rm_eo] = '\0';
1346 errmsg = internal_dlopen(line+match[1].rm_so);
1349 // if control reaches here, no GROUP ( ... ) directive was found
1350 // and the original error message is returned to the caller
1356 # elif defined(OBJFORMAT_PEi386)
1357 /* ------------------- Win32 DLL loader ------------------- */
1365 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
1367 /* See if we've already got it, and ignore if so. */
1368 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1369 if (0 == strcmp(o_dll->name, dll_name))
1373 /* The file name has no suffix (yet) so that we can try
1374 both foo.dll and foo.drv
1376 The documentation for LoadLibrary says:
1377 If no file name extension is specified in the lpFileName
1378 parameter, the default library extension .dll is
1379 appended. However, the file name string can include a trailing
1380 point character (.) to indicate that the module name has no
1383 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
1384 sprintf(buf, "%s.DLL", dll_name);
1385 instance = LoadLibrary(buf);
1386 if (instance == NULL) {
1387 if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1388 // KAA: allow loading of drivers (like winspool.drv)
1389 sprintf(buf, "%s.DRV", dll_name);
1390 instance = LoadLibrary(buf);
1391 if (instance == NULL) {
1392 if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1393 // #1883: allow loading of unix-style libfoo.dll DLLs
1394 sprintf(buf, "lib%s.DLL", dll_name);
1395 instance = LoadLibrary(buf);
1396 if (instance == NULL) {
1403 /* Add this DLL to the list of DLLs in which to search for symbols. */
1404 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
1405 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
1406 strcpy(o_dll->name, dll_name);
1407 o_dll->instance = instance;
1408 o_dll->next = opened_dlls;
1409 opened_dlls = o_dll;
1415 sysErrorBelch(dll_name);
1417 /* LoadLibrary failed; return a ptr to the error msg. */
1418 return "addDLL: could not load DLL";
1421 barf("addDLL: not implemented on this platform");
1425 /* -----------------------------------------------------------------------------
1426 * insert a stable symbol in the hash table
1430 insertStableSymbol(char* obj_name, char* key, StgPtr p)
1432 ghciInsertStrHashTable(obj_name, stablehash, key, getStablePtr(p));
1436 /* -----------------------------------------------------------------------------
1437 * insert a symbol in the hash table
1440 insertSymbol(char* obj_name, char* key, void* data)
1442 ghciInsertStrHashTable(obj_name, symhash, key, data);
1445 /* -----------------------------------------------------------------------------
1446 * lookup a symbol in the hash table
1449 lookupSymbol( char *lbl )
1453 ASSERT(symhash != NULL);
1454 val = lookupStrHashTable(symhash, lbl);
1457 # if defined(OBJFORMAT_ELF)
1458 return dlsym(dl_prog_handle, lbl);
1459 # elif defined(OBJFORMAT_MACHO)
1461 /* On OS X 10.3 and later, we use dlsym instead of the old legacy
1464 HACK: On OS X, global symbols are prefixed with an underscore.
1465 However, dlsym wants us to omit the leading underscore from the
1466 symbol name. For now, we simply strip it off here (and ONLY
1469 ASSERT(lbl[0] == '_');
1470 return dlsym(dl_prog_handle, lbl+1);
1472 if(NSIsSymbolNameDefined(lbl)) {
1473 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
1474 return NSAddressOfSymbol(symbol);
1478 # endif /* HAVE_DLFCN_H */
1479 # elif defined(OBJFORMAT_PEi386)
1482 sym = lookupSymbolInDLLs((unsigned char*)lbl);
1483 if (sym != NULL) { return sym; };
1485 // Also try looking up the symbol without the @N suffix. Some
1486 // DLLs have the suffixes on their symbols, some don't.
1487 zapTrailingAtSign ( (unsigned char*)lbl );
1488 sym = lookupSymbolInDLLs((unsigned char*)lbl);
1489 if (sym != NULL) { return sym; };
1501 /* -----------------------------------------------------------------------------
1502 * Debugging aid: look in GHCi's object symbol tables for symbols
1503 * within DELTA bytes of the specified address, and show their names.
1506 void ghci_enquire ( char* addr );
1508 void ghci_enquire ( char* addr )
1513 const int DELTA = 64;
1518 for (oc = objects; oc; oc = oc->next) {
1519 for (i = 0; i < oc->n_symbols; i++) {
1520 sym = oc->symbols[i];
1521 if (sym == NULL) continue;
1524 a = lookupStrHashTable(symhash, sym);
1527 // debugBelch("ghci_enquire: can't find %s\n", sym);
1529 else if (addr-DELTA <= a && a <= addr+DELTA) {
1530 debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym);
1538 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1541 mmapForLinker (size_t bytes, nat flags, int fd)
1543 void *map_addr = NULL;
1546 static nat fixed = 0;
1548 pagesize = getpagesize();
1549 size = ROUND_UP(bytes, pagesize);
1551 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
1554 if (mmap_32bit_base != 0) {
1555 map_addr = mmap_32bit_base;
1559 result = mmap(map_addr, size, PROT_EXEC|PROT_READ|PROT_WRITE,
1560 MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, 0);
1562 if (result == MAP_FAILED) {
1563 sysErrorBelch("mmap %lu bytes at %p",(lnat)size,map_addr);
1564 errorBelch("Try specifying an address with +RTS -xm<addr> -RTS");
1565 stg_exit(EXIT_FAILURE);
1568 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
1569 if (mmap_32bit_base != 0) {
1570 if (result == map_addr) {
1571 mmap_32bit_base = (StgWord8*)map_addr + size;
1573 if ((W_)result > 0x80000000) {
1574 // oops, we were given memory over 2Gb
1575 #if defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS)
1576 // Some platforms require MAP_FIXED. This is normally
1577 // a bad idea, because MAP_FIXED will overwrite
1578 // existing mappings.
1579 munmap(result,size);
1583 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);
1586 // hmm, we were given memory somewhere else, but it's
1587 // still under 2Gb so we can use it. Next time, ask
1588 // for memory right after the place we just got some
1589 mmap_32bit_base = (StgWord8*)result + size;
1593 if ((W_)result > 0x80000000) {
1594 // oops, we were given memory over 2Gb
1595 // ... try allocating memory somewhere else?;
1596 debugTrace(DEBUG_linker,"MAP_32BIT didn't work; gave us %lu bytes at 0x%p", bytes, result);
1597 munmap(result, size);
1599 // Set a base address and try again... (guess: 1Gb)
1600 mmap_32bit_base = (void*)0x40000000;
1611 mkOc( char *path, char *image, int imageSize
1613 #ifdef darwin_HOST_OS
1620 oc = stgMallocBytes(sizeof(ObjectCode), "loadArchive(oc)");
1622 # if defined(OBJFORMAT_ELF)
1623 oc->formatName = "ELF";
1624 # elif defined(OBJFORMAT_PEi386)
1625 oc->formatName = "PEi386";
1626 # elif defined(OBJFORMAT_MACHO)
1627 oc->formatName = "Mach-O";
1630 barf("loadObj: not implemented on this platform");
1634 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1635 /* XXX What should this be for an archive? */
1636 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1637 strcpy(oc->fileName, path);
1639 oc->fileSize = imageSize;
1641 oc->sections = NULL;
1642 oc->proddables = NULL;
1645 #ifdef darwin_HOST_OS
1646 oc->misalignment = misalignment;
1650 /* chain it onto the list of objects */
1657 #if defined(USE_ARCHIVES_FOR_GHCI)
1659 loadArchive( char *path )
1669 f = fopen(path, "rb");
1671 barf("loadObj: can't read `%s'", path);
1673 n = fread ( tmp, 1, 8, f );
1674 if (strncmp(tmp, "!<arch>\n", 8) != 0)
1675 barf("loadArchive: Not an archive: `%s'", path);
1678 n = fread ( tmp, 1, 16, f );
1684 barf("loadArchive: Failed reading file name from `%s'", path);
1687 /* Ignore special files */
1688 if ((0 == strncmp(tmp, "/ ", 16)) ||
1689 (0 == strncmp(tmp, "// ", 16))) {
1695 n = fread ( tmp, 1, 12, f );
1697 barf("loadArchive: Failed reading mod time from `%s'", path);
1698 n = fread ( tmp, 1, 6, f );
1700 barf("loadArchive: Failed reading owner from `%s'", path);
1701 n = fread ( tmp, 1, 6, f );
1703 barf("loadArchive: Failed reading group from `%s'", path);
1704 n = fread ( tmp, 1, 8, f );
1706 barf("loadArchive: Failed reading mode from `%s'", path);
1707 n = fread ( tmp, 1, 10, f );
1709 barf("loadArchive: Failed reading size from `%s'", path);
1711 for (n = 0; isdigit(tmp[n]); n++);
1713 imageSize = atoi(tmp);
1714 n = fread ( tmp, 1, 2, f );
1715 if (strncmp(tmp, "\x60\x0A", 2) != 0)
1716 barf("loadArchive: Failed reading magic from `%s' at %ld. Got %c%c", path, ftell(f), tmp[0], tmp[1]);
1719 /* We can't mmap from the archive directly, as object
1720 files need to be 8-byte aligned but files in .ar
1721 archives are 2-byte aligned, and if we malloc the
1722 memory then we can be given memory above 2^32, so we
1723 mmap some anonymous memory and use that. We could
1725 image = mmapForLinker(imageSize, MAP_ANONYMOUS, -1);
1726 n = fread ( image, 1, imageSize, f );
1728 barf("loadObj: error whilst reading `%s'", path);
1729 oc = mkOc(path, image, imageSize
1731 #ifdef darwin_HOST_OS
1736 if (0 == loadOc(oc)) {
1741 n = fseek(f, imageSize, SEEK_CUR);
1743 barf("loadArchive: error whilst seeking to %d in `%s'",
1746 /* .ar files are 2-byte aligned */
1747 if (imageSize % 2) {
1748 n = fread ( tmp, 1, 1, f );
1754 barf("loadArchive: Failed reading padding from `%s'", path);
1765 HsInt GNU_ATTRIBUTE(__noreturn__)
1766 loadArchive( char *path STG_UNUSED ) {
1767 barf("loadArchive: not enabled");
1771 /* -----------------------------------------------------------------------------
1772 * Load an obj (populate the global symbol table, but don't resolve yet)
1774 * Returns: 1 if ok, 0 on error.
1777 loadObj( char *path )
1789 IF_DEBUG(linker, debugBelch("loadObj %s\n", path));
1793 /* debugBelch("loadObj %s\n", path ); */
1795 /* Check that we haven't already loaded this object.
1796 Ignore requests to load multiple times */
1800 for (o = objects; o; o = o->next) {
1801 if (0 == strcmp(o->fileName, path)) {
1803 break; /* don't need to search further */
1807 IF_DEBUG(linker, debugBelch(
1808 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1809 "same object file twice:\n"
1811 "GHCi will ignore this, but be warned.\n"
1813 return 1; /* success */
1817 r = stat(path, &st);
1819 IF_DEBUG(linker, debugBelch("File doesn't exist\n"));
1823 fileSize = st.st_size;
1826 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1828 #if defined(openbsd_HOST_OS)
1829 fd = open(path, O_RDONLY, S_IRUSR);
1831 fd = open(path, O_RDONLY);
1834 barf("loadObj: can't open `%s'", path);
1836 image = mmapForLinker(fileSize, 0, fd);
1840 #else /* !USE_MMAP */
1841 /* load the image into memory */
1842 f = fopen(path, "rb");
1844 barf("loadObj: can't read `%s'", path);
1846 # if defined(mingw32_HOST_OS)
1847 // TODO: We would like to use allocateExec here, but allocateExec
1848 // cannot currently allocate blocks large enough.
1849 image = VirtualAlloc(NULL, fileSize, MEM_RESERVE | MEM_COMMIT,
1850 PAGE_EXECUTE_READWRITE);
1851 # elif defined(darwin_HOST_OS)
1852 // In a Mach-O .o file, all sections can and will be misaligned
1853 // if the total size of the headers is not a multiple of the
1854 // desired alignment. This is fine for .o files that only serve
1855 // as input for the static linker, but it's not fine for us,
1856 // as SSE (used by gcc for floating point) and Altivec require
1857 // 16-byte alignment.
1858 // We calculate the correct alignment from the header before
1859 // reading the file, and then we misalign image on purpose so
1860 // that the actual sections end up aligned again.
1861 misalignment = machoGetMisalignment(f);
1862 image = stgMallocBytes(fileSize + misalignment, "loadObj(image)");
1863 image += misalignment;
1865 image = stgMallocBytes(fileSize, "loadObj(image)");
1870 n = fread ( image, 1, fileSize, f );
1872 barf("loadObj: error whilst reading `%s'", path);
1875 #endif /* USE_MMAP */
1877 oc = mkOc(path, image, fileSize
1879 #ifdef darwin_HOST_OS
1889 loadOc( ObjectCode* oc ) {
1892 # if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
1893 r = ocAllocateSymbolExtras_MachO ( oc );
1895 IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO failed\n"));
1898 # elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
1899 r = ocAllocateSymbolExtras_ELF ( oc );
1901 IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_ELF failed\n"));
1906 /* verify the in-memory image */
1907 # if defined(OBJFORMAT_ELF)
1908 r = ocVerifyImage_ELF ( oc );
1909 # elif defined(OBJFORMAT_PEi386)
1910 r = ocVerifyImage_PEi386 ( oc );
1911 # elif defined(OBJFORMAT_MACHO)
1912 r = ocVerifyImage_MachO ( oc );
1914 barf("loadObj: no verify method");
1917 IF_DEBUG(linker, debugBelch("ocVerifyImage_* failed\n"));
1921 /* build the symbol list for this image */
1922 # if defined(OBJFORMAT_ELF)
1923 r = ocGetNames_ELF ( oc );
1924 # elif defined(OBJFORMAT_PEi386)
1925 r = ocGetNames_PEi386 ( oc );
1926 # elif defined(OBJFORMAT_MACHO)
1927 r = ocGetNames_MachO ( oc );
1929 barf("loadObj: no getNames method");
1932 IF_DEBUG(linker, debugBelch("ocGetNames_* failed\n"));
1936 /* loaded, but not resolved yet */
1937 oc->status = OBJECT_LOADED;
1942 /* -----------------------------------------------------------------------------
1943 * resolve all the currently unlinked objects in memory
1945 * Returns: 1 if ok, 0 on error.
1955 for (oc = objects; oc; oc = oc->next) {
1956 if (oc->status != OBJECT_RESOLVED) {
1957 # if defined(OBJFORMAT_ELF)
1958 r = ocResolve_ELF ( oc );
1959 # elif defined(OBJFORMAT_PEi386)
1960 r = ocResolve_PEi386 ( oc );
1961 # elif defined(OBJFORMAT_MACHO)
1962 r = ocResolve_MachO ( oc );
1964 barf("resolveObjs: not implemented on this platform");
1966 if (!r) { return r; }
1967 oc->status = OBJECT_RESOLVED;
1973 /* -----------------------------------------------------------------------------
1974 * delete an object from the pool
1977 unloadObj( char *path )
1979 ObjectCode *oc, *prev;
1981 ASSERT(symhash != NULL);
1982 ASSERT(objects != NULL);
1987 for (oc = objects; oc; prev = oc, oc = oc->next) {
1988 if (!strcmp(oc->fileName,path)) {
1990 /* Remove all the mappings for the symbols within this
1995 for (i = 0; i < oc->n_symbols; i++) {
1996 if (oc->symbols[i] != NULL) {
1997 removeStrHashTable(symhash, oc->symbols[i], NULL);
2005 prev->next = oc->next;
2008 // We're going to leave this in place, in case there are
2009 // any pointers from the heap into it:
2010 // #ifdef mingw32_HOST_OS
2011 // VirtualFree(oc->image);
2013 // stgFree(oc->image);
2015 stgFree(oc->fileName);
2016 stgFree(oc->symbols);
2017 stgFree(oc->sections);
2023 errorBelch("unloadObj: can't find `%s' to unload", path);
2027 /* -----------------------------------------------------------------------------
2028 * Sanity checking. For each ObjectCode, maintain a list of address ranges
2029 * which may be prodded during relocation, and abort if we try and write
2030 * outside any of these.
2032 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
2035 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
2036 /* debugBelch("aPB %p %p %d\n", oc, start, size); */
2040 pb->next = oc->proddables;
2041 oc->proddables = pb;
2044 static void checkProddableBlock ( ObjectCode* oc, void* addr )
2047 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
2048 char* s = (char*)(pb->start);
2049 char* e = s + pb->size - 1;
2050 char* a = (char*)addr;
2051 /* Assumes that the biggest fixup involves a 4-byte write. This
2052 probably needs to be changed to 8 (ie, +7) on 64-bit
2054 if (a >= s && (a+3) <= e) return;
2056 barf("checkProddableBlock: invalid fixup in runtime linker");
2059 /* -----------------------------------------------------------------------------
2060 * Section management.
2062 static void addSection ( ObjectCode* oc, SectionKind kind,
2063 void* start, void* end )
2065 Section* s = stgMallocBytes(sizeof(Section), "addSection");
2069 s->next = oc->sections;
2072 debugBelch("addSection: %p-%p (size %d), kind %d\n",
2073 start, ((char*)end)-1, end - start + 1, kind );
2078 /* --------------------------------------------------------------------------
2080 * This is about allocating a small chunk of memory for every symbol in the
2081 * object file. We make sure that the SymboLExtras are always "in range" of
2082 * limited-range PC-relative instructions on various platforms by allocating
2083 * them right next to the object code itself.
2086 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
2089 ocAllocateSymbolExtras
2091 Allocate additional space at the end of the object file image to make room
2092 for jump islands (powerpc, x86_64) and GOT entries (x86_64).
2094 PowerPC relative branch instructions have a 24 bit displacement field.
2095 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
2096 If a particular imported symbol is outside this range, we have to redirect
2097 the jump to a short piece of new code that just loads the 32bit absolute
2098 address and jumps there.
2099 On x86_64, PC-relative jumps and PC-relative accesses to the GOT are limited
2102 This function just allocates space for one SymbolExtra for every
2103 undefined symbol in the object file. The code for the jump islands is
2104 filled in by makeSymbolExtra below.
2107 static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
2114 int misalignment = 0;
2115 #ifdef darwin_HOST_OS
2116 misalignment = oc->misalignment;
2122 // round up to the nearest 4
2123 aligned = (oc->fileSize + 3) & ~3;
2126 pagesize = getpagesize();
2127 n = ROUND_UP( oc->fileSize, pagesize );
2128 m = ROUND_UP( aligned + sizeof (SymbolExtra) * count, pagesize );
2130 /* we try to use spare space at the end of the last page of the
2131 * image for the jump islands, but if there isn't enough space
2132 * then we have to map some (anonymously, remembering MAP_32BIT).
2134 if( m > n ) // we need to allocate more pages
2136 oc->symbol_extras = mmapForLinker(sizeof(SymbolExtra) * count,
2141 oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
2144 oc->image -= misalignment;
2145 oc->image = stgReallocBytes( oc->image,
2147 aligned + sizeof (SymbolExtra) * count,
2148 "ocAllocateSymbolExtras" );
2149 oc->image += misalignment;
2151 oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
2152 #endif /* USE_MMAP */
2154 memset( oc->symbol_extras, 0, sizeof (SymbolExtra) * count );
2157 oc->symbol_extras = NULL;
2159 oc->first_symbol_extra = first;
2160 oc->n_symbol_extras = count;
2165 static SymbolExtra* makeSymbolExtra( ObjectCode* oc,
2166 unsigned long symbolNumber,
2167 unsigned long target )
2171 ASSERT( symbolNumber >= oc->first_symbol_extra
2172 && symbolNumber - oc->first_symbol_extra < oc->n_symbol_extras);
2174 extra = &oc->symbol_extras[symbolNumber - oc->first_symbol_extra];
2176 #ifdef powerpc_HOST_ARCH
2177 // lis r12, hi16(target)
2178 extra->jumpIsland.lis_r12 = 0x3d80;
2179 extra->jumpIsland.hi_addr = target >> 16;
2181 // ori r12, r12, lo16(target)
2182 extra->jumpIsland.ori_r12_r12 = 0x618c;
2183 extra->jumpIsland.lo_addr = target & 0xffff;
2186 extra->jumpIsland.mtctr_r12 = 0x7d8903a6;
2189 extra->jumpIsland.bctr = 0x4e800420;
2191 #ifdef x86_64_HOST_ARCH
2193 static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
2194 extra->addr = target;
2195 memcpy(extra->jumpIsland, jmp, 6);
2203 /* --------------------------------------------------------------------------
2204 * PowerPC specifics (instruction cache flushing)
2205 * ------------------------------------------------------------------------*/
2207 #ifdef powerpc_HOST_ARCH
2209 ocFlushInstructionCache
2211 Flush the data & instruction caches.
2212 Because the PPC has split data/instruction caches, we have to
2213 do that whenever we modify code at runtime.
2216 static void ocFlushInstructionCache( ObjectCode *oc )
2218 int n = (oc->fileSize + sizeof( SymbolExtra ) * oc->n_symbol_extras + 3) / 4;
2219 unsigned long *p = (unsigned long *) oc->image;
2223 __asm__ volatile ( "dcbf 0,%0\n\t"
2231 __asm__ volatile ( "sync\n\t"
2237 /* --------------------------------------------------------------------------
2238 * PEi386 specifics (Win32 targets)
2239 * ------------------------------------------------------------------------*/
2241 /* The information for this linker comes from
2242 Microsoft Portable Executable
2243 and Common Object File Format Specification
2244 revision 5.1 January 1998
2245 which SimonM says comes from the MS Developer Network CDs.
2247 It can be found there (on older CDs), but can also be found
2250 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
2252 (this is Rev 6.0 from February 1999).
2254 Things move, so if that fails, try searching for it via
2256 http://www.google.com/search?q=PE+COFF+specification
2258 The ultimate reference for the PE format is the Winnt.h
2259 header file that comes with the Platform SDKs; as always,
2260 implementations will drift wrt their documentation.
2262 A good background article on the PE format is Matt Pietrek's
2263 March 1994 article in Microsoft System Journal (MSJ)
2264 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
2265 Win32 Portable Executable File Format." The info in there
2266 has recently been updated in a two part article in
2267 MSDN magazine, issues Feb and March 2002,
2268 "Inside Windows: An In-Depth Look into the Win32 Portable
2269 Executable File Format"
2271 John Levine's book "Linkers and Loaders" contains useful
2276 #if defined(OBJFORMAT_PEi386)
2280 typedef unsigned char UChar;
2281 typedef unsigned short UInt16;
2282 typedef unsigned int UInt32;
2289 UInt16 NumberOfSections;
2290 UInt32 TimeDateStamp;
2291 UInt32 PointerToSymbolTable;
2292 UInt32 NumberOfSymbols;
2293 UInt16 SizeOfOptionalHeader;
2294 UInt16 Characteristics;
2298 #define sizeof_COFF_header 20
2305 UInt32 VirtualAddress;
2306 UInt32 SizeOfRawData;
2307 UInt32 PointerToRawData;
2308 UInt32 PointerToRelocations;
2309 UInt32 PointerToLinenumbers;
2310 UInt16 NumberOfRelocations;
2311 UInt16 NumberOfLineNumbers;
2312 UInt32 Characteristics;
2316 #define sizeof_COFF_section 40
2323 UInt16 SectionNumber;
2326 UChar NumberOfAuxSymbols;
2330 #define sizeof_COFF_symbol 18
2335 UInt32 VirtualAddress;
2336 UInt32 SymbolTableIndex;
2341 #define sizeof_COFF_reloc 10
2344 /* From PE spec doc, section 3.3.2 */
2345 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
2346 windows.h -- for the same purpose, but I want to know what I'm
2348 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
2349 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
2350 #define MYIMAGE_FILE_DLL 0x2000
2351 #define MYIMAGE_FILE_SYSTEM 0x1000
2352 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
2353 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
2354 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
2356 /* From PE spec doc, section 5.4.2 and 5.4.4 */
2357 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
2358 #define MYIMAGE_SYM_CLASS_STATIC 3
2359 #define MYIMAGE_SYM_UNDEFINED 0
2361 /* From PE spec doc, section 4.1 */
2362 #define MYIMAGE_SCN_CNT_CODE 0x00000020
2363 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
2364 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
2366 /* From PE spec doc, section 5.2.1 */
2367 #define MYIMAGE_REL_I386_DIR32 0x0006
2368 #define MYIMAGE_REL_I386_REL32 0x0014
2371 /* We use myindex to calculate array addresses, rather than
2372 simply doing the normal subscript thing. That's because
2373 some of the above structs have sizes which are not
2374 a whole number of words. GCC rounds their sizes up to a
2375 whole number of words, which means that the address calcs
2376 arising from using normal C indexing or pointer arithmetic
2377 are just plain wrong. Sigh.
2380 myindex ( int scale, void* base, int index )
2383 ((UChar*)base) + scale * index;
2388 printName ( UChar* name, UChar* strtab )
2390 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2391 UInt32 strtab_offset = * (UInt32*)(name+4);
2392 debugBelch("%s", strtab + strtab_offset );
2395 for (i = 0; i < 8; i++) {
2396 if (name[i] == 0) break;
2397 debugBelch("%c", name[i] );
2404 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
2406 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2407 UInt32 strtab_offset = * (UInt32*)(name+4);
2408 strncpy ( (char*)dst, (char*)strtab+strtab_offset, dstSize );
2414 if (name[i] == 0) break;
2424 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
2427 /* If the string is longer than 8 bytes, look in the
2428 string table for it -- this will be correctly zero terminated.
2430 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2431 UInt32 strtab_offset = * (UInt32*)(name+4);
2432 return ((UChar*)strtab) + strtab_offset;
2434 /* Otherwise, if shorter than 8 bytes, return the original,
2435 which by defn is correctly terminated.
2437 if (name[7]==0) return name;
2438 /* The annoying case: 8 bytes. Copy into a temporary
2439 (XXX which is never freed ...)
2441 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
2443 strncpy((char*)newstr,(char*)name,8);
2448 /* Getting the name of a section is mildly tricky, so we make a
2449 function for it. Sadly, in one case we have to copy the string
2450 (when it is exactly 8 bytes long there's no trailing '\0'), so for
2451 consistency we *always* copy the string; the caller must free it
2454 cstring_from_section_name (UChar* name, UChar* strtab)
2459 int strtab_offset = strtol((char*)name+1,NULL,10);
2460 int len = strlen(((char*)strtab) + strtab_offset);
2462 newstr = stgMallocBytes(len, "cstring_from_section_symbol_name");
2463 strcpy((char*)newstr, (char*)((UChar*)strtab) + strtab_offset);
2468 newstr = stgMallocBytes(9, "cstring_from_section_symbol_name");
2470 strncpy((char*)newstr,(char*)name,8);
2476 /* Just compares the short names (first 8 chars) */
2477 static COFF_section *
2478 findPEi386SectionCalled ( ObjectCode* oc, UChar* name )
2482 = (COFF_header*)(oc->image);
2483 COFF_section* sectab
2485 ((UChar*)(oc->image))
2486 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2488 for (i = 0; i < hdr->NumberOfSections; i++) {
2491 COFF_section* section_i
2493 myindex ( sizeof_COFF_section, sectab, i );
2494 n1 = (UChar*) &(section_i->Name);
2496 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
2497 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
2498 n1[6]==n2[6] && n1[7]==n2[7])
2507 zapTrailingAtSign ( UChar* sym )
2509 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
2511 if (sym[0] == 0) return;
2513 while (sym[i] != 0) i++;
2516 while (j > 0 && my_isdigit(sym[j])) j--;
2517 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
2522 lookupSymbolInDLLs ( UChar *lbl )
2527 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
2528 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
2530 if (lbl[0] == '_') {
2531 /* HACK: if the name has an initial underscore, try stripping
2532 it off & look that up first. I've yet to verify whether there's
2533 a Rule that governs whether an initial '_' *should always* be
2534 stripped off when mapping from import lib name to the DLL name.
2536 sym = GetProcAddress(o_dll->instance, (char*)(lbl+1));
2538 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
2542 sym = GetProcAddress(o_dll->instance, (char*)lbl);
2544 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
2553 ocVerifyImage_PEi386 ( ObjectCode* oc )
2558 COFF_section* sectab;
2559 COFF_symbol* symtab;
2561 /* debugBelch("\nLOADING %s\n", oc->fileName); */
2562 hdr = (COFF_header*)(oc->image);
2563 sectab = (COFF_section*) (
2564 ((UChar*)(oc->image))
2565 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2567 symtab = (COFF_symbol*) (
2568 ((UChar*)(oc->image))
2569 + hdr->PointerToSymbolTable
2571 strtab = ((UChar*)symtab)
2572 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2574 if (hdr->Machine != 0x14c) {
2575 errorBelch("%s: Not x86 PEi386", oc->fileName);
2578 if (hdr->SizeOfOptionalHeader != 0) {
2579 errorBelch("%s: PEi386 with nonempty optional header", oc->fileName);
2582 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
2583 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
2584 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
2585 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
2586 errorBelch("%s: Not a PEi386 object file", oc->fileName);
2589 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
2590 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
2591 errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
2593 (int)(hdr->Characteristics));
2596 /* If the string table size is way crazy, this might indicate that
2597 there are more than 64k relocations, despite claims to the
2598 contrary. Hence this test. */
2599 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
2601 if ( (*(UInt32*)strtab) > 600000 ) {
2602 /* Note that 600k has no special significance other than being
2603 big enough to handle the almost-2MB-sized lumps that
2604 constitute HSwin32*.o. */
2605 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
2610 /* No further verification after this point; only debug printing. */
2612 IF_DEBUG(linker, i=1);
2613 if (i == 0) return 1;
2615 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
2616 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
2617 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
2620 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
2621 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
2622 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
2623 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
2624 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
2625 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
2626 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
2628 /* Print the section table. */
2630 for (i = 0; i < hdr->NumberOfSections; i++) {
2632 COFF_section* sectab_i
2634 myindex ( sizeof_COFF_section, sectab, i );
2641 printName ( sectab_i->Name, strtab );
2651 sectab_i->VirtualSize,
2652 sectab_i->VirtualAddress,
2653 sectab_i->SizeOfRawData,
2654 sectab_i->PointerToRawData,
2655 sectab_i->NumberOfRelocations,
2656 sectab_i->PointerToRelocations,
2657 sectab_i->PointerToRawData
2659 reltab = (COFF_reloc*) (
2660 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2663 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2664 /* If the relocation field (a short) has overflowed, the
2665 * real count can be found in the first reloc entry.
2667 * See Section 4.1 (last para) of the PE spec (rev6.0).
2669 COFF_reloc* rel = (COFF_reloc*)
2670 myindex ( sizeof_COFF_reloc, reltab, 0 );
2671 noRelocs = rel->VirtualAddress;
2674 noRelocs = sectab_i->NumberOfRelocations;
2678 for (; j < noRelocs; j++) {
2680 COFF_reloc* rel = (COFF_reloc*)
2681 myindex ( sizeof_COFF_reloc, reltab, j );
2683 " type 0x%-4x vaddr 0x%-8x name `",
2685 rel->VirtualAddress );
2686 sym = (COFF_symbol*)
2687 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
2688 /* Hmm..mysterious looking offset - what's it for? SOF */
2689 printName ( sym->Name, strtab -10 );
2696 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
2697 debugBelch("---START of string table---\n");
2698 for (i = 4; i < *(Int32*)strtab; i++) {
2700 debugBelch("\n"); else
2701 debugBelch("%c", strtab[i] );
2703 debugBelch("--- END of string table---\n");
2708 COFF_symbol* symtab_i;
2709 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2710 symtab_i = (COFF_symbol*)
2711 myindex ( sizeof_COFF_symbol, symtab, i );
2717 printName ( symtab_i->Name, strtab );
2726 (Int32)(symtab_i->SectionNumber),
2727 (UInt32)symtab_i->Type,
2728 (UInt32)symtab_i->StorageClass,
2729 (UInt32)symtab_i->NumberOfAuxSymbols
2731 i += symtab_i->NumberOfAuxSymbols;
2741 ocGetNames_PEi386 ( ObjectCode* oc )
2744 COFF_section* sectab;
2745 COFF_symbol* symtab;
2752 hdr = (COFF_header*)(oc->image);
2753 sectab = (COFF_section*) (
2754 ((UChar*)(oc->image))
2755 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2757 symtab = (COFF_symbol*) (
2758 ((UChar*)(oc->image))
2759 + hdr->PointerToSymbolTable
2761 strtab = ((UChar*)(oc->image))
2762 + hdr->PointerToSymbolTable
2763 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2765 /* Allocate space for any (local, anonymous) .bss sections. */
2767 for (i = 0; i < hdr->NumberOfSections; i++) {
2770 COFF_section* sectab_i
2772 myindex ( sizeof_COFF_section, sectab, i );
2774 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
2776 if (0 != strcmp(secname, ".bss")) {
2783 /* sof 10/05: the PE spec text isn't too clear regarding what
2784 * the SizeOfRawData field is supposed to hold for object
2785 * file sections containing just uninitialized data -- for executables,
2786 * it is supposed to be zero; unclear what it's supposed to be
2787 * for object files. However, VirtualSize is guaranteed to be
2788 * zero for object files, which definitely suggests that SizeOfRawData
2789 * will be non-zero (where else would the size of this .bss section be
2790 * stored?) Looking at the COFF_section info for incoming object files,
2791 * this certainly appears to be the case.
2793 * => I suspect we've been incorrectly handling .bss sections in (relocatable)
2794 * object files up until now. This turned out to bite us with ghc-6.4.1's use
2795 * of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
2796 * variable decls into to the .bss section. (The specific function in Q which
2797 * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
2799 if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
2800 /* This is a non-empty .bss section. Allocate zeroed space for
2801 it, and set its PointerToRawData field such that oc->image +
2802 PointerToRawData == addr_of_zeroed_space. */
2803 bss_sz = sectab_i->VirtualSize;
2804 if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
2805 zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
2806 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
2807 addProddableBlock(oc, zspace, bss_sz);
2808 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
2811 /* Copy section information into the ObjectCode. */
2813 for (i = 0; i < hdr->NumberOfSections; i++) {
2819 = SECTIONKIND_OTHER;
2820 COFF_section* sectab_i
2822 myindex ( sizeof_COFF_section, sectab, i );
2824 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
2826 IF_DEBUG(linker, debugBelch("section name = %s\n", secname ));
2829 /* I'm sure this is the Right Way to do it. However, the
2830 alternative of testing the sectab_i->Name field seems to
2831 work ok with Cygwin.
2833 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
2834 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
2835 kind = SECTIONKIND_CODE_OR_RODATA;
2838 if (0==strcmp(".text",(char*)secname) ||
2839 0==strcmp(".rdata",(char*)secname)||
2840 0==strcmp(".rodata",(char*)secname))
2841 kind = SECTIONKIND_CODE_OR_RODATA;
2842 if (0==strcmp(".data",(char*)secname) ||
2843 0==strcmp(".bss",(char*)secname))
2844 kind = SECTIONKIND_RWDATA;
2846 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
2847 sz = sectab_i->SizeOfRawData;
2848 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
2850 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
2851 end = start + sz - 1;
2853 if (kind == SECTIONKIND_OTHER
2854 /* Ignore sections called which contain stabs debugging
2856 && 0 != strcmp(".stab", (char*)secname)
2857 && 0 != strcmp(".stabstr", (char*)secname)
2858 /* ignore constructor section for now */
2859 && 0 != strcmp(".ctors", (char*)secname)
2860 /* ignore section generated from .ident */
2861 && 0!= strncmp(".debug", (char*)secname, 6)
2862 /* ignore unknown section that appeared in gcc 3.4.5(?) */
2863 && 0!= strcmp(".reloc", (char*)secname)
2864 && 0 != strcmp(".rdata$zzz", (char*)secname)
2866 errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", secname, oc->fileName);
2871 if (kind != SECTIONKIND_OTHER && end >= start) {
2872 addSection(oc, kind, start, end);
2873 addProddableBlock(oc, start, end - start + 1);
2879 /* Copy exported symbols into the ObjectCode. */
2881 oc->n_symbols = hdr->NumberOfSymbols;
2882 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2883 "ocGetNames_PEi386(oc->symbols)");
2884 /* Call me paranoid; I don't care. */
2885 for (i = 0; i < oc->n_symbols; i++)
2886 oc->symbols[i] = NULL;
2890 COFF_symbol* symtab_i;
2891 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2892 symtab_i = (COFF_symbol*)
2893 myindex ( sizeof_COFF_symbol, symtab, i );
2897 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
2898 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
2899 /* This symbol is global and defined, viz, exported */
2900 /* for MYIMAGE_SYMCLASS_EXTERNAL
2901 && !MYIMAGE_SYM_UNDEFINED,
2902 the address of the symbol is:
2903 address of relevant section + offset in section
2905 COFF_section* sectabent
2906 = (COFF_section*) myindex ( sizeof_COFF_section,
2908 symtab_i->SectionNumber-1 );
2909 addr = ((UChar*)(oc->image))
2910 + (sectabent->PointerToRawData
2914 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
2915 && symtab_i->Value > 0) {
2916 /* This symbol isn't in any section at all, ie, global bss.
2917 Allocate zeroed space for it. */
2918 addr = stgCallocBytes(1, symtab_i->Value,
2919 "ocGetNames_PEi386(non-anonymous bss)");
2920 addSection(oc, SECTIONKIND_RWDATA, addr,
2921 ((UChar*)addr) + symtab_i->Value - 1);
2922 addProddableBlock(oc, addr, symtab_i->Value);
2923 /* debugBelch("BSS section at 0x%x\n", addr); */
2926 if (addr != NULL ) {
2927 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
2928 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
2929 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
2930 ASSERT(i >= 0 && i < oc->n_symbols);
2931 /* cstring_from_COFF_symbol_name always succeeds. */
2932 oc->symbols[i] = (char*)sname;
2933 ghciInsertStrHashTable(oc->fileName, symhash, (char*)sname, addr);
2937 "IGNORING symbol %d\n"
2941 printName ( symtab_i->Name, strtab );
2950 (Int32)(symtab_i->SectionNumber),
2951 (UInt32)symtab_i->Type,
2952 (UInt32)symtab_i->StorageClass,
2953 (UInt32)symtab_i->NumberOfAuxSymbols
2958 i += symtab_i->NumberOfAuxSymbols;
2967 ocResolve_PEi386 ( ObjectCode* oc )
2970 COFF_section* sectab;
2971 COFF_symbol* symtab;
2981 /* ToDo: should be variable-sized? But is at least safe in the
2982 sense of buffer-overrun-proof. */
2984 /* debugBelch("resolving for %s\n", oc->fileName); */
2986 hdr = (COFF_header*)(oc->image);
2987 sectab = (COFF_section*) (
2988 ((UChar*)(oc->image))
2989 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2991 symtab = (COFF_symbol*) (
2992 ((UChar*)(oc->image))
2993 + hdr->PointerToSymbolTable
2995 strtab = ((UChar*)(oc->image))
2996 + hdr->PointerToSymbolTable
2997 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2999 for (i = 0; i < hdr->NumberOfSections; i++) {
3000 COFF_section* sectab_i
3002 myindex ( sizeof_COFF_section, sectab, i );
3005 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
3008 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
3010 /* Ignore sections called which contain stabs debugging
3012 if (0 == strcmp(".stab", (char*)secname)
3013 || 0 == strcmp(".stabstr", (char*)secname)
3014 || 0 == strcmp(".ctors", (char*)secname)
3015 || 0 == strncmp(".debug", (char*)secname, 6)
3016 || 0 == strcmp(".rdata$zzz", (char*)secname)) {
3023 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
3024 /* If the relocation field (a short) has overflowed, the
3025 * real count can be found in the first reloc entry.
3027 * See Section 4.1 (last para) of the PE spec (rev6.0).
3029 * Nov2003 update: the GNU linker still doesn't correctly
3030 * handle the generation of relocatable object files with
3031 * overflown relocations. Hence the output to warn of potential
3034 COFF_reloc* rel = (COFF_reloc*)
3035 myindex ( sizeof_COFF_reloc, reltab, 0 );
3036 noRelocs = rel->VirtualAddress;
3038 /* 10/05: we now assume (and check for) a GNU ld that is capable
3039 * of handling object files with (>2^16) of relocs.
3042 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
3047 noRelocs = sectab_i->NumberOfRelocations;
3052 for (; j < noRelocs; j++) {
3054 COFF_reloc* reltab_j
3056 myindex ( sizeof_COFF_reloc, reltab, j );
3058 /* the location to patch */
3060 ((UChar*)(oc->image))
3061 + (sectab_i->PointerToRawData
3062 + reltab_j->VirtualAddress
3063 - sectab_i->VirtualAddress )
3065 /* the existing contents of pP */
3067 /* the symbol to connect to */
3068 sym = (COFF_symbol*)
3069 myindex ( sizeof_COFF_symbol,
3070 symtab, reltab_j->SymbolTableIndex );
3073 "reloc sec %2d num %3d: type 0x%-4x "
3074 "vaddr 0x%-8x name `",
3076 (UInt32)reltab_j->Type,
3077 reltab_j->VirtualAddress );
3078 printName ( sym->Name, strtab );
3079 debugBelch("'\n" ));
3081 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
3082 COFF_section* section_sym
3083 = findPEi386SectionCalled ( oc, sym->Name );
3085 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
3088 S = ((UInt32)(oc->image))
3089 + (section_sym->PointerToRawData
3092 copyName ( sym->Name, strtab, symbol, 1000-1 );
3093 S = (UInt32) lookupSymbol( (char*)symbol );
3094 if ((void*)S != NULL) goto foundit;
3095 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3099 checkProddableBlock(oc, pP);
3100 switch (reltab_j->Type) {
3101 case MYIMAGE_REL_I386_DIR32:
3104 case MYIMAGE_REL_I386_REL32:
3105 /* Tricky. We have to insert a displacement at
3106 pP which, when added to the PC for the _next_
3107 insn, gives the address of the target (S).
3108 Problem is to know the address of the next insn
3109 when we only know pP. We assume that this
3110 literal field is always the last in the insn,
3111 so that the address of the next insn is pP+4
3112 -- hence the constant 4.
3113 Also I don't know if A should be added, but so
3114 far it has always been zero.
3116 SOF 05/2005: 'A' (old contents of *pP) have been observed
3117 to contain values other than zero (the 'wx' object file
3118 that came with wxhaskell-0.9.4; dunno how it was compiled..).
3119 So, add displacement to old value instead of asserting
3120 A to be zero. Fixes wxhaskell-related crashes, and no other
3121 ill effects have been observed.
3123 Update: the reason why we're seeing these more elaborate
3124 relocations is due to a switch in how the NCG compiles SRTs
3125 and offsets to them from info tables. SRTs live in .(ro)data,
3126 while info tables live in .text, causing GAS to emit REL32/DISP32
3127 relocations with non-zero values. Adding the displacement is
3128 the right thing to do.
3130 *pP = S - ((UInt32)pP) - 4 + A;
3133 debugBelch("%s: unhandled PEi386 relocation type %d",
3134 oc->fileName, reltab_j->Type);
3141 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
3145 #endif /* defined(OBJFORMAT_PEi386) */
3148 /* --------------------------------------------------------------------------
3150 * ------------------------------------------------------------------------*/
3152 #if defined(OBJFORMAT_ELF)
3157 #if defined(sparc_HOST_ARCH)
3158 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
3159 #elif defined(i386_HOST_ARCH)
3160 # define ELF_TARGET_386 /* Used inside <elf.h> */
3161 #elif defined(x86_64_HOST_ARCH)
3162 # define ELF_TARGET_X64_64
3166 #if !defined(openbsd_HOST_OS)
3169 /* openbsd elf has things in different places, with diff names */
3170 # include <elf_abi.h>
3171 # include <machine/reloc.h>
3172 # define R_386_32 RELOC_32
3173 # define R_386_PC32 RELOC_PC32
3176 /* If elf.h doesn't define it */
3177 # ifndef R_X86_64_PC64
3178 # define R_X86_64_PC64 24
3182 * Define a set of types which can be used for both ELF32 and ELF64
3186 #define ELFCLASS ELFCLASS64
3187 #define Elf_Addr Elf64_Addr
3188 #define Elf_Word Elf64_Word
3189 #define Elf_Sword Elf64_Sword
3190 #define Elf_Ehdr Elf64_Ehdr
3191 #define Elf_Phdr Elf64_Phdr
3192 #define Elf_Shdr Elf64_Shdr
3193 #define Elf_Sym Elf64_Sym
3194 #define Elf_Rel Elf64_Rel
3195 #define Elf_Rela Elf64_Rela
3197 #define ELF_ST_TYPE ELF64_ST_TYPE
3200 #define ELF_ST_BIND ELF64_ST_BIND
3203 #define ELF_R_TYPE ELF64_R_TYPE
3206 #define ELF_R_SYM ELF64_R_SYM
3209 #define ELFCLASS ELFCLASS32
3210 #define Elf_Addr Elf32_Addr
3211 #define Elf_Word Elf32_Word
3212 #define Elf_Sword Elf32_Sword
3213 #define Elf_Ehdr Elf32_Ehdr
3214 #define Elf_Phdr Elf32_Phdr
3215 #define Elf_Shdr Elf32_Shdr
3216 #define Elf_Sym Elf32_Sym
3217 #define Elf_Rel Elf32_Rel
3218 #define Elf_Rela Elf32_Rela
3220 #define ELF_ST_TYPE ELF32_ST_TYPE
3223 #define ELF_ST_BIND ELF32_ST_BIND
3226 #define ELF_R_TYPE ELF32_R_TYPE
3229 #define ELF_R_SYM ELF32_R_SYM
3235 * Functions to allocate entries in dynamic sections. Currently we simply
3236 * preallocate a large number, and we don't check if a entry for the given
3237 * target already exists (a linear search is too slow). Ideally these
3238 * entries would be associated with symbols.
3241 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
3242 #define GOT_SIZE 0x20000
3243 #define FUNCTION_TABLE_SIZE 0x10000
3244 #define PLT_SIZE 0x08000
3247 static Elf_Addr got[GOT_SIZE];
3248 static unsigned int gotIndex;
3249 static Elf_Addr gp_val = (Elf_Addr)got;
3252 allocateGOTEntry(Elf_Addr target)
3256 if (gotIndex >= GOT_SIZE)
3257 barf("Global offset table overflow");
3259 entry = &got[gotIndex++];
3261 return (Elf_Addr)entry;
3265 #ifdef ELF_FUNCTION_DESC
3271 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
3272 static unsigned int functionTableIndex;
3275 allocateFunctionDesc(Elf_Addr target)
3277 FunctionDesc *entry;
3279 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
3280 barf("Function table overflow");
3282 entry = &functionTable[functionTableIndex++];
3284 entry->gp = (Elf_Addr)gp_val;
3285 return (Elf_Addr)entry;
3289 copyFunctionDesc(Elf_Addr target)
3291 FunctionDesc *olddesc = (FunctionDesc *)target;
3292 FunctionDesc *newdesc;
3294 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
3295 newdesc->gp = olddesc->gp;
3296 return (Elf_Addr)newdesc;
3303 unsigned char code[sizeof(plt_code)];
3307 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
3309 PLTEntry *plt = (PLTEntry *)oc->plt;
3312 if (oc->pltIndex >= PLT_SIZE)
3313 barf("Procedure table overflow");
3315 entry = &plt[oc->pltIndex++];
3316 memcpy(entry->code, plt_code, sizeof(entry->code));
3317 PLT_RELOC(entry->code, target);
3318 return (Elf_Addr)entry;
3324 return (PLT_SIZE * sizeof(PLTEntry));
3330 * Generic ELF functions
3334 findElfSection ( void* objImage, Elf_Word sh_type )
3336 char* ehdrC = (char*)objImage;
3337 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3338 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
3339 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
3343 for (i = 0; i < ehdr->e_shnum; i++) {
3344 if (shdr[i].sh_type == sh_type
3345 /* Ignore the section header's string table. */
3346 && i != ehdr->e_shstrndx
3347 /* Ignore string tables named .stabstr, as they contain
3349 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
3351 ptr = ehdrC + shdr[i].sh_offset;
3359 ocVerifyImage_ELF ( ObjectCode* oc )
3363 int i, j, nent, nstrtab, nsymtabs;
3367 char* ehdrC = (char*)(oc->image);
3368 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3370 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
3371 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
3372 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
3373 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
3374 errorBelch("%s: not an ELF object", oc->fileName);
3378 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
3379 errorBelch("%s: unsupported ELF format", oc->fileName);
3383 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
3384 IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
3386 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
3387 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
3389 errorBelch("%s: unknown endiannness", oc->fileName);
3393 if (ehdr->e_type != ET_REL) {
3394 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
3397 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
3399 IF_DEBUG(linker,debugBelch( "Architecture is " ));
3400 switch (ehdr->e_machine) {
3401 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
3402 #ifdef EM_SPARC32PLUS
3403 case EM_SPARC32PLUS:
3405 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
3407 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
3409 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
3411 case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
3412 #elif defined(EM_AMD64)
3413 case EM_AMD64: IF_DEBUG(linker,debugBelch( "amd64" )); break;
3415 default: IF_DEBUG(linker,debugBelch( "unknown" ));
3416 errorBelch("%s: unknown architecture (e_machine == %d)"
3417 , oc->fileName, ehdr->e_machine);
3421 IF_DEBUG(linker,debugBelch(
3422 "\nSection header table: start %ld, n_entries %d, ent_size %d\n",
3423 (long)ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
3425 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
3427 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3429 if (ehdr->e_shstrndx == SHN_UNDEF) {
3430 errorBelch("%s: no section header string table", oc->fileName);
3433 IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
3435 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
3438 for (i = 0; i < ehdr->e_shnum; i++) {
3439 IF_DEBUG(linker,debugBelch("%2d: ", i ));
3440 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
3441 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
3442 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
3443 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
3444 ehdrC + shdr[i].sh_offset,
3445 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
3447 if (shdr[i].sh_type == SHT_REL) {
3448 IF_DEBUG(linker,debugBelch("Rel " ));
3449 } else if (shdr[i].sh_type == SHT_RELA) {
3450 IF_DEBUG(linker,debugBelch("RelA " ));
3452 IF_DEBUG(linker,debugBelch(" "));
3455 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
3459 IF_DEBUG(linker,debugBelch( "\nString tables" ));
3462 for (i = 0; i < ehdr->e_shnum; i++) {
3463 if (shdr[i].sh_type == SHT_STRTAB
3464 /* Ignore the section header's string table. */
3465 && i != ehdr->e_shstrndx
3466 /* Ignore string tables named .stabstr, as they contain
3468 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
3470 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
3471 strtab = ehdrC + shdr[i].sh_offset;
3476 errorBelch("%s: no string tables, or too many", oc->fileName);
3481 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
3482 for (i = 0; i < ehdr->e_shnum; i++) {
3483 if (shdr[i].sh_type != SHT_SYMTAB) continue;
3484 IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
3486 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
3487 nent = shdr[i].sh_size / sizeof(Elf_Sym);
3488 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%ld rem)\n",
3490 (long)shdr[i].sh_size % sizeof(Elf_Sym)
3492 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
3493 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
3496 for (j = 0; j < nent; j++) {
3497 IF_DEBUG(linker,debugBelch(" %2d ", j ));
3498 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
3499 (int)stab[j].st_shndx,
3500 (int)stab[j].st_size,
3501 (char*)stab[j].st_value ));
3503 IF_DEBUG(linker,debugBelch("type=" ));
3504 switch (ELF_ST_TYPE(stab[j].st_info)) {
3505 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
3506 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
3507 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
3508 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
3509 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
3510 default: IF_DEBUG(linker,debugBelch("? " )); break;
3512 IF_DEBUG(linker,debugBelch(" " ));
3514 IF_DEBUG(linker,debugBelch("bind=" ));
3515 switch (ELF_ST_BIND(stab[j].st_info)) {
3516 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
3517 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
3518 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
3519 default: IF_DEBUG(linker,debugBelch("? " )); break;
3521 IF_DEBUG(linker,debugBelch(" " ));
3523 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
3527 if (nsymtabs == 0) {
3528 errorBelch("%s: didn't find any symbol tables", oc->fileName);
3535 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
3539 if (hdr->sh_type == SHT_PROGBITS
3540 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
3541 /* .text-style section */
3542 return SECTIONKIND_CODE_OR_RODATA;
3545 if (hdr->sh_type == SHT_PROGBITS
3546 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3547 /* .data-style section */
3548 return SECTIONKIND_RWDATA;
3551 if (hdr->sh_type == SHT_PROGBITS
3552 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
3553 /* .rodata-style section */
3554 return SECTIONKIND_CODE_OR_RODATA;
3557 if (hdr->sh_type == SHT_NOBITS
3558 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3559 /* .bss-style section */
3561 return SECTIONKIND_RWDATA;
3564 return SECTIONKIND_OTHER;
3569 ocGetNames_ELF ( ObjectCode* oc )
3574 char* ehdrC = (char*)(oc->image);
3575 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3576 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
3577 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3579 ASSERT(symhash != NULL);
3582 errorBelch("%s: no strtab", oc->fileName);
3587 for (i = 0; i < ehdr->e_shnum; i++) {
3588 /* Figure out what kind of section it is. Logic derived from
3589 Figure 1.14 ("Special Sections") of the ELF document
3590 ("Portable Formats Specification, Version 1.1"). */
3592 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
3594 if (is_bss && shdr[i].sh_size > 0) {
3595 /* This is a non-empty .bss section. Allocate zeroed space for
3596 it, and set its .sh_offset field such that
3597 ehdrC + .sh_offset == addr_of_zeroed_space. */
3598 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
3599 "ocGetNames_ELF(BSS)");
3600 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
3602 debugBelch("BSS section at 0x%x, size %d\n",
3603 zspace, shdr[i].sh_size);
3607 /* fill in the section info */
3608 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
3609 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
3610 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
3611 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
3614 if (shdr[i].sh_type != SHT_SYMTAB) continue;
3616 /* copy stuff into this module's object symbol table */
3617 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
3618 nent = shdr[i].sh_size / sizeof(Elf_Sym);
3620 oc->n_symbols = nent;
3621 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3622 "ocGetNames_ELF(oc->symbols)");
3624 for (j = 0; j < nent; j++) {
3626 char isLocal = FALSE; /* avoids uninit-var warning */
3628 char* nm = strtab + stab[j].st_name;
3629 int secno = stab[j].st_shndx;
3631 /* Figure out if we want to add it; if so, set ad to its
3632 address. Otherwise leave ad == NULL. */
3634 if (secno == SHN_COMMON) {
3636 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
3638 debugBelch("COMMON symbol, size %d name %s\n",
3639 stab[j].st_size, nm);
3641 /* Pointless to do addProddableBlock() for this area,
3642 since the linker should never poke around in it. */
3645 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
3646 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
3648 /* and not an undefined symbol */
3649 && stab[j].st_shndx != SHN_UNDEF
3650 /* and not in a "special section" */
3651 && stab[j].st_shndx < SHN_LORESERVE
3653 /* and it's a not a section or string table or anything silly */
3654 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
3655 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
3656 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
3659 /* Section 0 is the undefined section, hence > and not >=. */
3660 ASSERT(secno > 0 && secno < ehdr->e_shnum);
3662 if (shdr[secno].sh_type == SHT_NOBITS) {
3663 debugBelch(" BSS symbol, size %d off %d name %s\n",
3664 stab[j].st_size, stab[j].st_value, nm);
3667 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
3668 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
3671 #ifdef ELF_FUNCTION_DESC
3672 /* dlsym() and the initialisation table both give us function
3673 * descriptors, so to be consistent we store function descriptors
3674 * in the symbol table */
3675 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
3676 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
3678 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s\n",
3679 ad, oc->fileName, nm ));
3684 /* And the decision is ... */
3688 oc->symbols[j] = nm;
3691 /* Ignore entirely. */
3693 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
3697 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
3698 strtab + stab[j].st_name ));
3701 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
3702 (int)ELF_ST_BIND(stab[j].st_info),
3703 (int)ELF_ST_TYPE(stab[j].st_info),
3704 (int)stab[j].st_shndx,
3705 strtab + stab[j].st_name
3708 oc->symbols[j] = NULL;
3717 /* Do ELF relocations which lack an explicit addend. All x86-linux
3718 relocations appear to be of this form. */
3720 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
3721 Elf_Shdr* shdr, int shnum,
3722 Elf_Sym* stab, char* strtab )
3727 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
3728 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
3729 int target_shndx = shdr[shnum].sh_info;
3730 int symtab_shndx = shdr[shnum].sh_link;
3732 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3733 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
3734 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3735 target_shndx, symtab_shndx ));
3737 /* Skip sections that we're not interested in. */
3740 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
3741 if (kind == SECTIONKIND_OTHER) {
3742 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
3747 for (j = 0; j < nent; j++) {
3748 Elf_Addr offset = rtab[j].r_offset;
3749 Elf_Addr info = rtab[j].r_info;
3751 Elf_Addr P = ((Elf_Addr)targ) + offset;
3752 Elf_Word* pP = (Elf_Word*)P;
3757 StgStablePtr stablePtr;
3760 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
3761 j, (void*)offset, (void*)info ));
3763 IF_DEBUG(linker,debugBelch( " ZERO" ));
3766 Elf_Sym sym = stab[ELF_R_SYM(info)];
3767 /* First see if it is a local symbol. */
3768 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3769 /* Yes, so we can get the address directly from the ELF symbol
3771 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3773 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3774 + stab[ELF_R_SYM(info)].st_value);
3777 symbol = strtab + sym.st_name;
3778 stablePtr = (StgStablePtr)lookupHashTable(stablehash, (StgWord)symbol);
3779 if (NULL == stablePtr) {
3780 /* No, so look up the name in our global table. */
3781 S_tmp = lookupSymbol( symbol );
3782 S = (Elf_Addr)S_tmp;
3784 stableVal = deRefStablePtr( stablePtr );
3786 S = (Elf_Addr)S_tmp;
3790 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3793 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
3796 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
3797 (void*)P, (void*)S, (void*)A ));
3798 checkProddableBlock ( oc, pP );
3802 switch (ELF_R_TYPE(info)) {
3803 # ifdef i386_HOST_ARCH
3804 case R_386_32: *pP = value; break;
3805 case R_386_PC32: *pP = value - P; break;
3808 errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n",
3809 oc->fileName, (lnat)ELF_R_TYPE(info));
3817 /* Do ELF relocations for which explicit addends are supplied.
3818 sparc-solaris relocations appear to be of this form. */
3820 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
3821 Elf_Shdr* shdr, int shnum,
3822 Elf_Sym* stab, char* strtab )
3825 char *symbol = NULL;
3827 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
3828 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
3829 int target_shndx = shdr[shnum].sh_info;
3830 int symtab_shndx = shdr[shnum].sh_link;
3832 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3833 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
3834 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3835 target_shndx, symtab_shndx ));
3837 for (j = 0; j < nent; j++) {
3838 #if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3839 /* This #ifdef only serves to avoid unused-var warnings. */
3840 Elf_Addr offset = rtab[j].r_offset;
3841 Elf_Addr P = targ + offset;
3843 Elf_Addr info = rtab[j].r_info;
3844 Elf_Addr A = rtab[j].r_addend;
3848 # if defined(sparc_HOST_ARCH)
3849 Elf_Word* pP = (Elf_Word*)P;
3851 # elif defined(powerpc_HOST_ARCH)
3855 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
3856 j, (void*)offset, (void*)info,
3859 IF_DEBUG(linker,debugBelch( " ZERO" ));
3862 Elf_Sym sym = stab[ELF_R_SYM(info)];
3863 /* First see if it is a local symbol. */
3864 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3865 /* Yes, so we can get the address directly from the ELF symbol
3867 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3869 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3870 + stab[ELF_R_SYM(info)].st_value);
3871 #ifdef ELF_FUNCTION_DESC
3872 /* Make a function descriptor for this function */
3873 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
3874 S = allocateFunctionDesc(S + A);
3879 /* No, so look up the name in our global table. */
3880 symbol = strtab + sym.st_name;
3881 S_tmp = lookupSymbol( symbol );
3882 S = (Elf_Addr)S_tmp;
3884 #ifdef ELF_FUNCTION_DESC
3885 /* If a function, already a function descriptor - we would
3886 have to copy it to add an offset. */
3887 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
3888 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
3892 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3895 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
3898 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
3899 (void*)P, (void*)S, (void*)A ));
3900 /* checkProddableBlock ( oc, (void*)P ); */
3904 switch (ELF_R_TYPE(info)) {
3905 # if defined(sparc_HOST_ARCH)
3906 case R_SPARC_WDISP30:
3907 w1 = *pP & 0xC0000000;
3908 w2 = (Elf_Word)((value - P) >> 2);
3909 ASSERT((w2 & 0xC0000000) == 0);
3914 w1 = *pP & 0xFFC00000;
3915 w2 = (Elf_Word)(value >> 10);
3916 ASSERT((w2 & 0xFFC00000) == 0);
3922 w2 = (Elf_Word)(value & 0x3FF);
3923 ASSERT((w2 & ~0x3FF) == 0);
3928 /* According to the Sun documentation:
3930 This relocation type resembles R_SPARC_32, except it refers to an
3931 unaligned word. That is, the word to be relocated must be treated
3932 as four separate bytes with arbitrary alignment, not as a word
3933 aligned according to the architecture requirements.
3936 w2 = (Elf_Word)value;
3938 // SPARC doesn't do misaligned writes of 32 bit words,
3939 // so we have to do this one byte-at-a-time.
3940 char *pPc = (char*)pP;
3941 pPc[0] = (char) ((Elf_Word)(w2 & 0xff000000) >> 24);
3942 pPc[1] = (char) ((Elf_Word)(w2 & 0x00ff0000) >> 16);
3943 pPc[2] = (char) ((Elf_Word)(w2 & 0x0000ff00) >> 8);
3944 pPc[3] = (char) ((Elf_Word)(w2 & 0x000000ff));
3948 w2 = (Elf_Word)value;
3951 # elif defined(powerpc_HOST_ARCH)
3952 case R_PPC_ADDR16_LO:
3953 *(Elf32_Half*) P = value;
3956 case R_PPC_ADDR16_HI:
3957 *(Elf32_Half*) P = value >> 16;
3960 case R_PPC_ADDR16_HA:
3961 *(Elf32_Half*) P = (value + 0x8000) >> 16;
3965 *(Elf32_Word *) P = value;
3969 *(Elf32_Word *) P = value - P;
3975 if( delta << 6 >> 6 != delta )
3977 value = (Elf_Addr) (&makeSymbolExtra( oc, ELF_R_SYM(info), value )
3981 if( value == 0 || delta << 6 >> 6 != delta )
3983 barf( "Unable to make SymbolExtra for #%d",
3989 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3990 | (delta & 0x3fffffc);
3994 #if x86_64_HOST_ARCH
3996 *(Elf64_Xword *)P = value;
4001 #if defined(ALWAYS_PIC)
4002 barf("R_X86_64_PC32 relocation, but ALWAYS_PIC.");
4004 StgInt64 off = value - P;
4005 if (off >= 0x7fffffffL || off < -0x80000000L) {
4006 #if X86_64_ELF_NONPIC_HACK
4007 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4009 off = pltAddress + A - P;
4011 barf("R_X86_64_PC32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
4012 symbol, off, oc->fileName );
4015 *(Elf64_Word *)P = (Elf64_Word)off;
4022 StgInt64 off = value - P;
4023 *(Elf64_Word *)P = (Elf64_Word)off;
4028 #if defined(ALWAYS_PIC)
4029 barf("R_X86_64_32 relocation, but ALWAYS_PIC.");
4031 if (value >= 0x7fffffffL) {
4032 #if X86_64_ELF_NONPIC_HACK
4033 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4035 value = pltAddress + A;
4037 barf("R_X86_64_32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
4038 symbol, value, oc->fileName );
4041 *(Elf64_Word *)P = (Elf64_Word)value;
4046 #if defined(ALWAYS_PIC)
4047 barf("R_X86_64_32S relocation, but ALWAYS_PIC.");
4049 if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
4050 #if X86_64_ELF_NONPIC_HACK
4051 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4053 value = pltAddress + A;
4055 barf("R_X86_64_32S relocation out of range: %s = %p\nRecompile %s with -fPIC.",
4056 symbol, value, oc->fileName );
4059 *(Elf64_Sword *)P = (Elf64_Sword)value;
4063 case R_X86_64_GOTPCREL:
4065 StgInt64 gotAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)->addr;
4066 StgInt64 off = gotAddress + A - P;
4067 *(Elf64_Word *)P = (Elf64_Word)off;
4071 case R_X86_64_PLT32:
4073 #if defined(ALWAYS_PIC)
4074 barf("R_X86_64_PLT32 relocation, but ALWAYS_PIC.");
4076 StgInt64 off = value - P;
4077 if (off >= 0x7fffffffL || off < -0x80000000L) {
4078 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4080 off = pltAddress + A - P;
4082 *(Elf64_Word *)P = (Elf64_Word)off;
4089 errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n",
4090 oc->fileName, (lnat)ELF_R_TYPE(info));
4099 ocResolve_ELF ( ObjectCode* oc )
4103 Elf_Sym* stab = NULL;
4104 char* ehdrC = (char*)(oc->image);
4105 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
4106 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
4108 /* first find "the" symbol table */
4109 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
4111 /* also go find the string table */
4112 strtab = findElfSection ( ehdrC, SHT_STRTAB );
4114 if (stab == NULL || strtab == NULL) {
4115 errorBelch("%s: can't find string or symbol table", oc->fileName);
4119 /* Process the relocation sections. */
4120 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
4121 if (shdr[shnum].sh_type == SHT_REL) {
4122 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
4123 shnum, stab, strtab );
4127 if (shdr[shnum].sh_type == SHT_RELA) {
4128 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
4129 shnum, stab, strtab );
4134 #if defined(powerpc_HOST_ARCH)
4135 ocFlushInstructionCache( oc );
4142 * PowerPC & X86_64 ELF specifics
4145 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
4147 static int ocAllocateSymbolExtras_ELF( ObjectCode *oc )
4153 ehdr = (Elf_Ehdr *) oc->image;
4154 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
4156 for( i = 0; i < ehdr->e_shnum; i++ )
4157 if( shdr[i].sh_type == SHT_SYMTAB )
4160 if( i == ehdr->e_shnum )
4162 errorBelch( "This ELF file contains no symtab" );
4166 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
4168 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
4169 (int) shdr[i].sh_entsize, (int) sizeof( Elf_Sym ) );
4174 return ocAllocateSymbolExtras( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
4177 #endif /* powerpc */
4181 /* --------------------------------------------------------------------------
4183 * ------------------------------------------------------------------------*/
4185 #if defined(OBJFORMAT_MACHO)
4188 Support for MachO linking on Darwin/MacOS X
4189 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
4191 I hereby formally apologize for the hackish nature of this code.
4192 Things that need to be done:
4193 *) implement ocVerifyImage_MachO
4194 *) add still more sanity checks.
4197 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
4198 #define mach_header mach_header_64
4199 #define segment_command segment_command_64
4200 #define section section_64
4201 #define nlist nlist_64
4204 #ifdef powerpc_HOST_ARCH
4205 static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
4207 struct mach_header *header = (struct mach_header *) oc->image;
4208 struct load_command *lc = (struct load_command *) (header + 1);
4211 for( i = 0; i < header->ncmds; i++ )
4213 if( lc->cmd == LC_SYMTAB )
4215 // Find out the first and last undefined external
4216 // symbol, so we don't have to allocate too many
4218 struct symtab_command *symLC = (struct symtab_command *) lc;
4219 unsigned min = symLC->nsyms, max = 0;
4220 struct nlist *nlist =
4221 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
4223 for(i=0;i<symLC->nsyms;i++)
4225 if(nlist[i].n_type & N_STAB)
4227 else if(nlist[i].n_type & N_EXT)
4229 if((nlist[i].n_type & N_TYPE) == N_UNDF
4230 && (nlist[i].n_value == 0))
4240 return ocAllocateSymbolExtras(oc, max - min + 1, min);
4245 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
4247 return ocAllocateSymbolExtras(oc,0,0);
4250 #ifdef x86_64_HOST_ARCH
4251 static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
4253 struct mach_header *header = (struct mach_header *) oc->image;
4254 struct load_command *lc = (struct load_command *) (header + 1);
4257 for( i = 0; i < header->ncmds; i++ )
4259 if( lc->cmd == LC_SYMTAB )
4261 // Just allocate one entry for every symbol
4262 struct symtab_command *symLC = (struct symtab_command *) lc;
4264 return ocAllocateSymbolExtras(oc, symLC->nsyms, 0);
4267 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
4269 return ocAllocateSymbolExtras(oc,0,0);
4273 static int ocVerifyImage_MachO(ObjectCode* oc)
4275 char *image = (char*) oc->image;
4276 struct mach_header *header = (struct mach_header*) image;
4278 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
4279 if(header->magic != MH_MAGIC_64) {
4280 errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
4281 oc->fileName, MH_MAGIC_64, header->magic);
4285 if(header->magic != MH_MAGIC) {
4286 errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
4287 oc->fileName, MH_MAGIC, header->magic);
4291 // FIXME: do some more verifying here
4295 static int resolveImports(
4298 struct symtab_command *symLC,
4299 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
4300 unsigned long *indirectSyms,
4301 struct nlist *nlist)
4304 size_t itemSize = 4;
4307 int isJumpTable = 0;
4308 if(!strcmp(sect->sectname,"__jump_table"))
4312 ASSERT(sect->reserved2 == itemSize);
4316 for(i=0; i*itemSize < sect->size;i++)
4318 // according to otool, reserved1 contains the first index into the indirect symbol table
4319 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
4320 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4323 if((symbol->n_type & N_TYPE) == N_UNDF
4324 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
4325 addr = (void*) (symbol->n_value);
4327 addr = lookupSymbol(nm);
4330 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
4338 checkProddableBlock(oc,image + sect->offset + i*itemSize);
4339 *(image + sect->offset + i*itemSize) = 0xe9; // jmp
4340 *(unsigned*)(image + sect->offset + i*itemSize + 1)
4341 = (char*)addr - (image + sect->offset + i*itemSize + 5);
4346 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
4347 ((void**)(image + sect->offset))[i] = addr;
4354 static unsigned long relocateAddress(
4357 struct section* sections,
4358 unsigned long address)
4361 for(i = 0; i < nSections; i++)
4363 if(sections[i].addr <= address
4364 && address < sections[i].addr + sections[i].size)
4366 return (unsigned long)oc->image
4367 + sections[i].offset + address - sections[i].addr;
4370 barf("Invalid Mach-O file:"
4371 "Address out of bounds while relocating object file");
4375 static int relocateSection(
4378 struct symtab_command *symLC, struct nlist *nlist,
4379 int nSections, struct section* sections, struct section *sect)
4381 struct relocation_info *relocs;
4384 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
4386 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
4388 else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
4390 else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
4394 relocs = (struct relocation_info*) (image + sect->reloff);
4398 #ifdef x86_64_HOST_ARCH
4399 struct relocation_info *reloc = &relocs[i];
4401 char *thingPtr = image + sect->offset + reloc->r_address;
4403 /* We shouldn't need to initialise this, but gcc on OS X 64 bit
4404 complains that it may be used uninitialized if we don't */
4407 int type = reloc->r_type;
4409 checkProddableBlock(oc,thingPtr);
4410 switch(reloc->r_length)
4413 thing = *(uint8_t*)thingPtr;
4414 baseValue = (uint64_t)thingPtr + 1;
4417 thing = *(uint16_t*)thingPtr;
4418 baseValue = (uint64_t)thingPtr + 2;
4421 thing = *(uint32_t*)thingPtr;
4422 baseValue = (uint64_t)thingPtr + 4;
4425 thing = *(uint64_t*)thingPtr;
4426 baseValue = (uint64_t)thingPtr + 8;
4429 barf("Unknown size.");
4432 if(type == X86_64_RELOC_GOT
4433 || type == X86_64_RELOC_GOT_LOAD)
4435 ASSERT(reloc->r_extern);
4436 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)->addr;
4438 type = X86_64_RELOC_SIGNED;
4440 else if(reloc->r_extern)
4442 struct nlist *symbol = &nlist[reloc->r_symbolnum];
4443 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4444 if(symbol->n_value == 0)
4445 value = (uint64_t) lookupSymbol(nm);
4447 value = relocateAddress(oc, nSections, sections,
4452 value = sections[reloc->r_symbolnum-1].offset
4453 - sections[reloc->r_symbolnum-1].addr
4457 if(type == X86_64_RELOC_BRANCH)
4459 if((int32_t)(value - baseValue) != (int64_t)(value - baseValue))
4461 ASSERT(reloc->r_extern);
4462 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)
4465 ASSERT((int32_t)(value - baseValue) == (int64_t)(value - baseValue));
4466 type = X86_64_RELOC_SIGNED;
4471 case X86_64_RELOC_UNSIGNED:
4472 ASSERT(!reloc->r_pcrel);
4475 case X86_64_RELOC_SIGNED:
4476 case X86_64_RELOC_SIGNED_1:
4477 case X86_64_RELOC_SIGNED_2:
4478 case X86_64_RELOC_SIGNED_4:
4479 ASSERT(reloc->r_pcrel);
4480 thing += value - baseValue;
4482 case X86_64_RELOC_SUBTRACTOR:
4483 ASSERT(!reloc->r_pcrel);
4487 barf("unkown relocation");
4490 switch(reloc->r_length)
4493 *(uint8_t*)thingPtr = thing;
4496 *(uint16_t*)thingPtr = thing;
4499 *(uint32_t*)thingPtr = thing;
4502 *(uint64_t*)thingPtr = thing;
4506 if(relocs[i].r_address & R_SCATTERED)
4508 struct scattered_relocation_info *scat =
4509 (struct scattered_relocation_info*) &relocs[i];
4513 if(scat->r_length == 2)
4515 unsigned long word = 0;
4516 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
4517 checkProddableBlock(oc,wordPtr);
4519 // Note on relocation types:
4520 // i386 uses the GENERIC_RELOC_* types,
4521 // while ppc uses special PPC_RELOC_* types.
4522 // *_RELOC_VANILLA and *_RELOC_PAIR have the same value
4523 // in both cases, all others are different.
4524 // Therefore, we use GENERIC_RELOC_VANILLA
4525 // and GENERIC_RELOC_PAIR instead of the PPC variants,
4526 // and use #ifdefs for the other types.
4528 // Step 1: Figure out what the relocated value should be
4529 if(scat->r_type == GENERIC_RELOC_VANILLA)
4531 word = *wordPtr + (unsigned long) relocateAddress(
4538 #ifdef powerpc_HOST_ARCH
4539 else if(scat->r_type == PPC_RELOC_SECTDIFF
4540 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
4541 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
4542 || scat->r_type == PPC_RELOC_HA16_SECTDIFF
4543 || scat->r_type == PPC_RELOC_LOCAL_SECTDIFF)
4545 else if(scat->r_type == GENERIC_RELOC_SECTDIFF
4546 || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
4549 struct scattered_relocation_info *pair =
4550 (struct scattered_relocation_info*) &relocs[i+1];
4552 if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR)
4553 barf("Invalid Mach-O file: "
4554 "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
4556 word = (unsigned long)
4557 (relocateAddress(oc, nSections, sections, scat->r_value)
4558 - relocateAddress(oc, nSections, sections, pair->r_value));
4561 #ifdef powerpc_HOST_ARCH
4562 else if(scat->r_type == PPC_RELOC_HI16
4563 || scat->r_type == PPC_RELOC_LO16
4564 || scat->r_type == PPC_RELOC_HA16
4565 || scat->r_type == PPC_RELOC_LO14)
4566 { // these are generated by label+offset things
4567 struct relocation_info *pair = &relocs[i+1];
4568 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
4569 barf("Invalid Mach-O file: "
4570 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
4572 if(scat->r_type == PPC_RELOC_LO16)
4574 word = ((unsigned short*) wordPtr)[1];
4575 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4577 else if(scat->r_type == PPC_RELOC_LO14)
4579 barf("Unsupported Relocation: PPC_RELOC_LO14");
4580 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
4581 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4583 else if(scat->r_type == PPC_RELOC_HI16)
4585 word = ((unsigned short*) wordPtr)[1] << 16;
4586 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4588 else if(scat->r_type == PPC_RELOC_HA16)
4590 word = ((unsigned short*) wordPtr)[1] << 16;
4591 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4595 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
4603 barf ("Don't know how to handle this Mach-O "
4604 "scattered relocation entry: "
4605 "object file %s; entry type %ld; "
4607 oc->fileName, scat->r_type, scat->r_address);
4611 #ifdef powerpc_HOST_ARCH
4612 if(scat->r_type == GENERIC_RELOC_VANILLA
4613 || scat->r_type == PPC_RELOC_SECTDIFF)
4615 if(scat->r_type == GENERIC_RELOC_VANILLA
4616 || scat->r_type == GENERIC_RELOC_SECTDIFF
4617 || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
4622 #ifdef powerpc_HOST_ARCH
4623 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
4625 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4627 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
4629 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4631 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
4633 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4634 + ((word & (1<<15)) ? 1 : 0);
4640 barf("Can't handle Mach-O scattered relocation entry "
4641 "with this r_length tag: "
4642 "object file %s; entry type %ld; "
4643 "r_length tag %ld; address %#lx\n",
4644 oc->fileName, scat->r_type, scat->r_length,
4649 else /* scat->r_pcrel */
4651 barf("Don't know how to handle *PC-relative* Mach-O "
4652 "scattered relocation entry: "
4653 "object file %s; entry type %ld; address %#lx\n",
4654 oc->fileName, scat->r_type, scat->r_address);
4659 else /* !(relocs[i].r_address & R_SCATTERED) */
4661 struct relocation_info *reloc = &relocs[i];
4662 if(reloc->r_pcrel && !reloc->r_extern)
4665 if(reloc->r_length == 2)
4667 unsigned long word = 0;
4668 #ifdef powerpc_HOST_ARCH
4669 unsigned long jumpIsland = 0;
4670 long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
4671 // to avoid warning and to catch
4675 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
4676 checkProddableBlock(oc,wordPtr);
4678 if(reloc->r_type == GENERIC_RELOC_VANILLA)
4682 #ifdef powerpc_HOST_ARCH
4683 else if(reloc->r_type == PPC_RELOC_LO16)
4685 word = ((unsigned short*) wordPtr)[1];
4686 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4688 else if(reloc->r_type == PPC_RELOC_HI16)
4690 word = ((unsigned short*) wordPtr)[1] << 16;
4691 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4693 else if(reloc->r_type == PPC_RELOC_HA16)
4695 word = ((unsigned short*) wordPtr)[1] << 16;
4696 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4698 else if(reloc->r_type == PPC_RELOC_BR24)
4701 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
4706 barf("Can't handle this Mach-O relocation entry "
4708 "object file %s; entry type %ld; address %#lx\n",
4709 oc->fileName, reloc->r_type, reloc->r_address);
4713 if(!reloc->r_extern)
4716 sections[reloc->r_symbolnum-1].offset
4717 - sections[reloc->r_symbolnum-1].addr
4724 struct nlist *symbol = &nlist[reloc->r_symbolnum];
4725 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4726 void *symbolAddress = lookupSymbol(nm);
4729 errorBelch("\nunknown symbol `%s'", nm);
4735 #ifdef powerpc_HOST_ARCH
4736 // In the .o file, this should be a relative jump to NULL
4737 // and we'll change it to a relative jump to the symbol
4738 ASSERT(word + reloc->r_address == 0);
4739 jumpIsland = (unsigned long)
4740 &makeSymbolExtra(oc,
4742 (unsigned long) symbolAddress)
4746 offsetToJumpIsland = word + jumpIsland
4747 - (((long)image) + sect->offset - sect->addr);
4750 word += (unsigned long) symbolAddress
4751 - (((long)image) + sect->offset - sect->addr);
4755 word += (unsigned long) symbolAddress;
4759 if(reloc->r_type == GENERIC_RELOC_VANILLA)
4764 #ifdef powerpc_HOST_ARCH
4765 else if(reloc->r_type == PPC_RELOC_LO16)
4767 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4770 else if(reloc->r_type == PPC_RELOC_HI16)
4772 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4775 else if(reloc->r_type == PPC_RELOC_HA16)
4777 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4778 + ((word & (1<<15)) ? 1 : 0);
4781 else if(reloc->r_type == PPC_RELOC_BR24)
4783 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4785 // The branch offset is too large.
4786 // Therefore, we try to use a jump island.
4789 barf("unconditional relative branch out of range: "
4790 "no jump island available");
4793 word = offsetToJumpIsland;
4794 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4795 barf("unconditional relative branch out of range: "
4796 "jump island out of range");
4798 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
4805 barf("Can't handle Mach-O relocation entry (not scattered) "
4806 "with this r_length tag: "
4807 "object file %s; entry type %ld; "
4808 "r_length tag %ld; address %#lx\n",
4809 oc->fileName, reloc->r_type, reloc->r_length,
4819 static int ocGetNames_MachO(ObjectCode* oc)
4821 char *image = (char*) oc->image;
4822 struct mach_header *header = (struct mach_header*) image;
4823 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4824 unsigned i,curSymbol = 0;
4825 struct segment_command *segLC = NULL;
4826 struct section *sections;
4827 struct symtab_command *symLC = NULL;
4828 struct nlist *nlist;
4829 unsigned long commonSize = 0;
4830 char *commonStorage = NULL;
4831 unsigned long commonCounter;
4833 for(i=0;i<header->ncmds;i++)
4835 if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
4836 segLC = (struct segment_command*) lc;
4837 else if(lc->cmd == LC_SYMTAB)
4838 symLC = (struct symtab_command*) lc;
4839 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4842 sections = (struct section*) (segLC+1);
4843 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4847 barf("ocGetNames_MachO: no segment load command");
4849 for(i=0;i<segLC->nsects;i++)
4851 if(sections[i].size == 0)
4854 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
4856 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
4857 "ocGetNames_MachO(common symbols)");
4858 sections[i].offset = zeroFillArea - image;
4861 if(!strcmp(sections[i].sectname,"__text"))
4862 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
4863 (void*) (image + sections[i].offset),
4864 (void*) (image + sections[i].offset + sections[i].size));
4865 else if(!strcmp(sections[i].sectname,"__const"))
4866 addSection(oc, SECTIONKIND_RWDATA,
4867 (void*) (image + sections[i].offset),
4868 (void*) (image + sections[i].offset + sections[i].size));
4869 else if(!strcmp(sections[i].sectname,"__data"))
4870 addSection(oc, SECTIONKIND_RWDATA,
4871 (void*) (image + sections[i].offset),
4872 (void*) (image + sections[i].offset + sections[i].size));
4873 else if(!strcmp(sections[i].sectname,"__bss")
4874 || !strcmp(sections[i].sectname,"__common"))
4875 addSection(oc, SECTIONKIND_RWDATA,
4876 (void*) (image + sections[i].offset),
4877 (void*) (image + sections[i].offset + sections[i].size));
4879 addProddableBlock(oc, (void*) (image + sections[i].offset),
4883 // count external symbols defined here
4887 for(i=0;i<symLC->nsyms;i++)
4889 if(nlist[i].n_type & N_STAB)
4891 else if(nlist[i].n_type & N_EXT)
4893 if((nlist[i].n_type & N_TYPE) == N_UNDF
4894 && (nlist[i].n_value != 0))
4896 commonSize += nlist[i].n_value;
4899 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4904 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
4905 "ocGetNames_MachO(oc->symbols)");
4909 for(i=0;i<symLC->nsyms;i++)
4911 if(nlist[i].n_type & N_STAB)
4913 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4915 if(nlist[i].n_type & N_EXT)
4917 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4918 if((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm))
4919 ; // weak definition, and we already have a definition
4922 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4924 + sections[nlist[i].n_sect-1].offset
4925 - sections[nlist[i].n_sect-1].addr
4926 + nlist[i].n_value);
4927 oc->symbols[curSymbol++] = nm;
4934 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
4935 commonCounter = (unsigned long)commonStorage;
4938 for(i=0;i<symLC->nsyms;i++)
4940 if((nlist[i].n_type & N_TYPE) == N_UNDF
4941 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
4943 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4944 unsigned long sz = nlist[i].n_value;
4946 nlist[i].n_value = commonCounter;
4948 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4949 (void*)commonCounter);
4950 oc->symbols[curSymbol++] = nm;
4952 commonCounter += sz;
4959 static int ocResolve_MachO(ObjectCode* oc)
4961 char *image = (char*) oc->image;
4962 struct mach_header *header = (struct mach_header*) image;
4963 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4965 struct segment_command *segLC = NULL;
4966 struct section *sections;
4967 struct symtab_command *symLC = NULL;
4968 struct dysymtab_command *dsymLC = NULL;
4969 struct nlist *nlist;
4971 for(i=0;i<header->ncmds;i++)
4973 if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
4974 segLC = (struct segment_command*) lc;
4975 else if(lc->cmd == LC_SYMTAB)
4976 symLC = (struct symtab_command*) lc;
4977 else if(lc->cmd == LC_DYSYMTAB)
4978 dsymLC = (struct dysymtab_command*) lc;
4979 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4982 sections = (struct section*) (segLC+1);
4983 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4988 unsigned long *indirectSyms
4989 = (unsigned long*) (image + dsymLC->indirectsymoff);
4991 for(i=0;i<segLC->nsects;i++)
4993 if( !strcmp(sections[i].sectname,"__la_symbol_ptr")
4994 || !strcmp(sections[i].sectname,"__la_sym_ptr2")
4995 || !strcmp(sections[i].sectname,"__la_sym_ptr3"))
4997 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
5000 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr")
5001 || !strcmp(sections[i].sectname,"__pointers"))
5003 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
5006 else if(!strcmp(sections[i].sectname,"__jump_table"))
5008 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
5014 for(i=0;i<segLC->nsects;i++)
5016 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
5020 #if defined (powerpc_HOST_ARCH)
5021 ocFlushInstructionCache( oc );
5027 #ifdef powerpc_HOST_ARCH
5029 * The Mach-O object format uses leading underscores. But not everywhere.
5030 * There is a small number of runtime support functions defined in
5031 * libcc_dynamic.a whose name does not have a leading underscore.
5032 * As a consequence, we can't get their address from C code.
5033 * We have to use inline assembler just to take the address of a function.
5037 extern void* symbolsWithoutUnderscore[];
5039 static void machoInitSymbolsWithoutUnderscore()
5041 void **p = symbolsWithoutUnderscore;
5042 __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
5044 #undef SymI_NeedsProto
5045 #define SymI_NeedsProto(x) \
5046 __asm__ volatile(".long " # x);
5048 RTS_MACHO_NOUNDERLINE_SYMBOLS
5050 __asm__ volatile(".text");
5052 #undef SymI_NeedsProto
5053 #define SymI_NeedsProto(x) \
5054 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
5056 RTS_MACHO_NOUNDERLINE_SYMBOLS
5058 #undef SymI_NeedsProto
5064 * Figure out by how much to shift the entire Mach-O file in memory
5065 * when loading so that its single segment ends up 16-byte-aligned
5067 static int machoGetMisalignment( FILE * f )
5069 struct mach_header header;
5072 fread(&header, sizeof(header), 1, f);
5075 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
5076 if(header.magic != MH_MAGIC_64) {
5077 errorBelch("Bad magic. Expected: %08x, got: %08x.\n",
5078 MH_MAGIC_64, header->magic);
5082 if(header.magic != MH_MAGIC) {
5083 errorBelch("Bad magic. Expected: %08x, got: %08x.\n",
5084 MH_MAGIC, header->magic);
5089 misalignment = (header.sizeofcmds + sizeof(header))
5092 return misalignment ? (16 - misalignment) : 0;