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>.
16 #if defined(__linux__) || defined(__GLIBC__)
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>
49 #ifdef HAVE_SYS_STAT_H
53 #if defined(HAVE_DLFCN_H)
57 #if defined(cygwin32_HOST_OS)
62 #ifdef HAVE_SYS_TIME_H
66 #include <sys/fcntl.h>
67 #include <sys/termios.h>
68 #include <sys/utime.h>
69 #include <sys/utsname.h>
73 #if defined(linux_HOST_OS ) || defined(freebsd_HOST_OS) || \
74 defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS ) || \
75 defined(openbsd_HOST_OS ) || \
76 ( defined(darwin_HOST_OS ) && !defined(powerpc_HOST_ARCH) ) || \
77 defined(kfreebsdgnu_HOST_OS)
78 /* Don't use mmap on powerpc-apple-darwin as mmap doesn't support
79 * reallocating but we need to allocate jump islands just after each
80 * object images. Otherwise relative branches to jump islands can fail
81 * due to 24-bits displacement overflow.
93 #if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
94 # define OBJFORMAT_ELF
95 # include <regex.h> // regex is already used by dlopen() so this is OK
96 // to use here without requiring an additional lib
97 #elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
98 # define OBJFORMAT_PEi386
101 #elif defined(darwin_HOST_OS)
102 # define OBJFORMAT_MACHO
104 # include <mach-o/loader.h>
105 # include <mach-o/nlist.h>
106 # include <mach-o/reloc.h>
107 #if !defined(HAVE_DLFCN_H)
108 # include <mach-o/dyld.h>
110 #if defined(powerpc_HOST_ARCH)
111 # include <mach-o/ppc/reloc.h>
113 #if defined(x86_64_HOST_ARCH)
114 # include <mach-o/x86_64/reloc.h>
118 #if defined(x86_64_HOST_ARCH) && defined(darwin_HOST_OS)
122 /* Hash table mapping symbol names to Symbol */
123 static /*Str*/HashTable *symhash;
125 /* Hash table mapping symbol names to StgStablePtr */
126 static /*Str*/HashTable *stablehash;
128 /* List of currently loaded objects */
129 ObjectCode *objects = NULL; /* initially empty */
131 static HsInt loadOc( ObjectCode* oc );
132 static ObjectCode* mkOc( char *path, char *image, int imageSize,
133 char *archiveMemberName
135 #ifdef darwin_HOST_OS
141 #if defined(OBJFORMAT_ELF)
142 static int ocVerifyImage_ELF ( ObjectCode* oc );
143 static int ocGetNames_ELF ( ObjectCode* oc );
144 static int ocResolve_ELF ( ObjectCode* oc );
145 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
146 static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc );
148 #elif defined(OBJFORMAT_PEi386)
149 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
150 static int ocGetNames_PEi386 ( ObjectCode* oc );
151 static int ocResolve_PEi386 ( ObjectCode* oc );
152 static void *lookupSymbolInDLLs ( unsigned char *lbl );
153 static void zapTrailingAtSign ( unsigned char *sym );
154 #elif defined(OBJFORMAT_MACHO)
155 static int ocVerifyImage_MachO ( ObjectCode* oc );
156 static int ocGetNames_MachO ( ObjectCode* oc );
157 static int ocResolve_MachO ( ObjectCode* oc );
160 static int machoGetMisalignment( FILE * );
162 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
163 static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
165 #ifdef powerpc_HOST_ARCH
166 static void machoInitSymbolsWithoutUnderscore( void );
170 /* on x86_64 we have a problem with relocating symbol references in
171 * code that was compiled without -fPIC. By default, the small memory
172 * model is used, which assumes that symbol references can fit in a
173 * 32-bit slot. The system dynamic linker makes this work for
174 * references to shared libraries by either (a) allocating a jump
175 * table slot for code references, or (b) moving the symbol at load
176 * time (and copying its contents, if necessary) for data references.
178 * We unfortunately can't tell whether symbol references are to code
179 * or data. So for now we assume they are code (the vast majority
180 * are), and allocate jump-table slots. Unfortunately this will
181 * SILENTLY generate crashing code for data references. This hack is
182 * enabled by X86_64_ELF_NONPIC_HACK.
184 * One workaround is to use shared Haskell libraries. This is
185 * coming. Another workaround is to keep the static libraries but
186 * compile them with -fPIC, because that will generate PIC references
187 * to data which can be relocated. The PIC code is still too green to
188 * do this systematically, though.
191 * See thread http://www.haskell.org/pipermail/cvs-ghc/2007-September/038458.html
193 * Naming Scheme for Symbol Macros
195 * SymI_*: symbol is internal to the RTS. It resides in an object
196 * file/library that is statically.
197 * SymE_*: symbol is external to the RTS library. It might be linked
200 * Sym*_HasProto : the symbol prototype is imported in an include file
201 * or defined explicitly
202 * Sym*_NeedsProto: the symbol is undefined and we add a dummy
203 * default proto extern void sym(void);
205 #define X86_64_ELF_NONPIC_HACK 1
207 /* Link objects into the lower 2Gb on x86_64. GHC assumes the
208 * small memory model on this architecture (see gcc docs,
211 * MAP_32BIT not available on OpenBSD/amd64
213 #if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
214 #define TRY_MAP_32BIT MAP_32BIT
216 #define TRY_MAP_32BIT 0
220 * Due to the small memory model (see above), on x86_64 we have to map
221 * all our non-PIC object files into the low 2Gb of the address space
222 * (why 2Gb and not 4Gb? Because all addresses must be reachable
223 * using a 32-bit signed PC-relative offset). On Linux we can do this
224 * using the MAP_32BIT flag to mmap(), however on other OSs
225 * (e.g. *BSD, see #2063, and also on Linux inside Xen, see #2512), we
226 * can't do this. So on these systems, we have to pick a base address
227 * in the low 2Gb of the address space and try to allocate memory from
230 * We pick a default address based on the OS, but also make this
231 * configurable via an RTS flag (+RTS -xm)
233 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
235 #if defined(MAP_32BIT)
236 // Try to use MAP_32BIT
237 #define MMAP_32BIT_BASE_DEFAULT 0
240 #define MMAP_32BIT_BASE_DEFAULT 0x40000000
243 static void *mmap_32bit_base = (void *)MMAP_32BIT_BASE_DEFAULT;
246 /* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
247 #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
248 #define MAP_ANONYMOUS MAP_ANON
251 /* -----------------------------------------------------------------------------
252 * Built-in symbols from the RTS
255 typedef struct _RtsSymbolVal {
260 #define Maybe_Stable_Names SymI_HasProto(stg_mkWeakzh) \
261 SymI_HasProto(stg_mkWeakForeignEnvzh) \
262 SymI_HasProto(stg_makeStableNamezh) \
263 SymI_HasProto(stg_finalizzeWeakzh)
265 #if !defined (mingw32_HOST_OS)
266 #define RTS_POSIX_ONLY_SYMBOLS \
267 SymI_HasProto(__hscore_get_saved_termios) \
268 SymI_HasProto(__hscore_set_saved_termios) \
269 SymI_HasProto(shutdownHaskellAndSignal) \
270 SymI_HasProto(lockFile) \
271 SymI_HasProto(unlockFile) \
272 SymI_HasProto(signal_handlers) \
273 SymI_HasProto(stg_sig_install) \
274 SymI_HasProto(rtsTimerSignal) \
275 SymI_NeedsProto(nocldstop)
278 #if defined (cygwin32_HOST_OS)
279 #define RTS_MINGW_ONLY_SYMBOLS /**/
280 /* Don't have the ability to read import libs / archives, so
281 * we have to stupidly list a lot of what libcygwin.a
284 #define RTS_CYGWIN_ONLY_SYMBOLS \
285 SymI_HasProto(regfree) \
286 SymI_HasProto(regexec) \
287 SymI_HasProto(regerror) \
288 SymI_HasProto(regcomp) \
289 SymI_HasProto(__errno) \
290 SymI_HasProto(access) \
291 SymI_HasProto(chmod) \
292 SymI_HasProto(chdir) \
293 SymI_HasProto(close) \
294 SymI_HasProto(creat) \
296 SymI_HasProto(dup2) \
297 SymI_HasProto(fstat) \
298 SymI_HasProto(fcntl) \
299 SymI_HasProto(getcwd) \
300 SymI_HasProto(getenv) \
301 SymI_HasProto(lseek) \
302 SymI_HasProto(open) \
303 SymI_HasProto(fpathconf) \
304 SymI_HasProto(pathconf) \
305 SymI_HasProto(stat) \
307 SymI_HasProto(tanh) \
308 SymI_HasProto(cosh) \
309 SymI_HasProto(sinh) \
310 SymI_HasProto(atan) \
311 SymI_HasProto(acos) \
312 SymI_HasProto(asin) \
318 SymI_HasProto(sqrt) \
319 SymI_HasProto(localtime_r) \
320 SymI_HasProto(gmtime_r) \
321 SymI_HasProto(mktime) \
322 SymI_NeedsProto(_imp___tzname) \
323 SymI_HasProto(gettimeofday) \
324 SymI_HasProto(timezone) \
325 SymI_HasProto(tcgetattr) \
326 SymI_HasProto(tcsetattr) \
327 SymI_HasProto(memcpy) \
328 SymI_HasProto(memmove) \
329 SymI_HasProto(realloc) \
330 SymI_HasProto(malloc) \
331 SymI_HasProto(free) \
332 SymI_HasProto(fork) \
333 SymI_HasProto(lstat) \
334 SymI_HasProto(isatty) \
335 SymI_HasProto(mkdir) \
336 SymI_HasProto(opendir) \
337 SymI_HasProto(readdir) \
338 SymI_HasProto(rewinddir) \
339 SymI_HasProto(closedir) \
340 SymI_HasProto(link) \
341 SymI_HasProto(mkfifo) \
342 SymI_HasProto(pipe) \
343 SymI_HasProto(read) \
344 SymI_HasProto(rename) \
345 SymI_HasProto(rmdir) \
346 SymI_HasProto(select) \
347 SymI_HasProto(system) \
348 SymI_HasProto(write) \
349 SymI_HasProto(strcmp) \
350 SymI_HasProto(strcpy) \
351 SymI_HasProto(strncpy) \
352 SymI_HasProto(strerror) \
353 SymI_HasProto(sigaddset) \
354 SymI_HasProto(sigemptyset) \
355 SymI_HasProto(sigprocmask) \
356 SymI_HasProto(umask) \
357 SymI_HasProto(uname) \
358 SymI_HasProto(unlink) \
359 SymI_HasProto(utime) \
360 SymI_HasProto(waitpid)
362 #elif !defined(mingw32_HOST_OS)
363 #define RTS_MINGW_ONLY_SYMBOLS /**/
364 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
365 #else /* defined(mingw32_HOST_OS) */
366 #define RTS_POSIX_ONLY_SYMBOLS /**/
367 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
369 #if HAVE_GETTIMEOFDAY
370 #define RTS_MINGW_GETTIMEOFDAY_SYM SymI_NeedsProto(gettimeofday)
372 #define RTS_MINGW_GETTIMEOFDAY_SYM /**/
375 #if HAVE___MINGW_VFPRINTF
376 #define RTS___MINGW_VFPRINTF_SYM SymI_HasProto(__mingw_vfprintf)
378 #define RTS___MINGW_VFPRINTF_SYM /**/
381 /* These are statically linked from the mingw libraries into the ghc
382 executable, so we have to employ this hack. */
383 #define RTS_MINGW_ONLY_SYMBOLS \
384 SymI_HasProto(stg_asyncReadzh) \
385 SymI_HasProto(stg_asyncWritezh) \
386 SymI_HasProto(stg_asyncDoProczh) \
387 SymI_HasProto(memset) \
388 SymI_HasProto(inet_ntoa) \
389 SymI_HasProto(inet_addr) \
390 SymI_HasProto(htonl) \
391 SymI_HasProto(recvfrom) \
392 SymI_HasProto(listen) \
393 SymI_HasProto(bind) \
394 SymI_HasProto(shutdown) \
395 SymI_HasProto(connect) \
396 SymI_HasProto(htons) \
397 SymI_HasProto(ntohs) \
398 SymI_HasProto(getservbyname) \
399 SymI_HasProto(getservbyport) \
400 SymI_HasProto(getprotobynumber) \
401 SymI_HasProto(getprotobyname) \
402 SymI_HasProto(gethostbyname) \
403 SymI_HasProto(gethostbyaddr) \
404 SymI_HasProto(gethostname) \
405 SymI_HasProto(strcpy) \
406 SymI_HasProto(strncpy) \
407 SymI_HasProto(abort) \
408 SymI_NeedsProto(_alloca) \
409 SymI_HasProto(isxdigit) \
410 SymI_HasProto(isupper) \
411 SymI_HasProto(ispunct) \
412 SymI_HasProto(islower) \
413 SymI_HasProto(isspace) \
414 SymI_HasProto(isprint) \
415 SymI_HasProto(isdigit) \
416 SymI_HasProto(iscntrl) \
417 SymI_HasProto(isalpha) \
418 SymI_HasProto(isalnum) \
419 SymI_HasProto(isascii) \
420 RTS___MINGW_VFPRINTF_SYM \
421 SymI_HasProto(strcmp) \
422 SymI_HasProto(memmove) \
423 SymI_HasProto(realloc) \
424 SymI_HasProto(malloc) \
426 SymI_HasProto(tanh) \
427 SymI_HasProto(cosh) \
428 SymI_HasProto(sinh) \
429 SymI_HasProto(atan) \
430 SymI_HasProto(acos) \
431 SymI_HasProto(asin) \
437 SymI_HasProto(sqrt) \
438 SymI_HasProto(powf) \
439 SymI_HasProto(tanhf) \
440 SymI_HasProto(coshf) \
441 SymI_HasProto(sinhf) \
442 SymI_HasProto(atanf) \
443 SymI_HasProto(acosf) \
444 SymI_HasProto(asinf) \
445 SymI_HasProto(tanf) \
446 SymI_HasProto(cosf) \
447 SymI_HasProto(sinf) \
448 SymI_HasProto(expf) \
449 SymI_HasProto(logf) \
450 SymI_HasProto(sqrtf) \
452 SymI_HasProto(erfc) \
453 SymI_HasProto(erff) \
454 SymI_HasProto(erfcf) \
455 SymI_HasProto(memcpy) \
456 SymI_HasProto(rts_InstallConsoleEvent) \
457 SymI_HasProto(rts_ConsoleHandlerDone) \
458 SymI_NeedsProto(mktime) \
459 SymI_NeedsProto(_imp___timezone) \
460 SymI_NeedsProto(_imp___tzname) \
461 SymI_NeedsProto(_imp__tzname) \
462 SymI_NeedsProto(_imp___iob) \
463 SymI_NeedsProto(_imp___osver) \
464 SymI_NeedsProto(localtime) \
465 SymI_NeedsProto(gmtime) \
466 SymI_NeedsProto(opendir) \
467 SymI_NeedsProto(readdir) \
468 SymI_NeedsProto(rewinddir) \
469 SymI_NeedsProto(_imp____mb_cur_max) \
470 SymI_NeedsProto(_imp___pctype) \
471 SymI_NeedsProto(__chkstk) \
472 RTS_MINGW_GETTIMEOFDAY_SYM \
473 SymI_NeedsProto(closedir)
477 #if defined(darwin_HOST_OS) && HAVE_PRINTF_LDBLSTUB
478 #define RTS_DARWIN_ONLY_SYMBOLS \
479 SymI_NeedsProto(asprintf$LDBLStub) \
480 SymI_NeedsProto(err$LDBLStub) \
481 SymI_NeedsProto(errc$LDBLStub) \
482 SymI_NeedsProto(errx$LDBLStub) \
483 SymI_NeedsProto(fprintf$LDBLStub) \
484 SymI_NeedsProto(fscanf$LDBLStub) \
485 SymI_NeedsProto(fwprintf$LDBLStub) \
486 SymI_NeedsProto(fwscanf$LDBLStub) \
487 SymI_NeedsProto(printf$LDBLStub) \
488 SymI_NeedsProto(scanf$LDBLStub) \
489 SymI_NeedsProto(snprintf$LDBLStub) \
490 SymI_NeedsProto(sprintf$LDBLStub) \
491 SymI_NeedsProto(sscanf$LDBLStub) \
492 SymI_NeedsProto(strtold$LDBLStub) \
493 SymI_NeedsProto(swprintf$LDBLStub) \
494 SymI_NeedsProto(swscanf$LDBLStub) \
495 SymI_NeedsProto(syslog$LDBLStub) \
496 SymI_NeedsProto(vasprintf$LDBLStub) \
497 SymI_NeedsProto(verr$LDBLStub) \
498 SymI_NeedsProto(verrc$LDBLStub) \
499 SymI_NeedsProto(verrx$LDBLStub) \
500 SymI_NeedsProto(vfprintf$LDBLStub) \
501 SymI_NeedsProto(vfscanf$LDBLStub) \
502 SymI_NeedsProto(vfwprintf$LDBLStub) \
503 SymI_NeedsProto(vfwscanf$LDBLStub) \
504 SymI_NeedsProto(vprintf$LDBLStub) \
505 SymI_NeedsProto(vscanf$LDBLStub) \
506 SymI_NeedsProto(vsnprintf$LDBLStub) \
507 SymI_NeedsProto(vsprintf$LDBLStub) \
508 SymI_NeedsProto(vsscanf$LDBLStub) \
509 SymI_NeedsProto(vswprintf$LDBLStub) \
510 SymI_NeedsProto(vswscanf$LDBLStub) \
511 SymI_NeedsProto(vsyslog$LDBLStub) \
512 SymI_NeedsProto(vwarn$LDBLStub) \
513 SymI_NeedsProto(vwarnc$LDBLStub) \
514 SymI_NeedsProto(vwarnx$LDBLStub) \
515 SymI_NeedsProto(vwprintf$LDBLStub) \
516 SymI_NeedsProto(vwscanf$LDBLStub) \
517 SymI_NeedsProto(warn$LDBLStub) \
518 SymI_NeedsProto(warnc$LDBLStub) \
519 SymI_NeedsProto(warnx$LDBLStub) \
520 SymI_NeedsProto(wcstold$LDBLStub) \
521 SymI_NeedsProto(wprintf$LDBLStub) \
522 SymI_NeedsProto(wscanf$LDBLStub)
524 #define RTS_DARWIN_ONLY_SYMBOLS
528 # define MAIN_CAP_SYM SymI_HasProto(MainCapability)
530 # define MAIN_CAP_SYM
533 #if !defined(mingw32_HOST_OS)
534 #define RTS_USER_SIGNALS_SYMBOLS \
535 SymI_HasProto(setIOManagerControlFd) \
536 SymI_HasProto(setIOManagerWakeupFd) \
537 SymI_HasProto(ioManagerWakeup) \
538 SymI_HasProto(blockUserSignals) \
539 SymI_HasProto(unblockUserSignals)
541 #define RTS_USER_SIGNALS_SYMBOLS \
542 SymI_HasProto(ioManagerWakeup) \
543 SymI_HasProto(sendIOManagerEvent) \
544 SymI_HasProto(readIOManagerEvent) \
545 SymI_HasProto(getIOManagerEvent) \
546 SymI_HasProto(console_handler)
549 #define RTS_LIBFFI_SYMBOLS \
550 SymE_NeedsProto(ffi_prep_cif) \
551 SymE_NeedsProto(ffi_call) \
552 SymE_NeedsProto(ffi_type_void) \
553 SymE_NeedsProto(ffi_type_float) \
554 SymE_NeedsProto(ffi_type_double) \
555 SymE_NeedsProto(ffi_type_sint64) \
556 SymE_NeedsProto(ffi_type_uint64) \
557 SymE_NeedsProto(ffi_type_sint32) \
558 SymE_NeedsProto(ffi_type_uint32) \
559 SymE_NeedsProto(ffi_type_sint16) \
560 SymE_NeedsProto(ffi_type_uint16) \
561 SymE_NeedsProto(ffi_type_sint8) \
562 SymE_NeedsProto(ffi_type_uint8) \
563 SymE_NeedsProto(ffi_type_pointer)
565 #ifdef TABLES_NEXT_TO_CODE
566 #define RTS_RET_SYMBOLS /* nothing */
568 #define RTS_RET_SYMBOLS \
569 SymI_HasProto(stg_enter_ret) \
570 SymI_HasProto(stg_gc_fun_ret) \
571 SymI_HasProto(stg_ap_v_ret) \
572 SymI_HasProto(stg_ap_f_ret) \
573 SymI_HasProto(stg_ap_d_ret) \
574 SymI_HasProto(stg_ap_l_ret) \
575 SymI_HasProto(stg_ap_n_ret) \
576 SymI_HasProto(stg_ap_p_ret) \
577 SymI_HasProto(stg_ap_pv_ret) \
578 SymI_HasProto(stg_ap_pp_ret) \
579 SymI_HasProto(stg_ap_ppv_ret) \
580 SymI_HasProto(stg_ap_ppp_ret) \
581 SymI_HasProto(stg_ap_pppv_ret) \
582 SymI_HasProto(stg_ap_pppp_ret) \
583 SymI_HasProto(stg_ap_ppppp_ret) \
584 SymI_HasProto(stg_ap_pppppp_ret)
587 /* Modules compiled with -ticky may mention ticky counters */
588 /* This list should marry up with the one in $(TOP)/includes/stg/Ticky.h */
589 #define RTS_TICKY_SYMBOLS \
590 SymI_NeedsProto(ticky_entry_ctrs) \
591 SymI_NeedsProto(top_ct) \
593 SymI_HasProto(ENT_VIA_NODE_ctr) \
594 SymI_HasProto(ENT_STATIC_THK_ctr) \
595 SymI_HasProto(ENT_DYN_THK_ctr) \
596 SymI_HasProto(ENT_STATIC_FUN_DIRECT_ctr) \
597 SymI_HasProto(ENT_DYN_FUN_DIRECT_ctr) \
598 SymI_HasProto(ENT_STATIC_CON_ctr) \
599 SymI_HasProto(ENT_DYN_CON_ctr) \
600 SymI_HasProto(ENT_STATIC_IND_ctr) \
601 SymI_HasProto(ENT_DYN_IND_ctr) \
602 SymI_HasProto(ENT_PERM_IND_ctr) \
603 SymI_HasProto(ENT_PAP_ctr) \
604 SymI_HasProto(ENT_AP_ctr) \
605 SymI_HasProto(ENT_AP_STACK_ctr) \
606 SymI_HasProto(ENT_BH_ctr) \
607 SymI_HasProto(UNKNOWN_CALL_ctr) \
608 SymI_HasProto(SLOW_CALL_v_ctr) \
609 SymI_HasProto(SLOW_CALL_f_ctr) \
610 SymI_HasProto(SLOW_CALL_d_ctr) \
611 SymI_HasProto(SLOW_CALL_l_ctr) \
612 SymI_HasProto(SLOW_CALL_n_ctr) \
613 SymI_HasProto(SLOW_CALL_p_ctr) \
614 SymI_HasProto(SLOW_CALL_pv_ctr) \
615 SymI_HasProto(SLOW_CALL_pp_ctr) \
616 SymI_HasProto(SLOW_CALL_ppv_ctr) \
617 SymI_HasProto(SLOW_CALL_ppp_ctr) \
618 SymI_HasProto(SLOW_CALL_pppv_ctr) \
619 SymI_HasProto(SLOW_CALL_pppp_ctr) \
620 SymI_HasProto(SLOW_CALL_ppppp_ctr) \
621 SymI_HasProto(SLOW_CALL_pppppp_ctr) \
622 SymI_HasProto(SLOW_CALL_OTHER_ctr) \
623 SymI_HasProto(ticky_slow_call_unevald) \
624 SymI_HasProto(SLOW_CALL_ctr) \
625 SymI_HasProto(MULTI_CHUNK_SLOW_CALL_ctr) \
626 SymI_HasProto(MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr) \
627 SymI_HasProto(KNOWN_CALL_ctr) \
628 SymI_HasProto(KNOWN_CALL_TOO_FEW_ARGS_ctr) \
629 SymI_HasProto(KNOWN_CALL_EXTRA_ARGS_ctr) \
630 SymI_HasProto(SLOW_CALL_FUN_TOO_FEW_ctr) \
631 SymI_HasProto(SLOW_CALL_FUN_CORRECT_ctr) \
632 SymI_HasProto(SLOW_CALL_FUN_TOO_MANY_ctr) \
633 SymI_HasProto(SLOW_CALL_PAP_TOO_FEW_ctr) \
634 SymI_HasProto(SLOW_CALL_PAP_CORRECT_ctr) \
635 SymI_HasProto(SLOW_CALL_PAP_TOO_MANY_ctr) \
636 SymI_HasProto(SLOW_CALL_UNEVALD_ctr) \
637 SymI_HasProto(UPDF_OMITTED_ctr) \
638 SymI_HasProto(UPDF_PUSHED_ctr) \
639 SymI_HasProto(CATCHF_PUSHED_ctr) \
640 SymI_HasProto(UPDF_RCC_PUSHED_ctr) \
641 SymI_HasProto(UPDF_RCC_OMITTED_ctr) \
642 SymI_HasProto(UPD_SQUEEZED_ctr) \
643 SymI_HasProto(UPD_CON_IN_NEW_ctr) \
644 SymI_HasProto(UPD_CON_IN_PLACE_ctr) \
645 SymI_HasProto(UPD_PAP_IN_NEW_ctr) \
646 SymI_HasProto(UPD_PAP_IN_PLACE_ctr) \
647 SymI_HasProto(ALLOC_HEAP_ctr) \
648 SymI_HasProto(ALLOC_HEAP_tot) \
649 SymI_HasProto(ALLOC_FUN_ctr) \
650 SymI_HasProto(ALLOC_FUN_adm) \
651 SymI_HasProto(ALLOC_FUN_gds) \
652 SymI_HasProto(ALLOC_FUN_slp) \
653 SymI_HasProto(UPD_NEW_IND_ctr) \
654 SymI_HasProto(UPD_NEW_PERM_IND_ctr) \
655 SymI_HasProto(UPD_OLD_IND_ctr) \
656 SymI_HasProto(UPD_OLD_PERM_IND_ctr) \
657 SymI_HasProto(UPD_BH_UPDATABLE_ctr) \
658 SymI_HasProto(UPD_BH_SINGLE_ENTRY_ctr) \
659 SymI_HasProto(UPD_CAF_BH_UPDATABLE_ctr) \
660 SymI_HasProto(UPD_CAF_BH_SINGLE_ENTRY_ctr) \
661 SymI_HasProto(GC_SEL_ABANDONED_ctr) \
662 SymI_HasProto(GC_SEL_MINOR_ctr) \
663 SymI_HasProto(GC_SEL_MAJOR_ctr) \
664 SymI_HasProto(GC_FAILED_PROMOTION_ctr) \
665 SymI_HasProto(ALLOC_UP_THK_ctr) \
666 SymI_HasProto(ALLOC_SE_THK_ctr) \
667 SymI_HasProto(ALLOC_THK_adm) \
668 SymI_HasProto(ALLOC_THK_gds) \
669 SymI_HasProto(ALLOC_THK_slp) \
670 SymI_HasProto(ALLOC_CON_ctr) \
671 SymI_HasProto(ALLOC_CON_adm) \
672 SymI_HasProto(ALLOC_CON_gds) \
673 SymI_HasProto(ALLOC_CON_slp) \
674 SymI_HasProto(ALLOC_TUP_ctr) \
675 SymI_HasProto(ALLOC_TUP_adm) \
676 SymI_HasProto(ALLOC_TUP_gds) \
677 SymI_HasProto(ALLOC_TUP_slp) \
678 SymI_HasProto(ALLOC_BH_ctr) \
679 SymI_HasProto(ALLOC_BH_adm) \
680 SymI_HasProto(ALLOC_BH_gds) \
681 SymI_HasProto(ALLOC_BH_slp) \
682 SymI_HasProto(ALLOC_PRIM_ctr) \
683 SymI_HasProto(ALLOC_PRIM_adm) \
684 SymI_HasProto(ALLOC_PRIM_gds) \
685 SymI_HasProto(ALLOC_PRIM_slp) \
686 SymI_HasProto(ALLOC_PAP_ctr) \
687 SymI_HasProto(ALLOC_PAP_adm) \
688 SymI_HasProto(ALLOC_PAP_gds) \
689 SymI_HasProto(ALLOC_PAP_slp) \
690 SymI_HasProto(ALLOC_TSO_ctr) \
691 SymI_HasProto(ALLOC_TSO_adm) \
692 SymI_HasProto(ALLOC_TSO_gds) \
693 SymI_HasProto(ALLOC_TSO_slp) \
694 SymI_HasProto(RET_NEW_ctr) \
695 SymI_HasProto(RET_OLD_ctr) \
696 SymI_HasProto(RET_UNBOXED_TUP_ctr) \
697 SymI_HasProto(RET_SEMI_loads_avoided)
700 // On most platforms, the garbage collector rewrites references
701 // to small integer and char objects to a set of common, shared ones.
703 // We don't do this when compiling to Windows DLLs at the moment because
704 // it doesn't support cross package data references well.
706 #if defined(__PIC__) && defined(mingw32_HOST_OS)
707 #define RTS_INTCHAR_SYMBOLS
709 #define RTS_INTCHAR_SYMBOLS \
710 SymI_HasProto(stg_CHARLIKE_closure) \
711 SymI_HasProto(stg_INTLIKE_closure)
715 #define RTS_SYMBOLS \
718 SymI_HasProto(StgReturn) \
719 SymI_HasProto(stg_enter_info) \
720 SymI_HasProto(stg_gc_void_info) \
721 SymI_HasProto(__stg_gc_enter_1) \
722 SymI_HasProto(stg_gc_noregs) \
723 SymI_HasProto(stg_gc_unpt_r1_info) \
724 SymI_HasProto(stg_gc_unpt_r1) \
725 SymI_HasProto(stg_gc_unbx_r1_info) \
726 SymI_HasProto(stg_gc_unbx_r1) \
727 SymI_HasProto(stg_gc_f1_info) \
728 SymI_HasProto(stg_gc_f1) \
729 SymI_HasProto(stg_gc_d1_info) \
730 SymI_HasProto(stg_gc_d1) \
731 SymI_HasProto(stg_gc_l1_info) \
732 SymI_HasProto(stg_gc_l1) \
733 SymI_HasProto(__stg_gc_fun) \
734 SymI_HasProto(stg_gc_fun_info) \
735 SymI_HasProto(stg_gc_gen) \
736 SymI_HasProto(stg_gc_gen_info) \
737 SymI_HasProto(stg_gc_gen_hp) \
738 SymI_HasProto(stg_gc_ut) \
739 SymI_HasProto(stg_gen_yield) \
740 SymI_HasProto(stg_yield_noregs) \
741 SymI_HasProto(stg_yield_to_interpreter) \
742 SymI_HasProto(stg_gen_block) \
743 SymI_HasProto(stg_block_noregs) \
744 SymI_HasProto(stg_block_1) \
745 SymI_HasProto(stg_block_takemvar) \
746 SymI_HasProto(stg_block_putmvar) \
748 SymI_HasProto(MallocFailHook) \
749 SymI_HasProto(OnExitHook) \
750 SymI_HasProto(OutOfHeapHook) \
751 SymI_HasProto(StackOverflowHook) \
752 SymI_HasProto(addDLL) \
753 SymI_HasProto(__int_encodeDouble) \
754 SymI_HasProto(__word_encodeDouble) \
755 SymI_HasProto(__2Int_encodeDouble) \
756 SymI_HasProto(__int_encodeFloat) \
757 SymI_HasProto(__word_encodeFloat) \
758 SymI_HasProto(stg_atomicallyzh) \
759 SymI_HasProto(barf) \
760 SymI_HasProto(debugBelch) \
761 SymI_HasProto(errorBelch) \
762 SymI_HasProto(sysErrorBelch) \
763 SymI_HasProto(stg_getMaskingStatezh) \
764 SymI_HasProto(stg_maskAsyncExceptionszh) \
765 SymI_HasProto(stg_maskUninterruptiblezh) \
766 SymI_HasProto(stg_catchzh) \
767 SymI_HasProto(stg_catchRetryzh) \
768 SymI_HasProto(stg_catchSTMzh) \
769 SymI_HasProto(stg_checkzh) \
770 SymI_HasProto(closure_flags) \
771 SymI_HasProto(cmp_thread) \
772 SymI_HasProto(createAdjustor) \
773 SymI_HasProto(stg_decodeDoublezu2Intzh) \
774 SymI_HasProto(stg_decodeFloatzuIntzh) \
775 SymI_HasProto(defaultsHook) \
776 SymI_HasProto(stg_delayzh) \
777 SymI_HasProto(stg_deRefWeakzh) \
778 SymI_HasProto(stg_deRefStablePtrzh) \
779 SymI_HasProto(dirty_MUT_VAR) \
780 SymI_HasProto(stg_forkzh) \
781 SymI_HasProto(stg_forkOnzh) \
782 SymI_HasProto(forkProcess) \
783 SymI_HasProto(forkOS_createThread) \
784 SymI_HasProto(freeHaskellFunctionPtr) \
785 SymI_HasProto(getOrSetTypeableStore) \
786 SymI_HasProto(getOrSetGHCConcSignalSignalHandlerStore) \
787 SymI_HasProto(getOrSetGHCConcWindowsPendingDelaysStore) \
788 SymI_HasProto(getOrSetGHCConcWindowsIOManagerThreadStore) \
789 SymI_HasProto(getOrSetGHCConcWindowsProddingStore) \
790 SymI_HasProto(getOrSetSystemEventThreadEventManagerStore) \
791 SymI_HasProto(getOrSetSystemEventThreadIOManagerThreadStore) \
792 SymI_HasProto(genSymZh) \
793 SymI_HasProto(genericRaise) \
794 SymI_HasProto(getProgArgv) \
795 SymI_HasProto(getFullProgArgv) \
796 SymI_HasProto(getStablePtr) \
797 SymI_HasProto(hs_init) \
798 SymI_HasProto(hs_exit) \
799 SymI_HasProto(hs_set_argv) \
800 SymI_HasProto(hs_add_root) \
801 SymI_HasProto(hs_perform_gc) \
802 SymI_HasProto(hs_free_stable_ptr) \
803 SymI_HasProto(hs_free_fun_ptr) \
804 SymI_HasProto(hs_hpc_rootModule) \
805 SymI_HasProto(hs_hpc_module) \
806 SymI_HasProto(initLinker) \
807 SymI_HasProto(stg_unpackClosurezh) \
808 SymI_HasProto(stg_getApStackValzh) \
809 SymI_HasProto(stg_getSparkzh) \
810 SymI_HasProto(stg_numSparkszh) \
811 SymI_HasProto(stg_isCurrentThreadBoundzh) \
812 SymI_HasProto(stg_isEmptyMVarzh) \
813 SymI_HasProto(stg_killThreadzh) \
814 SymI_HasProto(loadArchive) \
815 SymI_HasProto(loadObj) \
816 SymI_HasProto(insertStableSymbol) \
817 SymI_HasProto(insertSymbol) \
818 SymI_HasProto(lookupSymbol) \
819 SymI_HasProto(stg_makeStablePtrzh) \
820 SymI_HasProto(stg_mkApUpd0zh) \
821 SymI_HasProto(stg_myThreadIdzh) \
822 SymI_HasProto(stg_labelThreadzh) \
823 SymI_HasProto(stg_newArrayzh) \
824 SymI_HasProto(stg_newBCOzh) \
825 SymI_HasProto(stg_newByteArrayzh) \
826 SymI_HasProto_redirect(newCAF, newDynCAF) \
827 SymI_HasProto(stg_newMVarzh) \
828 SymI_HasProto(stg_newMutVarzh) \
829 SymI_HasProto(stg_newTVarzh) \
830 SymI_HasProto(stg_noDuplicatezh) \
831 SymI_HasProto(stg_atomicModifyMutVarzh) \
832 SymI_HasProto(stg_newPinnedByteArrayzh) \
833 SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \
834 SymI_HasProto(newSpark) \
835 SymI_HasProto(performGC) \
836 SymI_HasProto(performMajorGC) \
837 SymI_HasProto(prog_argc) \
838 SymI_HasProto(prog_argv) \
839 SymI_HasProto(stg_putMVarzh) \
840 SymI_HasProto(stg_raisezh) \
841 SymI_HasProto(stg_raiseIOzh) \
842 SymI_HasProto(stg_readTVarzh) \
843 SymI_HasProto(stg_readTVarIOzh) \
844 SymI_HasProto(resumeThread) \
845 SymI_HasProto(resolveObjs) \
846 SymI_HasProto(stg_retryzh) \
847 SymI_HasProto(rts_apply) \
848 SymI_HasProto(rts_checkSchedStatus) \
849 SymI_HasProto(rts_eval) \
850 SymI_HasProto(rts_evalIO) \
851 SymI_HasProto(rts_evalLazyIO) \
852 SymI_HasProto(rts_evalStableIO) \
853 SymI_HasProto(rts_eval_) \
854 SymI_HasProto(rts_getBool) \
855 SymI_HasProto(rts_getChar) \
856 SymI_HasProto(rts_getDouble) \
857 SymI_HasProto(rts_getFloat) \
858 SymI_HasProto(rts_getInt) \
859 SymI_HasProto(rts_getInt8) \
860 SymI_HasProto(rts_getInt16) \
861 SymI_HasProto(rts_getInt32) \
862 SymI_HasProto(rts_getInt64) \
863 SymI_HasProto(rts_getPtr) \
864 SymI_HasProto(rts_getFunPtr) \
865 SymI_HasProto(rts_getStablePtr) \
866 SymI_HasProto(rts_getThreadId) \
867 SymI_HasProto(rts_getWord) \
868 SymI_HasProto(rts_getWord8) \
869 SymI_HasProto(rts_getWord16) \
870 SymI_HasProto(rts_getWord32) \
871 SymI_HasProto(rts_getWord64) \
872 SymI_HasProto(rts_lock) \
873 SymI_HasProto(rts_mkBool) \
874 SymI_HasProto(rts_mkChar) \
875 SymI_HasProto(rts_mkDouble) \
876 SymI_HasProto(rts_mkFloat) \
877 SymI_HasProto(rts_mkInt) \
878 SymI_HasProto(rts_mkInt8) \
879 SymI_HasProto(rts_mkInt16) \
880 SymI_HasProto(rts_mkInt32) \
881 SymI_HasProto(rts_mkInt64) \
882 SymI_HasProto(rts_mkPtr) \
883 SymI_HasProto(rts_mkFunPtr) \
884 SymI_HasProto(rts_mkStablePtr) \
885 SymI_HasProto(rts_mkString) \
886 SymI_HasProto(rts_mkWord) \
887 SymI_HasProto(rts_mkWord8) \
888 SymI_HasProto(rts_mkWord16) \
889 SymI_HasProto(rts_mkWord32) \
890 SymI_HasProto(rts_mkWord64) \
891 SymI_HasProto(rts_unlock) \
892 SymI_HasProto(rts_unsafeGetMyCapability) \
893 SymI_HasProto(rtsSupportsBoundThreads) \
894 SymI_HasProto(rts_isProfiled) \
895 SymI_HasProto(setProgArgv) \
896 SymI_HasProto(startupHaskell) \
897 SymI_HasProto(shutdownHaskell) \
898 SymI_HasProto(shutdownHaskellAndExit) \
899 SymI_HasProto(stable_ptr_table) \
900 SymI_HasProto(stackOverflow) \
901 SymI_HasProto(stg_CAF_BLACKHOLE_info) \
902 SymI_HasProto(stg_BLACKHOLE_info) \
903 SymI_HasProto(__stg_EAGER_BLACKHOLE_info) \
904 SymI_HasProto(stg_BLOCKING_QUEUE_CLEAN_info) \
905 SymI_HasProto(stg_BLOCKING_QUEUE_DIRTY_info) \
906 SymI_HasProto(startTimer) \
907 SymI_HasProto(stg_MVAR_CLEAN_info) \
908 SymI_HasProto(stg_MVAR_DIRTY_info) \
909 SymI_HasProto(stg_IND_STATIC_info) \
910 SymI_HasProto(stg_ARR_WORDS_info) \
911 SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info) \
912 SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info) \
913 SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN0_info) \
914 SymI_HasProto(stg_WEAK_info) \
915 SymI_HasProto(stg_ap_v_info) \
916 SymI_HasProto(stg_ap_f_info) \
917 SymI_HasProto(stg_ap_d_info) \
918 SymI_HasProto(stg_ap_l_info) \
919 SymI_HasProto(stg_ap_n_info) \
920 SymI_HasProto(stg_ap_p_info) \
921 SymI_HasProto(stg_ap_pv_info) \
922 SymI_HasProto(stg_ap_pp_info) \
923 SymI_HasProto(stg_ap_ppv_info) \
924 SymI_HasProto(stg_ap_ppp_info) \
925 SymI_HasProto(stg_ap_pppv_info) \
926 SymI_HasProto(stg_ap_pppp_info) \
927 SymI_HasProto(stg_ap_ppppp_info) \
928 SymI_HasProto(stg_ap_pppppp_info) \
929 SymI_HasProto(stg_ap_0_fast) \
930 SymI_HasProto(stg_ap_v_fast) \
931 SymI_HasProto(stg_ap_f_fast) \
932 SymI_HasProto(stg_ap_d_fast) \
933 SymI_HasProto(stg_ap_l_fast) \
934 SymI_HasProto(stg_ap_n_fast) \
935 SymI_HasProto(stg_ap_p_fast) \
936 SymI_HasProto(stg_ap_pv_fast) \
937 SymI_HasProto(stg_ap_pp_fast) \
938 SymI_HasProto(stg_ap_ppv_fast) \
939 SymI_HasProto(stg_ap_ppp_fast) \
940 SymI_HasProto(stg_ap_pppv_fast) \
941 SymI_HasProto(stg_ap_pppp_fast) \
942 SymI_HasProto(stg_ap_ppppp_fast) \
943 SymI_HasProto(stg_ap_pppppp_fast) \
944 SymI_HasProto(stg_ap_1_upd_info) \
945 SymI_HasProto(stg_ap_2_upd_info) \
946 SymI_HasProto(stg_ap_3_upd_info) \
947 SymI_HasProto(stg_ap_4_upd_info) \
948 SymI_HasProto(stg_ap_5_upd_info) \
949 SymI_HasProto(stg_ap_6_upd_info) \
950 SymI_HasProto(stg_ap_7_upd_info) \
951 SymI_HasProto(stg_exit) \
952 SymI_HasProto(stg_sel_0_upd_info) \
953 SymI_HasProto(stg_sel_10_upd_info) \
954 SymI_HasProto(stg_sel_11_upd_info) \
955 SymI_HasProto(stg_sel_12_upd_info) \
956 SymI_HasProto(stg_sel_13_upd_info) \
957 SymI_HasProto(stg_sel_14_upd_info) \
958 SymI_HasProto(stg_sel_15_upd_info) \
959 SymI_HasProto(stg_sel_1_upd_info) \
960 SymI_HasProto(stg_sel_2_upd_info) \
961 SymI_HasProto(stg_sel_3_upd_info) \
962 SymI_HasProto(stg_sel_4_upd_info) \
963 SymI_HasProto(stg_sel_5_upd_info) \
964 SymI_HasProto(stg_sel_6_upd_info) \
965 SymI_HasProto(stg_sel_7_upd_info) \
966 SymI_HasProto(stg_sel_8_upd_info) \
967 SymI_HasProto(stg_sel_9_upd_info) \
968 SymI_HasProto(stg_upd_frame_info) \
969 SymI_HasProto(stg_bh_upd_frame_info) \
970 SymI_HasProto(suspendThread) \
971 SymI_HasProto(stg_takeMVarzh) \
972 SymI_HasProto(stg_threadStatuszh) \
973 SymI_HasProto(stg_tryPutMVarzh) \
974 SymI_HasProto(stg_tryTakeMVarzh) \
975 SymI_HasProto(stg_unmaskAsyncExceptionszh) \
976 SymI_HasProto(unloadObj) \
977 SymI_HasProto(stg_unsafeThawArrayzh) \
978 SymI_HasProto(stg_waitReadzh) \
979 SymI_HasProto(stg_waitWritezh) \
980 SymI_HasProto(stg_writeTVarzh) \
981 SymI_HasProto(stg_yieldzh) \
982 SymI_NeedsProto(stg_interp_constr_entry) \
983 SymI_HasProto(stg_arg_bitmaps) \
984 SymI_HasProto(large_alloc_lim) \
986 SymI_HasProto(allocate) \
987 SymI_HasProto(allocateExec) \
988 SymI_HasProto(freeExec) \
989 SymI_HasProto(getAllocations) \
990 SymI_HasProto(revertCAFs) \
991 SymI_HasProto(RtsFlags) \
992 SymI_NeedsProto(rts_breakpoint_io_action) \
993 SymI_NeedsProto(rts_stop_next_breakpoint) \
994 SymI_NeedsProto(rts_stop_on_exception) \
995 SymI_HasProto(stopTimer) \
996 SymI_HasProto(n_capabilities) \
997 SymI_HasProto(stg_traceCcszh) \
998 SymI_HasProto(stg_traceEventzh) \
999 RTS_USER_SIGNALS_SYMBOLS \
1003 // 64-bit support functions in libgcc.a
1004 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
1005 #define RTS_LIBGCC_SYMBOLS \
1006 SymI_NeedsProto(__divdi3) \
1007 SymI_NeedsProto(__udivdi3) \
1008 SymI_NeedsProto(__moddi3) \
1009 SymI_NeedsProto(__umoddi3) \
1010 SymI_NeedsProto(__muldi3) \
1011 SymI_NeedsProto(__ashldi3) \
1012 SymI_NeedsProto(__ashrdi3) \
1013 SymI_NeedsProto(__lshrdi3)
1015 #define RTS_LIBGCC_SYMBOLS
1018 #if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
1019 // Symbols that don't have a leading underscore
1020 // on Mac OS X. They have to receive special treatment,
1021 // see machoInitSymbolsWithoutUnderscore()
1022 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
1023 SymI_NeedsProto(saveFP) \
1024 SymI_NeedsProto(restFP)
1027 /* entirely bogus claims about types of these symbols */
1028 #define SymI_NeedsProto(vvv) extern void vvv(void);
1029 #if defined(__PIC__) && defined(mingw32_HOST_OS)
1030 #define SymE_HasProto(vvv) SymE_HasProto(vvv);
1031 #define SymE_NeedsProto(vvv) extern void _imp__ ## vvv (void);
1033 #define SymE_NeedsProto(vvv) SymI_NeedsProto(vvv);
1034 #define SymE_HasProto(vvv) SymI_HasProto(vvv)
1036 #define SymI_HasProto(vvv) /**/
1037 #define SymI_HasProto_redirect(vvv,xxx) /**/
1040 RTS_POSIX_ONLY_SYMBOLS
1041 RTS_MINGW_ONLY_SYMBOLS
1042 RTS_CYGWIN_ONLY_SYMBOLS
1043 RTS_DARWIN_ONLY_SYMBOLS
1046 #undef SymI_NeedsProto
1047 #undef SymI_HasProto
1048 #undef SymI_HasProto_redirect
1049 #undef SymE_HasProto
1050 #undef SymE_NeedsProto
1052 #ifdef LEADING_UNDERSCORE
1053 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
1055 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
1058 #define SymI_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1060 #define SymE_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1061 (void*)DLL_IMPORT_DATA_REF(vvv) },
1063 #define SymI_NeedsProto(vvv) SymI_HasProto(vvv)
1064 #define SymE_NeedsProto(vvv) SymE_HasProto(vvv)
1066 // SymI_HasProto_redirect allows us to redirect references to one symbol to
1067 // another symbol. See newCAF/newDynCAF for an example.
1068 #define SymI_HasProto_redirect(vvv,xxx) \
1069 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1072 static RtsSymbolVal rtsSyms[] = {
1075 RTS_POSIX_ONLY_SYMBOLS
1076 RTS_MINGW_ONLY_SYMBOLS
1077 RTS_CYGWIN_ONLY_SYMBOLS
1078 RTS_DARWIN_ONLY_SYMBOLS
1081 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
1082 // dyld stub code contains references to this,
1083 // but it should never be called because we treat
1084 // lazy pointers as nonlazy.
1085 { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
1087 { 0, 0 } /* sentinel */
1092 /* -----------------------------------------------------------------------------
1093 * Insert symbols into hash tables, checking for duplicates.
1096 static void ghciInsertStrHashTable ( char* obj_name,
1102 if (lookupHashTable(table, (StgWord)key) == NULL)
1104 insertStrHashTable(table, (StgWord)key, data);
1109 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
1111 "whilst processing object file\n"
1113 "This could be caused by:\n"
1114 " * Loading two different object files which export the same symbol\n"
1115 " * Specifying the same object file twice on the GHCi command line\n"
1116 " * An incorrect `package.conf' entry, causing some object to be\n"
1118 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
1125 /* -----------------------------------------------------------------------------
1126 * initialize the object linker
1130 static int linker_init_done = 0 ;
1132 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1133 static void *dl_prog_handle;
1134 static regex_t re_invalid;
1135 static regex_t re_realso;
1137 static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
1145 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1149 IF_DEBUG(linker, debugBelch("initLinker: start\n"));
1151 /* Make initLinker idempotent, so we can call it
1152 before evey relevant operation; that means we
1153 don't need to initialise the linker separately */
1154 if (linker_init_done == 1) {
1155 IF_DEBUG(linker, debugBelch("initLinker: idempotent return\n"));
1158 linker_init_done = 1;
1161 #if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO))
1162 initMutex(&dl_mutex);
1164 stablehash = allocStrHashTable();
1165 symhash = allocStrHashTable();
1167 /* populate the symbol table with stuff from the RTS */
1168 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
1169 ghciInsertStrHashTable("(GHCi built-in symbols)",
1170 symhash, sym->lbl, sym->addr);
1171 IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr));
1173 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
1174 machoInitSymbolsWithoutUnderscore();
1177 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1178 # if defined(RTLD_DEFAULT)
1179 dl_prog_handle = RTLD_DEFAULT;
1181 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
1182 # endif /* RTLD_DEFAULT */
1184 compileResult = regcomp(&re_invalid,
1185 "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*invalid ELF header",
1187 ASSERT( compileResult == 0 );
1188 compileResult = regcomp(&re_realso,
1189 "GROUP *\\( *(([^ )])+)",
1191 ASSERT( compileResult == 0 );
1194 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
1195 if (RtsFlags.MiscFlags.linkerMemBase != 0) {
1196 // User-override for mmap_32bit_base
1197 mmap_32bit_base = (void*)RtsFlags.MiscFlags.linkerMemBase;
1201 #if defined(mingw32_HOST_OS)
1203 * These two libraries cause problems when added to the static link,
1204 * but are necessary for resolving symbols in GHCi, hence we load
1205 * them manually here.
1211 IF_DEBUG(linker, debugBelch("initLinker: done\n"));
1216 exitLinker( void ) {
1217 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1218 if (linker_init_done == 1) {
1219 regfree(&re_invalid);
1220 regfree(&re_realso);
1222 closeMutex(&dl_mutex);
1228 /* -----------------------------------------------------------------------------
1229 * Loading DLL or .so dynamic libraries
1230 * -----------------------------------------------------------------------------
1232 * Add a DLL from which symbols may be found. In the ELF case, just
1233 * do RTLD_GLOBAL-style add, so no further messing around needs to
1234 * happen in order that symbols in the loaded .so are findable --
1235 * lookupSymbol() will subsequently see them by dlsym on the program's
1236 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
1238 * In the PEi386 case, open the DLLs and put handles to them in a
1239 * linked list. When looking for a symbol, try all handles in the
1240 * list. This means that we need to load even DLLs that are guaranteed
1241 * to be in the ghc.exe image already, just so we can get a handle
1242 * to give to loadSymbol, so that we can find the symbols. For such
1243 * libraries, the LoadLibrary call should be a no-op except for returning
1248 #if defined(OBJFORMAT_PEi386)
1249 /* A record for storing handles into DLLs. */
1254 struct _OpenedDLL* next;
1259 /* A list thereof. */
1260 static OpenedDLL* opened_dlls = NULL;
1263 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1266 internal_dlopen(const char *dll_name)
1272 // omitted: RTLD_NOW
1273 // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
1275 debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name));
1277 //-------------- Begin critical section ------------------
1278 // This critical section is necessary because dlerror() is not
1279 // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008)
1280 // Also, the error message returned must be copied to preserve it
1283 ACQUIRE_LOCK(&dl_mutex);
1284 hdl = dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
1288 /* dlopen failed; return a ptr to the error msg. */
1290 if (errmsg == NULL) errmsg = "addDLL: unknown error";
1291 errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL");
1292 strcpy(errmsg_copy, errmsg);
1293 errmsg = errmsg_copy;
1295 RELEASE_LOCK(&dl_mutex);
1296 //--------------- End critical section -------------------
1303 addDLL( char *dll_name )
1305 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1306 /* ------------------- ELF DLL loader ------------------- */
1309 regmatch_t match[NMATCH];
1312 size_t match_length;
1313 #define MAXLINE 1000
1319 IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name));
1320 errmsg = internal_dlopen(dll_name);
1322 if (errmsg == NULL) {
1326 // GHC Trac ticket #2615
1327 // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so)
1328 // contain linker scripts rather than ELF-format object code. This
1329 // code handles the situation by recognizing the real object code
1330 // file name given in the linker script.
1332 // If an "invalid ELF header" error occurs, it is assumed that the
1333 // .so file contains a linker script instead of ELF object code.
1334 // In this case, the code looks for the GROUP ( ... ) linker
1335 // directive. If one is found, the first file name inside the
1336 // parentheses is treated as the name of a dynamic library and the
1337 // code attempts to dlopen that file. If this is also unsuccessful,
1338 // an error message is returned.
1340 // see if the error message is due to an invalid ELF header
1341 IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg));
1342 result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0);
1343 IF_DEBUG(linker, debugBelch("result = %i\n", result));
1345 // success -- try to read the named file as a linker script
1346 match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so),
1348 strncpy(line, (errmsg+(match[1].rm_so)),match_length);
1349 line[match_length] = '\0'; // make sure string is null-terminated
1350 IF_DEBUG(linker, debugBelch ("file name = '%s'\n", line));
1351 if ((fp = fopen(line, "r")) == NULL) {
1352 return errmsg; // return original error if open fails
1354 // try to find a GROUP ( ... ) command
1355 while (fgets(line, MAXLINE, fp) != NULL) {
1356 IF_DEBUG(linker, debugBelch("input line = %s", line));
1357 if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
1358 // success -- try to dlopen the first named file
1359 IF_DEBUG(linker, debugBelch("match%s\n",""));
1360 line[match[1].rm_eo] = '\0';
1361 errmsg = internal_dlopen(line+match[1].rm_so);
1364 // if control reaches here, no GROUP ( ... ) directive was found
1365 // and the original error message is returned to the caller
1371 # elif defined(OBJFORMAT_PEi386)
1372 /* ------------------- Win32 DLL loader ------------------- */
1380 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
1382 /* See if we've already got it, and ignore if so. */
1383 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1384 if (0 == strcmp(o_dll->name, dll_name))
1388 /* The file name has no suffix (yet) so that we can try
1389 both foo.dll and foo.drv
1391 The documentation for LoadLibrary says:
1392 If no file name extension is specified in the lpFileName
1393 parameter, the default library extension .dll is
1394 appended. However, the file name string can include a trailing
1395 point character (.) to indicate that the module name has no
1398 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
1399 sprintf(buf, "%s.DLL", dll_name);
1400 instance = LoadLibrary(buf);
1401 if (instance == NULL) {
1402 if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1403 // KAA: allow loading of drivers (like winspool.drv)
1404 sprintf(buf, "%s.DRV", dll_name);
1405 instance = LoadLibrary(buf);
1406 if (instance == NULL) {
1407 if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1408 // #1883: allow loading of unix-style libfoo.dll DLLs
1409 sprintf(buf, "lib%s.DLL", dll_name);
1410 instance = LoadLibrary(buf);
1411 if (instance == NULL) {
1418 /* Add this DLL to the list of DLLs in which to search for symbols. */
1419 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
1420 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
1421 strcpy(o_dll->name, dll_name);
1422 o_dll->instance = instance;
1423 o_dll->next = opened_dlls;
1424 opened_dlls = o_dll;
1430 sysErrorBelch(dll_name);
1432 /* LoadLibrary failed; return a ptr to the error msg. */
1433 return "addDLL: could not load DLL";
1436 barf("addDLL: not implemented on this platform");
1440 /* -----------------------------------------------------------------------------
1441 * insert a stable symbol in the hash table
1445 insertStableSymbol(char* obj_name, char* key, StgPtr p)
1447 ghciInsertStrHashTable(obj_name, stablehash, key, getStablePtr(p));
1451 /* -----------------------------------------------------------------------------
1452 * insert a symbol in the hash table
1455 insertSymbol(char* obj_name, char* key, void* data)
1457 ghciInsertStrHashTable(obj_name, symhash, key, data);
1460 /* -----------------------------------------------------------------------------
1461 * lookup a symbol in the hash table
1464 lookupSymbol( char *lbl )
1467 IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl));
1469 ASSERT(symhash != NULL);
1470 val = lookupStrHashTable(symhash, lbl);
1473 IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n"));
1474 # if defined(OBJFORMAT_ELF)
1475 return dlsym(dl_prog_handle, lbl);
1476 # elif defined(OBJFORMAT_MACHO)
1478 /* On OS X 10.3 and later, we use dlsym instead of the old legacy
1481 HACK: On OS X, global symbols are prefixed with an underscore.
1482 However, dlsym wants us to omit the leading underscore from the
1483 symbol name. For now, we simply strip it off here (and ONLY
1486 IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n", lbl));
1487 ASSERT(lbl[0] == '_');
1488 return dlsym(dl_prog_handle, lbl+1);
1490 if(NSIsSymbolNameDefined(lbl)) {
1491 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
1492 return NSAddressOfSymbol(symbol);
1496 # endif /* HAVE_DLFCN_H */
1497 # elif defined(OBJFORMAT_PEi386)
1500 sym = lookupSymbolInDLLs((unsigned char*)lbl);
1501 if (sym != NULL) { return sym; };
1503 // Also try looking up the symbol without the @N suffix. Some
1504 // DLLs have the suffixes on their symbols, some don't.
1505 zapTrailingAtSign ( (unsigned char*)lbl );
1506 sym = lookupSymbolInDLLs((unsigned char*)lbl);
1507 if (sym != NULL) { return sym; };
1515 IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p\n", lbl, val));
1520 /* -----------------------------------------------------------------------------
1521 * Debugging aid: look in GHCi's object symbol tables for symbols
1522 * within DELTA bytes of the specified address, and show their names.
1525 void ghci_enquire ( char* addr );
1527 void ghci_enquire ( char* addr )
1532 const int DELTA = 64;
1537 for (oc = objects; oc; oc = oc->next) {
1538 for (i = 0; i < oc->n_symbols; i++) {
1539 sym = oc->symbols[i];
1540 if (sym == NULL) continue;
1543 a = lookupStrHashTable(symhash, sym);
1546 // debugBelch("ghci_enquire: can't find %s\n", sym);
1548 else if (addr-DELTA <= a && a <= addr+DELTA) {
1549 debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym);
1557 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1560 mmapForLinker (size_t bytes, nat flags, int fd)
1562 void *map_addr = NULL;
1565 static nat fixed = 0;
1567 pagesize = getpagesize();
1568 size = ROUND_UP(bytes, pagesize);
1570 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
1573 if (mmap_32bit_base != 0) {
1574 map_addr = mmap_32bit_base;
1578 result = mmap(map_addr, size, PROT_EXEC|PROT_READ|PROT_WRITE,
1579 MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, 0);
1581 if (result == MAP_FAILED) {
1582 sysErrorBelch("mmap %lu bytes at %p",(lnat)size,map_addr);
1583 errorBelch("Try specifying an address with +RTS -xm<addr> -RTS");
1584 stg_exit(EXIT_FAILURE);
1587 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
1588 if (mmap_32bit_base != 0) {
1589 if (result == map_addr) {
1590 mmap_32bit_base = (StgWord8*)map_addr + size;
1592 if ((W_)result > 0x80000000) {
1593 // oops, we were given memory over 2Gb
1594 #if defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) || defined(dragonfly_HOST_OS)
1595 // Some platforms require MAP_FIXED. This is normally
1596 // a bad idea, because MAP_FIXED will overwrite
1597 // existing mappings.
1598 munmap(result,size);
1602 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);
1605 // hmm, we were given memory somewhere else, but it's
1606 // still under 2Gb so we can use it. Next time, ask
1607 // for memory right after the place we just got some
1608 mmap_32bit_base = (StgWord8*)result + size;
1612 if ((W_)result > 0x80000000) {
1613 // oops, we were given memory over 2Gb
1614 // ... try allocating memory somewhere else?;
1615 debugTrace(DEBUG_linker,"MAP_32BIT didn't work; gave us %lu bytes at 0x%p", bytes, result);
1616 munmap(result, size);
1618 // Set a base address and try again... (guess: 1Gb)
1619 mmap_32bit_base = (void*)0x40000000;
1630 mkOc( char *path, char *image, int imageSize,
1631 char *archiveMemberName
1633 #ifdef darwin_HOST_OS
1640 oc = stgMallocBytes(sizeof(ObjectCode), "loadArchive(oc)");
1642 # if defined(OBJFORMAT_ELF)
1643 oc->formatName = "ELF";
1644 # elif defined(OBJFORMAT_PEi386)
1645 oc->formatName = "PEi386";
1646 # elif defined(OBJFORMAT_MACHO)
1647 oc->formatName = "Mach-O";
1650 barf("loadObj: not implemented on this platform");
1654 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1655 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1656 strcpy(oc->fileName, path);
1658 if (archiveMemberName) {
1659 oc->archiveMemberName = stgMallocBytes( strlen(archiveMemberName)+1, "loadObj" );
1660 strcpy(oc->archiveMemberName, archiveMemberName);
1663 oc->archiveMemberName = NULL;
1666 oc->fileSize = imageSize;
1668 oc->sections = NULL;
1669 oc->proddables = NULL;
1672 #ifdef darwin_HOST_OS
1673 oc->misalignment = misalignment;
1677 /* chain it onto the list of objects */
1685 loadArchive( char *path )
1692 size_t thisFileNameSize;
1694 size_t fileNameSize;
1695 int isObject, isGnuIndex;
1698 int gnuFileIndexSize;
1699 #if !defined(USE_MMAP) && defined(darwin_HOST_OS)
1703 IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%s'\n", path));
1705 gnuFileIndex = NULL;
1706 gnuFileIndexSize = 0;
1709 fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)");
1711 f = fopen(path, "rb");
1713 barf("loadObj: can't read `%s'", path);
1715 n = fread ( tmp, 1, 8, f );
1716 if (strncmp(tmp, "!<arch>\n", 8) != 0)
1717 barf("loadArchive: Not an archive: `%s'", path);
1720 n = fread ( fileName, 1, 16, f );
1726 barf("loadArchive: Failed reading file name from `%s'", path);
1729 n = fread ( tmp, 1, 12, f );
1731 barf("loadArchive: Failed reading mod time from `%s'", path);
1732 n = fread ( tmp, 1, 6, f );
1734 barf("loadArchive: Failed reading owner from `%s'", path);
1735 n = fread ( tmp, 1, 6, f );
1737 barf("loadArchive: Failed reading group from `%s'", path);
1738 n = fread ( tmp, 1, 8, f );
1740 barf("loadArchive: Failed reading mode from `%s'", path);
1741 n = fread ( tmp, 1, 10, f );
1743 barf("loadArchive: Failed reading size from `%s'", path);
1745 for (n = 0; isdigit(tmp[n]); n++);
1747 memberSize = atoi(tmp);
1748 n = fread ( tmp, 1, 2, f );
1749 if (strncmp(tmp, "\x60\x0A", 2) != 0)
1750 barf("loadArchive: Failed reading magic from `%s' at %ld. Got %c%c",
1751 path, ftell(f), tmp[0], tmp[1]);
1754 /* Check for BSD-variant large filenames */
1755 if (0 == strncmp(fileName, "#1/", 3)) {
1756 fileName[16] = '\0';
1757 if (isdigit(fileName[3])) {
1758 for (n = 4; isdigit(fileName[n]); n++);
1760 thisFileNameSize = atoi(fileName + 3);
1761 memberSize -= thisFileNameSize;
1762 if (thisFileNameSize >= fileNameSize) {
1763 /* Double it to avoid potentially continually
1764 increasing it by 1 */
1765 fileNameSize = thisFileNameSize * 2;
1766 fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
1768 n = fread ( fileName, 1, thisFileNameSize, f );
1769 if (n != (int)thisFileNameSize) {
1770 barf("loadArchive: Failed reading filename from `%s'",
1773 fileName[thisFileNameSize] = 0;
1776 barf("loadArchive: BSD-variant filename size not found while reading filename from `%s'", path);
1779 /* Check for GNU file index file */
1780 else if (0 == strncmp(fileName, "//", 2)) {
1782 thisFileNameSize = 0;
1785 /* Check for a file in the GNU file index */
1786 else if (fileName[0] == '/') {
1787 if (isdigit(fileName[1])) {
1790 for (n = 2; isdigit(fileName[n]); n++);
1792 n = atoi(fileName + 1);
1794 if (gnuFileIndex == NULL) {
1795 barf("loadArchive: GNU-variant filename without an index while reading from `%s'", path);
1797 if (n < 0 || n > gnuFileIndexSize) {
1798 barf("loadArchive: GNU-variant filename offset %d out of range [0..%d] while reading filename from `%s'", n, gnuFileIndexSize, path);
1800 if (n != 0 && gnuFileIndex[n - 1] != '\n') {
1801 barf("loadArchive: GNU-variant filename offset %d invalid (range [0..%d]) while reading filename from `%s'", n, gnuFileIndexSize, path);
1803 for (i = n; gnuFileIndex[i] != '/'; i++);
1804 thisFileNameSize = i - n;
1805 if (thisFileNameSize >= fileNameSize) {
1806 /* Double it to avoid potentially continually
1807 increasing it by 1 */
1808 fileNameSize = thisFileNameSize * 2;
1809 fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
1811 memcpy(fileName, gnuFileIndex + n, thisFileNameSize);
1812 fileName[thisFileNameSize] = '\0';
1814 else if (fileName[1] == ' ') {
1816 thisFileNameSize = 0;
1819 barf("loadArchive: GNU-variant filename offset not found while reading filename from `%s'", path);
1822 /* Finally, the case where the filename field actually contains
1825 /* GNU ar terminates filenames with a '/', this allowing
1826 spaces in filenames. So first look to see if there is a
1828 for (thisFileNameSize = 0;
1829 thisFileNameSize < 16;
1830 thisFileNameSize++) {
1831 if (fileName[thisFileNameSize] == '/') {
1832 fileName[thisFileNameSize] = '\0';
1836 /* If we didn't find a '/', then a space teminates the
1837 filename. Note that if we don't find one, then
1838 thisFileNameSize ends up as 16, and we already have the
1840 if (thisFileNameSize == 16) {
1841 for (thisFileNameSize = 0;
1842 thisFileNameSize < 16;
1843 thisFileNameSize++) {
1844 if (fileName[thisFileNameSize] == ' ') {
1845 fileName[thisFileNameSize] = '\0';
1853 debugBelch("loadArchive: Found member file `%s'\n", fileName));
1855 isObject = thisFileNameSize >= 2
1856 && fileName[thisFileNameSize - 2] == '.'
1857 && fileName[thisFileNameSize - 1] == 'o';
1860 char *archiveMemberName;
1862 IF_DEBUG(linker, debugBelch("loadArchive: Member is an object file...loading...\n"));
1864 /* We can't mmap from the archive directly, as object
1865 files need to be 8-byte aligned but files in .ar
1866 archives are 2-byte aligned. When possible we use mmap
1867 to get some anonymous memory, as on 64-bit platforms if
1868 we use malloc then we can be given memory above 2^32.
1869 In the mmap case we're probably wasting lots of space;
1870 we could do better. */
1871 #if defined(USE_MMAP)
1872 image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1);
1873 #elif defined(darwin_HOST_OS)
1875 misalignment = machoGetMisalignment(f);
1876 image = stgMallocBytes(memberSize + misalignment, "loadArchive(image)");
1877 image += misalignment;
1879 image = stgMallocBytes(memberSize, "loadArchive(image)");
1881 n = fread ( image, 1, memberSize, f );
1882 if (n != memberSize) {
1883 barf("loadArchive: error whilst reading `%s'", path);
1886 archiveMemberName = stgMallocBytes(strlen(path) + thisFileNameSize + 3,
1887 "loadArchive(file)");
1888 sprintf(archiveMemberName, "%s(%.*s)",
1889 path, (int)thisFileNameSize, fileName);
1891 oc = mkOc(path, image, memberSize, archiveMemberName
1893 #ifdef darwin_HOST_OS
1899 stgFree(archiveMemberName);
1901 if (0 == loadOc(oc)) {
1906 else if (isGnuIndex) {
1907 if (gnuFileIndex != NULL) {
1908 barf("loadArchive: GNU-variant index found, but already have an index, while reading filename from `%s'", path);
1910 IF_DEBUG(linker, debugBelch("loadArchive: Found GNU-variant file index\n"));
1912 gnuFileIndex = mmapForLinker(memberSize + 1, MAP_ANONYMOUS, -1);
1914 gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)");
1916 n = fread ( gnuFileIndex, 1, memberSize, f );
1917 if (n != memberSize) {
1918 barf("loadArchive: error whilst reading `%s'", path);
1920 gnuFileIndex[memberSize] = '/';
1921 gnuFileIndexSize = memberSize;
1924 n = fseek(f, memberSize, SEEK_CUR);
1926 barf("loadArchive: error whilst seeking by %d in `%s'",
1929 /* .ar files are 2-byte aligned */
1930 if (memberSize % 2) {
1931 n = fread ( tmp, 1, 1, f );
1937 barf("loadArchive: Failed reading padding from `%s'", path);
1946 if (gnuFileIndex != NULL) {
1948 munmap(gnuFileIndex, gnuFileIndexSize + 1);
1950 stgFree(gnuFileIndex);
1957 /* -----------------------------------------------------------------------------
1958 * Load an obj (populate the global symbol table, but don't resolve yet)
1960 * Returns: 1 if ok, 0 on error.
1963 loadObj( char *path )
1974 # if defined(darwin_HOST_OS)
1978 IF_DEBUG(linker, debugBelch("loadObj %s\n", path));
1982 /* debugBelch("loadObj %s\n", path ); */
1984 /* Check that we haven't already loaded this object.
1985 Ignore requests to load multiple times */
1989 for (o = objects; o; o = o->next) {
1990 if (0 == strcmp(o->fileName, path)) {
1992 break; /* don't need to search further */
1996 IF_DEBUG(linker, debugBelch(
1997 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1998 "same object file twice:\n"
2000 "GHCi will ignore this, but be warned.\n"
2002 return 1; /* success */
2006 r = stat(path, &st);
2008 IF_DEBUG(linker, debugBelch("File doesn't exist\n"));
2012 fileSize = st.st_size;
2015 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
2017 #if defined(openbsd_HOST_OS)
2018 fd = open(path, O_RDONLY, S_IRUSR);
2020 fd = open(path, O_RDONLY);
2023 barf("loadObj: can't open `%s'", path);
2025 image = mmapForLinker(fileSize, 0, fd);
2029 #else /* !USE_MMAP */
2030 /* load the image into memory */
2031 f = fopen(path, "rb");
2033 barf("loadObj: can't read `%s'", path);
2035 # if defined(mingw32_HOST_OS)
2036 // TODO: We would like to use allocateExec here, but allocateExec
2037 // cannot currently allocate blocks large enough.
2038 image = VirtualAlloc(NULL, fileSize, MEM_RESERVE | MEM_COMMIT,
2039 PAGE_EXECUTE_READWRITE);
2040 # elif defined(darwin_HOST_OS)
2041 // In a Mach-O .o file, all sections can and will be misaligned
2042 // if the total size of the headers is not a multiple of the
2043 // desired alignment. This is fine for .o files that only serve
2044 // as input for the static linker, but it's not fine for us,
2045 // as SSE (used by gcc for floating point) and Altivec require
2046 // 16-byte alignment.
2047 // We calculate the correct alignment from the header before
2048 // reading the file, and then we misalign image on purpose so
2049 // that the actual sections end up aligned again.
2050 misalignment = machoGetMisalignment(f);
2051 image = stgMallocBytes(fileSize + misalignment, "loadObj(image)");
2052 image += misalignment;
2054 image = stgMallocBytes(fileSize, "loadObj(image)");
2059 n = fread ( image, 1, fileSize, f );
2061 barf("loadObj: error whilst reading `%s'", path);
2064 #endif /* USE_MMAP */
2066 oc = mkOc(path, image, fileSize, NULL
2068 #ifdef darwin_HOST_OS
2078 loadOc( ObjectCode* oc ) {
2081 IF_DEBUG(linker, debugBelch("loadOc\n"));
2083 # if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
2084 r = ocAllocateSymbolExtras_MachO ( oc );
2086 IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO failed\n"));
2089 # elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
2090 r = ocAllocateSymbolExtras_ELF ( oc );
2092 IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_ELF failed\n"));
2097 /* verify the in-memory image */
2098 # if defined(OBJFORMAT_ELF)
2099 r = ocVerifyImage_ELF ( oc );
2100 # elif defined(OBJFORMAT_PEi386)
2101 r = ocVerifyImage_PEi386 ( oc );
2102 # elif defined(OBJFORMAT_MACHO)
2103 r = ocVerifyImage_MachO ( oc );
2105 barf("loadObj: no verify method");
2108 IF_DEBUG(linker, debugBelch("ocVerifyImage_* failed\n"));
2112 /* build the symbol list for this image */
2113 # if defined(OBJFORMAT_ELF)
2114 r = ocGetNames_ELF ( oc );
2115 # elif defined(OBJFORMAT_PEi386)
2116 r = ocGetNames_PEi386 ( oc );
2117 # elif defined(OBJFORMAT_MACHO)
2118 r = ocGetNames_MachO ( oc );
2120 barf("loadObj: no getNames method");
2123 IF_DEBUG(linker, debugBelch("ocGetNames_* failed\n"));
2127 /* loaded, but not resolved yet */
2128 oc->status = OBJECT_LOADED;
2129 IF_DEBUG(linker, debugBelch("loadObj done.\n"));
2134 /* -----------------------------------------------------------------------------
2135 * resolve all the currently unlinked objects in memory
2137 * Returns: 1 if ok, 0 on error.
2145 IF_DEBUG(linker, debugBelch("resolveObjs: start\n"));
2148 for (oc = objects; oc; oc = oc->next) {
2149 if (oc->status != OBJECT_RESOLVED) {
2150 # if defined(OBJFORMAT_ELF)
2151 r = ocResolve_ELF ( oc );
2152 # elif defined(OBJFORMAT_PEi386)
2153 r = ocResolve_PEi386 ( oc );
2154 # elif defined(OBJFORMAT_MACHO)
2155 r = ocResolve_MachO ( oc );
2157 barf("resolveObjs: not implemented on this platform");
2159 if (!r) { return r; }
2160 oc->status = OBJECT_RESOLVED;
2163 IF_DEBUG(linker, debugBelch("resolveObjs: done\n"));
2167 /* -----------------------------------------------------------------------------
2168 * delete an object from the pool
2171 unloadObj( char *path )
2173 ObjectCode *oc, *prev;
2174 HsBool unloadedAnyObj = HS_BOOL_FALSE;
2176 ASSERT(symhash != NULL);
2177 ASSERT(objects != NULL);
2182 for (oc = objects; oc; prev = oc, oc = oc->next) {
2183 if (!strcmp(oc->fileName,path)) {
2185 /* Remove all the mappings for the symbols within this
2190 for (i = 0; i < oc->n_symbols; i++) {
2191 if (oc->symbols[i] != NULL) {
2192 removeStrHashTable(symhash, oc->symbols[i], NULL);
2200 prev->next = oc->next;
2203 // We're going to leave this in place, in case there are
2204 // any pointers from the heap into it:
2205 // #ifdef mingw32_HOST_OS
2206 // VirtualFree(oc->image);
2208 // stgFree(oc->image);
2210 stgFree(oc->fileName);
2211 stgFree(oc->symbols);
2212 stgFree(oc->sections);
2215 /* This could be a member of an archive so continue
2216 * unloading other members. */
2217 unloadedAnyObj = HS_BOOL_TRUE;
2221 if (unloadedAnyObj) {
2225 errorBelch("unloadObj: can't find `%s' to unload", path);
2230 /* -----------------------------------------------------------------------------
2231 * Sanity checking. For each ObjectCode, maintain a list of address ranges
2232 * which may be prodded during relocation, and abort if we try and write
2233 * outside any of these.
2235 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
2238 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
2239 IF_DEBUG(linker, debugBelch("addProddableBlock %p %p %d\n", oc, start, size));
2243 pb->next = oc->proddables;
2244 oc->proddables = pb;
2247 static void checkProddableBlock ( ObjectCode* oc, void* addr )
2250 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
2251 char* s = (char*)(pb->start);
2252 char* e = s + pb->size - 1;
2253 char* a = (char*)addr;
2254 /* Assumes that the biggest fixup involves a 4-byte write. This
2255 probably needs to be changed to 8 (ie, +7) on 64-bit
2257 if (a >= s && (a+3) <= e) return;
2259 barf("checkProddableBlock: invalid fixup in runtime linker");
2262 /* -----------------------------------------------------------------------------
2263 * Section management.
2265 static void addSection ( ObjectCode* oc, SectionKind kind,
2266 void* start, void* end )
2268 Section* s = stgMallocBytes(sizeof(Section), "addSection");
2272 s->next = oc->sections;
2275 debugBelch("addSection: %p-%p (size %d), kind %d\n",
2276 start, ((char*)end)-1, end - start + 1, kind );
2281 /* --------------------------------------------------------------------------
2283 * This is about allocating a small chunk of memory for every symbol in the
2284 * object file. We make sure that the SymboLExtras are always "in range" of
2285 * limited-range PC-relative instructions on various platforms by allocating
2286 * them right next to the object code itself.
2289 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
2292 ocAllocateSymbolExtras
2294 Allocate additional space at the end of the object file image to make room
2295 for jump islands (powerpc, x86_64) and GOT entries (x86_64).
2297 PowerPC relative branch instructions have a 24 bit displacement field.
2298 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
2299 If a particular imported symbol is outside this range, we have to redirect
2300 the jump to a short piece of new code that just loads the 32bit absolute
2301 address and jumps there.
2302 On x86_64, PC-relative jumps and PC-relative accesses to the GOT are limited
2305 This function just allocates space for one SymbolExtra for every
2306 undefined symbol in the object file. The code for the jump islands is
2307 filled in by makeSymbolExtra below.
2310 static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
2317 int misalignment = 0;
2318 #ifdef darwin_HOST_OS
2319 misalignment = oc->misalignment;
2325 // round up to the nearest 4
2326 aligned = (oc->fileSize + 3) & ~3;
2329 pagesize = getpagesize();
2330 n = ROUND_UP( oc->fileSize, pagesize );
2331 m = ROUND_UP( aligned + sizeof (SymbolExtra) * count, pagesize );
2333 /* we try to use spare space at the end of the last page of the
2334 * image for the jump islands, but if there isn't enough space
2335 * then we have to map some (anonymously, remembering MAP_32BIT).
2337 if( m > n ) // we need to allocate more pages
2339 oc->symbol_extras = mmapForLinker(sizeof(SymbolExtra) * count,
2344 oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
2347 oc->image -= misalignment;
2348 oc->image = stgReallocBytes( oc->image,
2350 aligned + sizeof (SymbolExtra) * count,
2351 "ocAllocateSymbolExtras" );
2352 oc->image += misalignment;
2354 oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
2355 #endif /* USE_MMAP */
2357 memset( oc->symbol_extras, 0, sizeof (SymbolExtra) * count );
2360 oc->symbol_extras = NULL;
2362 oc->first_symbol_extra = first;
2363 oc->n_symbol_extras = count;
2368 static SymbolExtra* makeSymbolExtra( ObjectCode* oc,
2369 unsigned long symbolNumber,
2370 unsigned long target )
2374 ASSERT( symbolNumber >= oc->first_symbol_extra
2375 && symbolNumber - oc->first_symbol_extra < oc->n_symbol_extras);
2377 extra = &oc->symbol_extras[symbolNumber - oc->first_symbol_extra];
2379 #ifdef powerpc_HOST_ARCH
2380 // lis r12, hi16(target)
2381 extra->jumpIsland.lis_r12 = 0x3d80;
2382 extra->jumpIsland.hi_addr = target >> 16;
2384 // ori r12, r12, lo16(target)
2385 extra->jumpIsland.ori_r12_r12 = 0x618c;
2386 extra->jumpIsland.lo_addr = target & 0xffff;
2389 extra->jumpIsland.mtctr_r12 = 0x7d8903a6;
2392 extra->jumpIsland.bctr = 0x4e800420;
2394 #ifdef x86_64_HOST_ARCH
2396 static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
2397 extra->addr = target;
2398 memcpy(extra->jumpIsland, jmp, 6);
2406 /* --------------------------------------------------------------------------
2407 * PowerPC specifics (instruction cache flushing)
2408 * ------------------------------------------------------------------------*/
2410 #ifdef powerpc_HOST_ARCH
2412 ocFlushInstructionCache
2414 Flush the data & instruction caches.
2415 Because the PPC has split data/instruction caches, we have to
2416 do that whenever we modify code at runtime.
2418 static void ocFlushInstructionCacheFrom(void* begin, size_t length)
2420 size_t n = (length + 3) / 4;
2421 unsigned long* p = begin;
2425 __asm__ volatile ( "dcbf 0,%0\n\t"
2433 __asm__ volatile ( "sync\n\t"
2437 static void ocFlushInstructionCache( ObjectCode *oc )
2439 /* The main object code */
2440 ocFlushInstructionCacheFrom(oc->image + oc->misalignment, oc->fileSize);
2443 ocFlushInstructionCacheFrom(oc->symbol_extras, sizeof(SymbolExtra) * oc->n_symbol_extras);
2447 /* --------------------------------------------------------------------------
2448 * PEi386 specifics (Win32 targets)
2449 * ------------------------------------------------------------------------*/
2451 /* The information for this linker comes from
2452 Microsoft Portable Executable
2453 and Common Object File Format Specification
2454 revision 5.1 January 1998
2455 which SimonM says comes from the MS Developer Network CDs.
2457 It can be found there (on older CDs), but can also be found
2460 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
2462 (this is Rev 6.0 from February 1999).
2464 Things move, so if that fails, try searching for it via
2466 http://www.google.com/search?q=PE+COFF+specification
2468 The ultimate reference for the PE format is the Winnt.h
2469 header file that comes with the Platform SDKs; as always,
2470 implementations will drift wrt their documentation.
2472 A good background article on the PE format is Matt Pietrek's
2473 March 1994 article in Microsoft System Journal (MSJ)
2474 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
2475 Win32 Portable Executable File Format." The info in there
2476 has recently been updated in a two part article in
2477 MSDN magazine, issues Feb and March 2002,
2478 "Inside Windows: An In-Depth Look into the Win32 Portable
2479 Executable File Format"
2481 John Levine's book "Linkers and Loaders" contains useful
2486 #if defined(OBJFORMAT_PEi386)
2490 typedef unsigned char UChar;
2491 typedef unsigned short UInt16;
2492 typedef unsigned int UInt32;
2499 UInt16 NumberOfSections;
2500 UInt32 TimeDateStamp;
2501 UInt32 PointerToSymbolTable;
2502 UInt32 NumberOfSymbols;
2503 UInt16 SizeOfOptionalHeader;
2504 UInt16 Characteristics;
2508 #define sizeof_COFF_header 20
2515 UInt32 VirtualAddress;
2516 UInt32 SizeOfRawData;
2517 UInt32 PointerToRawData;
2518 UInt32 PointerToRelocations;
2519 UInt32 PointerToLinenumbers;
2520 UInt16 NumberOfRelocations;
2521 UInt16 NumberOfLineNumbers;
2522 UInt32 Characteristics;
2526 #define sizeof_COFF_section 40
2533 UInt16 SectionNumber;
2536 UChar NumberOfAuxSymbols;
2540 #define sizeof_COFF_symbol 18
2545 UInt32 VirtualAddress;
2546 UInt32 SymbolTableIndex;
2551 #define sizeof_COFF_reloc 10
2554 /* From PE spec doc, section 3.3.2 */
2555 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
2556 windows.h -- for the same purpose, but I want to know what I'm
2558 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
2559 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
2560 #define MYIMAGE_FILE_DLL 0x2000
2561 #define MYIMAGE_FILE_SYSTEM 0x1000
2562 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
2563 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
2564 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
2566 /* From PE spec doc, section 5.4.2 and 5.4.4 */
2567 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
2568 #define MYIMAGE_SYM_CLASS_STATIC 3
2569 #define MYIMAGE_SYM_UNDEFINED 0
2571 /* From PE spec doc, section 4.1 */
2572 #define MYIMAGE_SCN_CNT_CODE 0x00000020
2573 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
2574 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
2576 /* From PE spec doc, section 5.2.1 */
2577 #define MYIMAGE_REL_I386_DIR32 0x0006
2578 #define MYIMAGE_REL_I386_REL32 0x0014
2581 /* We use myindex to calculate array addresses, rather than
2582 simply doing the normal subscript thing. That's because
2583 some of the above structs have sizes which are not
2584 a whole number of words. GCC rounds their sizes up to a
2585 whole number of words, which means that the address calcs
2586 arising from using normal C indexing or pointer arithmetic
2587 are just plain wrong. Sigh.
2590 myindex ( int scale, void* base, int index )
2593 ((UChar*)base) + scale * index;
2598 printName ( UChar* name, UChar* strtab )
2600 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2601 UInt32 strtab_offset = * (UInt32*)(name+4);
2602 debugBelch("%s", strtab + strtab_offset );
2605 for (i = 0; i < 8; i++) {
2606 if (name[i] == 0) break;
2607 debugBelch("%c", name[i] );
2614 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
2616 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2617 UInt32 strtab_offset = * (UInt32*)(name+4);
2618 strncpy ( (char*)dst, (char*)strtab+strtab_offset, dstSize );
2624 if (name[i] == 0) break;
2634 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
2637 /* If the string is longer than 8 bytes, look in the
2638 string table for it -- this will be correctly zero terminated.
2640 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2641 UInt32 strtab_offset = * (UInt32*)(name+4);
2642 return ((UChar*)strtab) + strtab_offset;
2644 /* Otherwise, if shorter than 8 bytes, return the original,
2645 which by defn is correctly terminated.
2647 if (name[7]==0) return name;
2648 /* The annoying case: 8 bytes. Copy into a temporary
2649 (XXX which is never freed ...)
2651 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
2653 strncpy((char*)newstr,(char*)name,8);
2658 /* Getting the name of a section is mildly tricky, so we make a
2659 function for it. Sadly, in one case we have to copy the string
2660 (when it is exactly 8 bytes long there's no trailing '\0'), so for
2661 consistency we *always* copy the string; the caller must free it
2664 cstring_from_section_name (UChar* name, UChar* strtab)
2669 int strtab_offset = strtol((char*)name+1,NULL,10);
2670 int len = strlen(((char*)strtab) + strtab_offset);
2672 newstr = stgMallocBytes(len, "cstring_from_section_symbol_name");
2673 strcpy((char*)newstr, (char*)((UChar*)strtab) + strtab_offset);
2678 newstr = stgMallocBytes(9, "cstring_from_section_symbol_name");
2680 strncpy((char*)newstr,(char*)name,8);
2686 /* Just compares the short names (first 8 chars) */
2687 static COFF_section *
2688 findPEi386SectionCalled ( ObjectCode* oc, UChar* name )
2692 = (COFF_header*)(oc->image);
2693 COFF_section* sectab
2695 ((UChar*)(oc->image))
2696 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2698 for (i = 0; i < hdr->NumberOfSections; i++) {
2701 COFF_section* section_i
2703 myindex ( sizeof_COFF_section, sectab, i );
2704 n1 = (UChar*) &(section_i->Name);
2706 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
2707 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
2708 n1[6]==n2[6] && n1[7]==n2[7])
2717 zapTrailingAtSign ( UChar* sym )
2719 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
2721 if (sym[0] == 0) return;
2723 while (sym[i] != 0) i++;
2726 while (j > 0 && my_isdigit(sym[j])) j--;
2727 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
2732 lookupSymbolInDLLs ( UChar *lbl )
2737 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
2738 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
2740 if (lbl[0] == '_') {
2741 /* HACK: if the name has an initial underscore, try stripping
2742 it off & look that up first. I've yet to verify whether there's
2743 a Rule that governs whether an initial '_' *should always* be
2744 stripped off when mapping from import lib name to the DLL name.
2746 sym = GetProcAddress(o_dll->instance, (char*)(lbl+1));
2748 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
2752 sym = GetProcAddress(o_dll->instance, (char*)lbl);
2754 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
2763 ocVerifyImage_PEi386 ( ObjectCode* oc )
2768 COFF_section* sectab;
2769 COFF_symbol* symtab;
2771 /* debugBelch("\nLOADING %s\n", oc->fileName); */
2772 hdr = (COFF_header*)(oc->image);
2773 sectab = (COFF_section*) (
2774 ((UChar*)(oc->image))
2775 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2777 symtab = (COFF_symbol*) (
2778 ((UChar*)(oc->image))
2779 + hdr->PointerToSymbolTable
2781 strtab = ((UChar*)symtab)
2782 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2784 if (hdr->Machine != 0x14c) {
2785 errorBelch("%s: Not x86 PEi386", oc->fileName);
2788 if (hdr->SizeOfOptionalHeader != 0) {
2789 errorBelch("%s: PEi386 with nonempty optional header", oc->fileName);
2792 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
2793 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
2794 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
2795 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
2796 errorBelch("%s: Not a PEi386 object file", oc->fileName);
2799 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
2800 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
2801 errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
2803 (int)(hdr->Characteristics));
2806 /* If the string table size is way crazy, this might indicate that
2807 there are more than 64k relocations, despite claims to the
2808 contrary. Hence this test. */
2809 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
2811 if ( (*(UInt32*)strtab) > 600000 ) {
2812 /* Note that 600k has no special significance other than being
2813 big enough to handle the almost-2MB-sized lumps that
2814 constitute HSwin32*.o. */
2815 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
2820 /* No further verification after this point; only debug printing. */
2822 IF_DEBUG(linker, i=1);
2823 if (i == 0) return 1;
2825 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
2826 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
2827 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
2830 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
2831 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
2832 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
2833 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
2834 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
2835 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
2836 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
2838 /* Print the section table. */
2840 for (i = 0; i < hdr->NumberOfSections; i++) {
2842 COFF_section* sectab_i
2844 myindex ( sizeof_COFF_section, sectab, i );
2851 printName ( sectab_i->Name, strtab );
2861 sectab_i->VirtualSize,
2862 sectab_i->VirtualAddress,
2863 sectab_i->SizeOfRawData,
2864 sectab_i->PointerToRawData,
2865 sectab_i->NumberOfRelocations,
2866 sectab_i->PointerToRelocations,
2867 sectab_i->PointerToRawData
2869 reltab = (COFF_reloc*) (
2870 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2873 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2874 /* If the relocation field (a short) has overflowed, the
2875 * real count can be found in the first reloc entry.
2877 * See Section 4.1 (last para) of the PE spec (rev6.0).
2879 COFF_reloc* rel = (COFF_reloc*)
2880 myindex ( sizeof_COFF_reloc, reltab, 0 );
2881 noRelocs = rel->VirtualAddress;
2884 noRelocs = sectab_i->NumberOfRelocations;
2888 for (; j < noRelocs; j++) {
2890 COFF_reloc* rel = (COFF_reloc*)
2891 myindex ( sizeof_COFF_reloc, reltab, j );
2893 " type 0x%-4x vaddr 0x%-8x name `",
2895 rel->VirtualAddress );
2896 sym = (COFF_symbol*)
2897 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
2898 /* Hmm..mysterious looking offset - what's it for? SOF */
2899 printName ( sym->Name, strtab -10 );
2906 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
2907 debugBelch("---START of string table---\n");
2908 for (i = 4; i < *(Int32*)strtab; i++) {
2910 debugBelch("\n"); else
2911 debugBelch("%c", strtab[i] );
2913 debugBelch("--- END of string table---\n");
2918 COFF_symbol* symtab_i;
2919 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2920 symtab_i = (COFF_symbol*)
2921 myindex ( sizeof_COFF_symbol, symtab, i );
2927 printName ( symtab_i->Name, strtab );
2936 (Int32)(symtab_i->SectionNumber),
2937 (UInt32)symtab_i->Type,
2938 (UInt32)symtab_i->StorageClass,
2939 (UInt32)symtab_i->NumberOfAuxSymbols
2941 i += symtab_i->NumberOfAuxSymbols;
2951 ocGetNames_PEi386 ( ObjectCode* oc )
2954 COFF_section* sectab;
2955 COFF_symbol* symtab;
2962 hdr = (COFF_header*)(oc->image);
2963 sectab = (COFF_section*) (
2964 ((UChar*)(oc->image))
2965 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2967 symtab = (COFF_symbol*) (
2968 ((UChar*)(oc->image))
2969 + hdr->PointerToSymbolTable
2971 strtab = ((UChar*)(oc->image))
2972 + hdr->PointerToSymbolTable
2973 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2975 /* Allocate space for any (local, anonymous) .bss sections. */
2977 for (i = 0; i < hdr->NumberOfSections; i++) {
2980 COFF_section* sectab_i
2982 myindex ( sizeof_COFF_section, sectab, i );
2984 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
2986 if (0 != strcmp(secname, ".bss")) {
2993 /* sof 10/05: the PE spec text isn't too clear regarding what
2994 * the SizeOfRawData field is supposed to hold for object
2995 * file sections containing just uninitialized data -- for executables,
2996 * it is supposed to be zero; unclear what it's supposed to be
2997 * for object files. However, VirtualSize is guaranteed to be
2998 * zero for object files, which definitely suggests that SizeOfRawData
2999 * will be non-zero (where else would the size of this .bss section be
3000 * stored?) Looking at the COFF_section info for incoming object files,
3001 * this certainly appears to be the case.
3003 * => I suspect we've been incorrectly handling .bss sections in (relocatable)
3004 * object files up until now. This turned out to bite us with ghc-6.4.1's use
3005 * of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
3006 * variable decls into to the .bss section. (The specific function in Q which
3007 * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
3009 if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
3010 /* This is a non-empty .bss section. Allocate zeroed space for
3011 it, and set its PointerToRawData field such that oc->image +
3012 PointerToRawData == addr_of_zeroed_space. */
3013 bss_sz = sectab_i->VirtualSize;
3014 if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
3015 zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
3016 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
3017 addProddableBlock(oc, zspace, bss_sz);
3018 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
3021 /* Copy section information into the ObjectCode. */
3023 for (i = 0; i < hdr->NumberOfSections; i++) {
3029 = SECTIONKIND_OTHER;
3030 COFF_section* sectab_i
3032 myindex ( sizeof_COFF_section, sectab, i );
3034 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
3036 IF_DEBUG(linker, debugBelch("section name = %s\n", secname ));
3039 /* I'm sure this is the Right Way to do it. However, the
3040 alternative of testing the sectab_i->Name field seems to
3041 work ok with Cygwin.
3043 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
3044 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
3045 kind = SECTIONKIND_CODE_OR_RODATA;
3048 if (0==strcmp(".text",(char*)secname) ||
3049 0==strcmp(".rdata",(char*)secname)||
3050 0==strcmp(".rodata",(char*)secname))
3051 kind = SECTIONKIND_CODE_OR_RODATA;
3052 if (0==strcmp(".data",(char*)secname) ||
3053 0==strcmp(".bss",(char*)secname))
3054 kind = SECTIONKIND_RWDATA;
3056 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
3057 sz = sectab_i->SizeOfRawData;
3058 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
3060 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
3061 end = start + sz - 1;
3063 if (kind == SECTIONKIND_OTHER
3064 /* Ignore sections called which contain stabs debugging
3066 && 0 != strcmp(".stab", (char*)secname)
3067 && 0 != strcmp(".stabstr", (char*)secname)
3068 /* ignore constructor section for now */
3069 && 0 != strcmp(".ctors", (char*)secname)
3070 /* ignore section generated from .ident */
3071 && 0!= strncmp(".debug", (char*)secname, 6)
3072 /* ignore unknown section that appeared in gcc 3.4.5(?) */
3073 && 0!= strcmp(".reloc", (char*)secname)
3074 && 0 != strcmp(".rdata$zzz", (char*)secname)
3076 errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", secname, oc->fileName);
3081 if (kind != SECTIONKIND_OTHER && end >= start) {
3082 addSection(oc, kind, start, end);
3083 addProddableBlock(oc, start, end - start + 1);
3089 /* Copy exported symbols into the ObjectCode. */
3091 oc->n_symbols = hdr->NumberOfSymbols;
3092 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3093 "ocGetNames_PEi386(oc->symbols)");
3094 /* Call me paranoid; I don't care. */
3095 for (i = 0; i < oc->n_symbols; i++)
3096 oc->symbols[i] = NULL;
3100 COFF_symbol* symtab_i;
3101 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
3102 symtab_i = (COFF_symbol*)
3103 myindex ( sizeof_COFF_symbol, symtab, i );
3107 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
3108 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
3109 /* This symbol is global and defined, viz, exported */
3110 /* for MYIMAGE_SYMCLASS_EXTERNAL
3111 && !MYIMAGE_SYM_UNDEFINED,
3112 the address of the symbol is:
3113 address of relevant section + offset in section
3115 COFF_section* sectabent
3116 = (COFF_section*) myindex ( sizeof_COFF_section,
3118 symtab_i->SectionNumber-1 );
3119 addr = ((UChar*)(oc->image))
3120 + (sectabent->PointerToRawData
3124 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
3125 && symtab_i->Value > 0) {
3126 /* This symbol isn't in any section at all, ie, global bss.
3127 Allocate zeroed space for it. */
3128 addr = stgCallocBytes(1, symtab_i->Value,
3129 "ocGetNames_PEi386(non-anonymous bss)");
3130 addSection(oc, SECTIONKIND_RWDATA, addr,
3131 ((UChar*)addr) + symtab_i->Value - 1);
3132 addProddableBlock(oc, addr, symtab_i->Value);
3133 /* debugBelch("BSS section at 0x%x\n", addr); */
3136 if (addr != NULL ) {
3137 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
3138 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
3139 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
3140 ASSERT(i >= 0 && i < oc->n_symbols);
3141 /* cstring_from_COFF_symbol_name always succeeds. */
3142 oc->symbols[i] = (char*)sname;
3143 ghciInsertStrHashTable(oc->fileName, symhash, (char*)sname, addr);
3147 "IGNORING symbol %d\n"
3151 printName ( symtab_i->Name, strtab );
3160 (Int32)(symtab_i->SectionNumber),
3161 (UInt32)symtab_i->Type,
3162 (UInt32)symtab_i->StorageClass,
3163 (UInt32)symtab_i->NumberOfAuxSymbols
3168 i += symtab_i->NumberOfAuxSymbols;
3177 ocResolve_PEi386 ( ObjectCode* oc )
3180 COFF_section* sectab;
3181 COFF_symbol* symtab;
3191 /* ToDo: should be variable-sized? But is at least safe in the
3192 sense of buffer-overrun-proof. */
3194 /* debugBelch("resolving for %s\n", oc->fileName); */
3196 hdr = (COFF_header*)(oc->image);
3197 sectab = (COFF_section*) (
3198 ((UChar*)(oc->image))
3199 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
3201 symtab = (COFF_symbol*) (
3202 ((UChar*)(oc->image))
3203 + hdr->PointerToSymbolTable
3205 strtab = ((UChar*)(oc->image))
3206 + hdr->PointerToSymbolTable
3207 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
3209 for (i = 0; i < hdr->NumberOfSections; i++) {
3210 COFF_section* sectab_i
3212 myindex ( sizeof_COFF_section, sectab, i );
3215 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
3218 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
3220 /* Ignore sections called which contain stabs debugging
3222 if (0 == strcmp(".stab", (char*)secname)
3223 || 0 == strcmp(".stabstr", (char*)secname)
3224 || 0 == strcmp(".ctors", (char*)secname)
3225 || 0 == strncmp(".debug", (char*)secname, 6)
3226 || 0 == strcmp(".rdata$zzz", (char*)secname)) {
3233 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
3234 /* If the relocation field (a short) has overflowed, the
3235 * real count can be found in the first reloc entry.
3237 * See Section 4.1 (last para) of the PE spec (rev6.0).
3239 * Nov2003 update: the GNU linker still doesn't correctly
3240 * handle the generation of relocatable object files with
3241 * overflown relocations. Hence the output to warn of potential
3244 COFF_reloc* rel = (COFF_reloc*)
3245 myindex ( sizeof_COFF_reloc, reltab, 0 );
3246 noRelocs = rel->VirtualAddress;
3248 /* 10/05: we now assume (and check for) a GNU ld that is capable
3249 * of handling object files with (>2^16) of relocs.
3252 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
3257 noRelocs = sectab_i->NumberOfRelocations;
3262 for (; j < noRelocs; j++) {
3264 COFF_reloc* reltab_j
3266 myindex ( sizeof_COFF_reloc, reltab, j );
3268 /* the location to patch */
3270 ((UChar*)(oc->image))
3271 + (sectab_i->PointerToRawData
3272 + reltab_j->VirtualAddress
3273 - sectab_i->VirtualAddress )
3275 /* the existing contents of pP */
3277 /* the symbol to connect to */
3278 sym = (COFF_symbol*)
3279 myindex ( sizeof_COFF_symbol,
3280 symtab, reltab_j->SymbolTableIndex );
3283 "reloc sec %2d num %3d: type 0x%-4x "
3284 "vaddr 0x%-8x name `",
3286 (UInt32)reltab_j->Type,
3287 reltab_j->VirtualAddress );
3288 printName ( sym->Name, strtab );
3289 debugBelch("'\n" ));
3291 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
3292 COFF_section* section_sym
3293 = findPEi386SectionCalled ( oc, sym->Name );
3295 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
3298 S = ((UInt32)(oc->image))
3299 + (section_sym->PointerToRawData
3302 copyName ( sym->Name, strtab, symbol, 1000-1 );
3303 S = (UInt32) lookupSymbol( (char*)symbol );
3304 if ((void*)S != NULL) goto foundit;
3305 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3309 checkProddableBlock(oc, pP);
3310 switch (reltab_j->Type) {
3311 case MYIMAGE_REL_I386_DIR32:
3314 case MYIMAGE_REL_I386_REL32:
3315 /* Tricky. We have to insert a displacement at
3316 pP which, when added to the PC for the _next_
3317 insn, gives the address of the target (S).
3318 Problem is to know the address of the next insn
3319 when we only know pP. We assume that this
3320 literal field is always the last in the insn,
3321 so that the address of the next insn is pP+4
3322 -- hence the constant 4.
3323 Also I don't know if A should be added, but so
3324 far it has always been zero.
3326 SOF 05/2005: 'A' (old contents of *pP) have been observed
3327 to contain values other than zero (the 'wx' object file
3328 that came with wxhaskell-0.9.4; dunno how it was compiled..).
3329 So, add displacement to old value instead of asserting
3330 A to be zero. Fixes wxhaskell-related crashes, and no other
3331 ill effects have been observed.
3333 Update: the reason why we're seeing these more elaborate
3334 relocations is due to a switch in how the NCG compiles SRTs
3335 and offsets to them from info tables. SRTs live in .(ro)data,
3336 while info tables live in .text, causing GAS to emit REL32/DISP32
3337 relocations with non-zero values. Adding the displacement is
3338 the right thing to do.
3340 *pP = S - ((UInt32)pP) - 4 + A;
3343 debugBelch("%s: unhandled PEi386 relocation type %d",
3344 oc->fileName, reltab_j->Type);
3351 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
3355 #endif /* defined(OBJFORMAT_PEi386) */
3358 /* --------------------------------------------------------------------------
3360 * ------------------------------------------------------------------------*/
3362 #if defined(OBJFORMAT_ELF)
3367 #if defined(sparc_HOST_ARCH)
3368 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
3369 #elif defined(i386_HOST_ARCH)
3370 # define ELF_TARGET_386 /* Used inside <elf.h> */
3371 #elif defined(x86_64_HOST_ARCH)
3372 # define ELF_TARGET_X64_64
3376 #if !defined(openbsd_HOST_OS)
3379 /* openbsd elf has things in different places, with diff names */
3380 # include <elf_abi.h>
3381 # include <machine/reloc.h>
3382 # define R_386_32 RELOC_32
3383 # define R_386_PC32 RELOC_PC32
3386 /* If elf.h doesn't define it */
3387 # ifndef R_X86_64_PC64
3388 # define R_X86_64_PC64 24
3392 * Define a set of types which can be used for both ELF32 and ELF64
3396 #define ELFCLASS ELFCLASS64
3397 #define Elf_Addr Elf64_Addr
3398 #define Elf_Word Elf64_Word
3399 #define Elf_Sword Elf64_Sword
3400 #define Elf_Ehdr Elf64_Ehdr
3401 #define Elf_Phdr Elf64_Phdr
3402 #define Elf_Shdr Elf64_Shdr
3403 #define Elf_Sym Elf64_Sym
3404 #define Elf_Rel Elf64_Rel
3405 #define Elf_Rela Elf64_Rela
3407 #define ELF_ST_TYPE ELF64_ST_TYPE
3410 #define ELF_ST_BIND ELF64_ST_BIND
3413 #define ELF_R_TYPE ELF64_R_TYPE
3416 #define ELF_R_SYM ELF64_R_SYM
3419 #define ELFCLASS ELFCLASS32
3420 #define Elf_Addr Elf32_Addr
3421 #define Elf_Word Elf32_Word
3422 #define Elf_Sword Elf32_Sword
3423 #define Elf_Ehdr Elf32_Ehdr
3424 #define Elf_Phdr Elf32_Phdr
3425 #define Elf_Shdr Elf32_Shdr
3426 #define Elf_Sym Elf32_Sym
3427 #define Elf_Rel Elf32_Rel
3428 #define Elf_Rela Elf32_Rela
3430 #define ELF_ST_TYPE ELF32_ST_TYPE
3433 #define ELF_ST_BIND ELF32_ST_BIND
3436 #define ELF_R_TYPE ELF32_R_TYPE
3439 #define ELF_R_SYM ELF32_R_SYM
3445 * Functions to allocate entries in dynamic sections. Currently we simply
3446 * preallocate a large number, and we don't check if a entry for the given
3447 * target already exists (a linear search is too slow). Ideally these
3448 * entries would be associated with symbols.
3451 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
3452 #define GOT_SIZE 0x20000
3453 #define FUNCTION_TABLE_SIZE 0x10000
3454 #define PLT_SIZE 0x08000
3457 static Elf_Addr got[GOT_SIZE];
3458 static unsigned int gotIndex;
3459 static Elf_Addr gp_val = (Elf_Addr)got;
3462 allocateGOTEntry(Elf_Addr target)
3466 if (gotIndex >= GOT_SIZE)
3467 barf("Global offset table overflow");
3469 entry = &got[gotIndex++];
3471 return (Elf_Addr)entry;
3475 #ifdef ELF_FUNCTION_DESC
3481 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
3482 static unsigned int functionTableIndex;
3485 allocateFunctionDesc(Elf_Addr target)
3487 FunctionDesc *entry;
3489 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
3490 barf("Function table overflow");
3492 entry = &functionTable[functionTableIndex++];
3494 entry->gp = (Elf_Addr)gp_val;
3495 return (Elf_Addr)entry;
3499 copyFunctionDesc(Elf_Addr target)
3501 FunctionDesc *olddesc = (FunctionDesc *)target;
3502 FunctionDesc *newdesc;
3504 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
3505 newdesc->gp = olddesc->gp;
3506 return (Elf_Addr)newdesc;
3513 unsigned char code[sizeof(plt_code)];
3517 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
3519 PLTEntry *plt = (PLTEntry *)oc->plt;
3522 if (oc->pltIndex >= PLT_SIZE)
3523 barf("Procedure table overflow");
3525 entry = &plt[oc->pltIndex++];
3526 memcpy(entry->code, plt_code, sizeof(entry->code));
3527 PLT_RELOC(entry->code, target);
3528 return (Elf_Addr)entry;
3534 return (PLT_SIZE * sizeof(PLTEntry));
3540 * Generic ELF functions
3544 findElfSection ( void* objImage, Elf_Word sh_type )
3546 char* ehdrC = (char*)objImage;
3547 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3548 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
3549 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
3553 for (i = 0; i < ehdr->e_shnum; i++) {
3554 if (shdr[i].sh_type == sh_type
3555 /* Ignore the section header's string table. */
3556 && i != ehdr->e_shstrndx
3557 /* Ignore string tables named .stabstr, as they contain
3559 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
3561 ptr = ehdrC + shdr[i].sh_offset;
3569 ocVerifyImage_ELF ( ObjectCode* oc )
3573 int i, j, nent, nstrtab, nsymtabs;
3577 char* ehdrC = (char*)(oc->image);
3578 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3580 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
3581 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
3582 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
3583 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
3584 errorBelch("%s: not an ELF object", oc->fileName);
3588 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
3589 errorBelch("%s: unsupported ELF format", oc->fileName);
3593 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
3594 IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
3596 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
3597 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
3599 errorBelch("%s: unknown endiannness", oc->fileName);
3603 if (ehdr->e_type != ET_REL) {
3604 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
3607 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
3609 IF_DEBUG(linker,debugBelch( "Architecture is " ));
3610 switch (ehdr->e_machine) {
3611 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
3612 #ifdef EM_SPARC32PLUS
3613 case EM_SPARC32PLUS:
3615 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
3617 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
3619 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
3621 case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
3622 #elif defined(EM_AMD64)
3623 case EM_AMD64: IF_DEBUG(linker,debugBelch( "amd64" )); break;
3625 default: IF_DEBUG(linker,debugBelch( "unknown" ));
3626 errorBelch("%s: unknown architecture (e_machine == %d)"
3627 , oc->fileName, ehdr->e_machine);
3631 IF_DEBUG(linker,debugBelch(
3632 "\nSection header table: start %ld, n_entries %d, ent_size %d\n",
3633 (long)ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
3635 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
3637 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3639 if (ehdr->e_shstrndx == SHN_UNDEF) {
3640 errorBelch("%s: no section header string table", oc->fileName);
3643 IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
3645 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
3648 for (i = 0; i < ehdr->e_shnum; i++) {
3649 IF_DEBUG(linker,debugBelch("%2d: ", i ));
3650 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
3651 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
3652 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
3653 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
3654 ehdrC + shdr[i].sh_offset,
3655 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
3657 if (shdr[i].sh_type == SHT_REL) {
3658 IF_DEBUG(linker,debugBelch("Rel " ));
3659 } else if (shdr[i].sh_type == SHT_RELA) {
3660 IF_DEBUG(linker,debugBelch("RelA " ));
3662 IF_DEBUG(linker,debugBelch(" "));
3665 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
3669 IF_DEBUG(linker,debugBelch( "\nString tables" ));
3672 for (i = 0; i < ehdr->e_shnum; i++) {
3673 if (shdr[i].sh_type == SHT_STRTAB
3674 /* Ignore the section header's string table. */
3675 && i != ehdr->e_shstrndx
3676 /* Ignore string tables named .stabstr, as they contain
3678 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
3680 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
3681 strtab = ehdrC + shdr[i].sh_offset;
3686 errorBelch("%s: no string tables, or too many", oc->fileName);
3691 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
3692 for (i = 0; i < ehdr->e_shnum; i++) {
3693 if (shdr[i].sh_type != SHT_SYMTAB) continue;
3694 IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
3696 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
3697 nent = shdr[i].sh_size / sizeof(Elf_Sym);
3698 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%ld rem)\n",
3700 (long)shdr[i].sh_size % sizeof(Elf_Sym)
3702 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
3703 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
3706 for (j = 0; j < nent; j++) {
3707 IF_DEBUG(linker,debugBelch(" %2d ", j ));
3708 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
3709 (int)stab[j].st_shndx,
3710 (int)stab[j].st_size,
3711 (char*)stab[j].st_value ));
3713 IF_DEBUG(linker,debugBelch("type=" ));
3714 switch (ELF_ST_TYPE(stab[j].st_info)) {
3715 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
3716 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
3717 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
3718 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
3719 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
3720 default: IF_DEBUG(linker,debugBelch("? " )); break;
3722 IF_DEBUG(linker,debugBelch(" " ));
3724 IF_DEBUG(linker,debugBelch("bind=" ));
3725 switch (ELF_ST_BIND(stab[j].st_info)) {
3726 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
3727 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
3728 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
3729 default: IF_DEBUG(linker,debugBelch("? " )); break;
3731 IF_DEBUG(linker,debugBelch(" " ));
3733 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
3737 if (nsymtabs == 0) {
3738 errorBelch("%s: didn't find any symbol tables", oc->fileName);
3745 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
3749 if (hdr->sh_type == SHT_PROGBITS
3750 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
3751 /* .text-style section */
3752 return SECTIONKIND_CODE_OR_RODATA;
3755 if (hdr->sh_type == SHT_PROGBITS
3756 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3757 /* .data-style section */
3758 return SECTIONKIND_RWDATA;
3761 if (hdr->sh_type == SHT_PROGBITS
3762 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
3763 /* .rodata-style section */
3764 return SECTIONKIND_CODE_OR_RODATA;
3767 if (hdr->sh_type == SHT_NOBITS
3768 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3769 /* .bss-style section */
3771 return SECTIONKIND_RWDATA;
3774 return SECTIONKIND_OTHER;
3779 ocGetNames_ELF ( ObjectCode* oc )
3784 char* ehdrC = (char*)(oc->image);
3785 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3786 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
3787 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3789 ASSERT(symhash != NULL);
3792 errorBelch("%s: no strtab", oc->fileName);
3797 for (i = 0; i < ehdr->e_shnum; i++) {
3798 /* Figure out what kind of section it is. Logic derived from
3799 Figure 1.14 ("Special Sections") of the ELF document
3800 ("Portable Formats Specification, Version 1.1"). */
3802 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
3804 if (is_bss && shdr[i].sh_size > 0) {
3805 /* This is a non-empty .bss section. Allocate zeroed space for
3806 it, and set its .sh_offset field such that
3807 ehdrC + .sh_offset == addr_of_zeroed_space. */
3808 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
3809 "ocGetNames_ELF(BSS)");
3810 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
3812 debugBelch("BSS section at 0x%x, size %d\n",
3813 zspace, shdr[i].sh_size);
3817 /* fill in the section info */
3818 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
3819 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
3820 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
3821 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
3824 if (shdr[i].sh_type != SHT_SYMTAB) continue;
3826 /* copy stuff into this module's object symbol table */
3827 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
3828 nent = shdr[i].sh_size / sizeof(Elf_Sym);
3830 oc->n_symbols = nent;
3831 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3832 "ocGetNames_ELF(oc->symbols)");
3834 for (j = 0; j < nent; j++) {
3836 char isLocal = FALSE; /* avoids uninit-var warning */
3838 char* nm = strtab + stab[j].st_name;
3839 int secno = stab[j].st_shndx;
3841 /* Figure out if we want to add it; if so, set ad to its
3842 address. Otherwise leave ad == NULL. */
3844 if (secno == SHN_COMMON) {
3846 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
3848 debugBelch("COMMON symbol, size %d name %s\n",
3849 stab[j].st_size, nm);
3851 /* Pointless to do addProddableBlock() for this area,
3852 since the linker should never poke around in it. */
3855 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
3856 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
3858 /* and not an undefined symbol */
3859 && stab[j].st_shndx != SHN_UNDEF
3860 /* and not in a "special section" */
3861 && stab[j].st_shndx < SHN_LORESERVE
3863 /* and it's a not a section or string table or anything silly */
3864 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
3865 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
3866 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
3869 /* Section 0 is the undefined section, hence > and not >=. */
3870 ASSERT(secno > 0 && secno < ehdr->e_shnum);
3872 if (shdr[secno].sh_type == SHT_NOBITS) {
3873 debugBelch(" BSS symbol, size %d off %d name %s\n",
3874 stab[j].st_size, stab[j].st_value, nm);
3877 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
3878 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
3881 #ifdef ELF_FUNCTION_DESC
3882 /* dlsym() and the initialisation table both give us function
3883 * descriptors, so to be consistent we store function descriptors
3884 * in the symbol table */
3885 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
3886 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
3888 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s\n",
3889 ad, oc->fileName, nm ));
3894 /* And the decision is ... */
3898 oc->symbols[j] = nm;
3901 /* Ignore entirely. */
3903 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
3907 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
3908 strtab + stab[j].st_name ));
3911 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
3912 (int)ELF_ST_BIND(stab[j].st_info),
3913 (int)ELF_ST_TYPE(stab[j].st_info),
3914 (int)stab[j].st_shndx,
3915 strtab + stab[j].st_name
3918 oc->symbols[j] = NULL;
3927 /* Do ELF relocations which lack an explicit addend. All x86-linux
3928 relocations appear to be of this form. */
3930 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
3931 Elf_Shdr* shdr, int shnum,
3932 Elf_Sym* stab, char* strtab )
3937 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
3938 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
3939 int target_shndx = shdr[shnum].sh_info;
3940 int symtab_shndx = shdr[shnum].sh_link;
3942 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3943 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
3944 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3945 target_shndx, symtab_shndx ));
3947 /* Skip sections that we're not interested in. */
3950 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
3951 if (kind == SECTIONKIND_OTHER) {
3952 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
3957 for (j = 0; j < nent; j++) {
3958 Elf_Addr offset = rtab[j].r_offset;
3959 Elf_Addr info = rtab[j].r_info;
3961 Elf_Addr P = ((Elf_Addr)targ) + offset;
3962 Elf_Word* pP = (Elf_Word*)P;
3967 StgStablePtr stablePtr;
3970 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
3971 j, (void*)offset, (void*)info ));
3973 IF_DEBUG(linker,debugBelch( " ZERO" ));
3976 Elf_Sym sym = stab[ELF_R_SYM(info)];
3977 /* First see if it is a local symbol. */
3978 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3979 /* Yes, so we can get the address directly from the ELF symbol
3981 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3983 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3984 + stab[ELF_R_SYM(info)].st_value);
3987 symbol = strtab + sym.st_name;
3988 stablePtr = (StgStablePtr)lookupHashTable(stablehash, (StgWord)symbol);
3989 if (NULL == stablePtr) {
3990 /* No, so look up the name in our global table. */
3991 S_tmp = lookupSymbol( symbol );
3992 S = (Elf_Addr)S_tmp;
3994 stableVal = deRefStablePtr( stablePtr );
3996 S = (Elf_Addr)S_tmp;
4000 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
4003 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
4006 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
4007 (void*)P, (void*)S, (void*)A ));
4008 checkProddableBlock ( oc, pP );
4012 switch (ELF_R_TYPE(info)) {
4013 # ifdef i386_HOST_ARCH
4014 case R_386_32: *pP = value; break;
4015 case R_386_PC32: *pP = value - P; break;
4018 errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n",
4019 oc->fileName, (lnat)ELF_R_TYPE(info));
4027 /* Do ELF relocations for which explicit addends are supplied.
4028 sparc-solaris relocations appear to be of this form. */
4030 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
4031 Elf_Shdr* shdr, int shnum,
4032 Elf_Sym* stab, char* strtab )
4035 char *symbol = NULL;
4037 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
4038 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
4039 int target_shndx = shdr[shnum].sh_info;
4040 int symtab_shndx = shdr[shnum].sh_link;
4042 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
4043 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
4044 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
4045 target_shndx, symtab_shndx ));
4047 for (j = 0; j < nent; j++) {
4048 #if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
4049 /* This #ifdef only serves to avoid unused-var warnings. */
4050 Elf_Addr offset = rtab[j].r_offset;
4051 Elf_Addr P = targ + offset;
4053 Elf_Addr info = rtab[j].r_info;
4054 Elf_Addr A = rtab[j].r_addend;
4058 # if defined(sparc_HOST_ARCH)
4059 Elf_Word* pP = (Elf_Word*)P;
4061 # elif defined(powerpc_HOST_ARCH)
4065 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
4066 j, (void*)offset, (void*)info,
4069 IF_DEBUG(linker,debugBelch( " ZERO" ));
4072 Elf_Sym sym = stab[ELF_R_SYM(info)];
4073 /* First see if it is a local symbol. */
4074 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
4075 /* Yes, so we can get the address directly from the ELF symbol
4077 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
4079 (ehdrC + shdr[ sym.st_shndx ].sh_offset
4080 + stab[ELF_R_SYM(info)].st_value);
4081 #ifdef ELF_FUNCTION_DESC
4082 /* Make a function descriptor for this function */
4083 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
4084 S = allocateFunctionDesc(S + A);
4089 /* No, so look up the name in our global table. */
4090 symbol = strtab + sym.st_name;
4091 S_tmp = lookupSymbol( symbol );
4092 S = (Elf_Addr)S_tmp;
4094 #ifdef ELF_FUNCTION_DESC
4095 /* If a function, already a function descriptor - we would
4096 have to copy it to add an offset. */
4097 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
4098 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
4102 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
4105 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
4108 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
4109 (void*)P, (void*)S, (void*)A ));
4110 /* checkProddableBlock ( oc, (void*)P ); */
4114 switch (ELF_R_TYPE(info)) {
4115 # if defined(sparc_HOST_ARCH)
4116 case R_SPARC_WDISP30:
4117 w1 = *pP & 0xC0000000;
4118 w2 = (Elf_Word)((value - P) >> 2);
4119 ASSERT((w2 & 0xC0000000) == 0);
4124 w1 = *pP & 0xFFC00000;
4125 w2 = (Elf_Word)(value >> 10);
4126 ASSERT((w2 & 0xFFC00000) == 0);
4132 w2 = (Elf_Word)(value & 0x3FF);
4133 ASSERT((w2 & ~0x3FF) == 0);
4138 /* According to the Sun documentation:
4140 This relocation type resembles R_SPARC_32, except it refers to an
4141 unaligned word. That is, the word to be relocated must be treated
4142 as four separate bytes with arbitrary alignment, not as a word
4143 aligned according to the architecture requirements.
4146 w2 = (Elf_Word)value;
4148 // SPARC doesn't do misaligned writes of 32 bit words,
4149 // so we have to do this one byte-at-a-time.
4150 char *pPc = (char*)pP;
4151 pPc[0] = (char) ((Elf_Word)(w2 & 0xff000000) >> 24);
4152 pPc[1] = (char) ((Elf_Word)(w2 & 0x00ff0000) >> 16);
4153 pPc[2] = (char) ((Elf_Word)(w2 & 0x0000ff00) >> 8);
4154 pPc[3] = (char) ((Elf_Word)(w2 & 0x000000ff));
4158 w2 = (Elf_Word)value;
4161 # elif defined(powerpc_HOST_ARCH)
4162 case R_PPC_ADDR16_LO:
4163 *(Elf32_Half*) P = value;
4166 case R_PPC_ADDR16_HI:
4167 *(Elf32_Half*) P = value >> 16;
4170 case R_PPC_ADDR16_HA:
4171 *(Elf32_Half*) P = (value + 0x8000) >> 16;
4175 *(Elf32_Word *) P = value;
4179 *(Elf32_Word *) P = value - P;
4185 if( delta << 6 >> 6 != delta )
4187 value = (Elf_Addr) (&makeSymbolExtra( oc, ELF_R_SYM(info), value )
4191 if( value == 0 || delta << 6 >> 6 != delta )
4193 barf( "Unable to make SymbolExtra for #%d",
4199 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
4200 | (delta & 0x3fffffc);
4204 #if x86_64_HOST_ARCH
4206 *(Elf64_Xword *)P = value;
4211 #if defined(ALWAYS_PIC)
4212 barf("R_X86_64_PC32 relocation, but ALWAYS_PIC.");
4214 StgInt64 off = value - P;
4215 if (off >= 0x7fffffffL || off < -0x80000000L) {
4216 #if X86_64_ELF_NONPIC_HACK
4217 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4219 off = pltAddress + A - P;
4221 barf("R_X86_64_PC32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
4222 symbol, off, oc->fileName );
4225 *(Elf64_Word *)P = (Elf64_Word)off;
4232 StgInt64 off = value - P;
4233 *(Elf64_Word *)P = (Elf64_Word)off;
4238 #if defined(ALWAYS_PIC)
4239 barf("R_X86_64_32 relocation, but ALWAYS_PIC.");
4241 if (value >= 0x7fffffffL) {
4242 #if X86_64_ELF_NONPIC_HACK
4243 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4245 value = pltAddress + A;
4247 barf("R_X86_64_32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
4248 symbol, value, oc->fileName );
4251 *(Elf64_Word *)P = (Elf64_Word)value;
4256 #if defined(ALWAYS_PIC)
4257 barf("R_X86_64_32S relocation, but ALWAYS_PIC.");
4259 if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
4260 #if X86_64_ELF_NONPIC_HACK
4261 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4263 value = pltAddress + A;
4265 barf("R_X86_64_32S relocation out of range: %s = %p\nRecompile %s with -fPIC.",
4266 symbol, value, oc->fileName );
4269 *(Elf64_Sword *)P = (Elf64_Sword)value;
4273 case R_X86_64_GOTPCREL:
4275 StgInt64 gotAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)->addr;
4276 StgInt64 off = gotAddress + A - P;
4277 *(Elf64_Word *)P = (Elf64_Word)off;
4281 case R_X86_64_PLT32:
4283 #if defined(ALWAYS_PIC)
4284 barf("R_X86_64_PLT32 relocation, but ALWAYS_PIC.");
4286 StgInt64 off = value - P;
4287 if (off >= 0x7fffffffL || off < -0x80000000L) {
4288 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4290 off = pltAddress + A - P;
4292 *(Elf64_Word *)P = (Elf64_Word)off;
4299 errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n",
4300 oc->fileName, (lnat)ELF_R_TYPE(info));
4309 ocResolve_ELF ( ObjectCode* oc )
4313 Elf_Sym* stab = NULL;
4314 char* ehdrC = (char*)(oc->image);
4315 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
4316 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
4318 /* first find "the" symbol table */
4319 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
4321 /* also go find the string table */
4322 strtab = findElfSection ( ehdrC, SHT_STRTAB );
4324 if (stab == NULL || strtab == NULL) {
4325 errorBelch("%s: can't find string or symbol table", oc->fileName);
4329 /* Process the relocation sections. */
4330 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
4331 if (shdr[shnum].sh_type == SHT_REL) {
4332 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
4333 shnum, stab, strtab );
4337 if (shdr[shnum].sh_type == SHT_RELA) {
4338 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
4339 shnum, stab, strtab );
4344 #if defined(powerpc_HOST_ARCH)
4345 ocFlushInstructionCache( oc );
4352 * PowerPC & X86_64 ELF specifics
4355 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
4357 static int ocAllocateSymbolExtras_ELF( ObjectCode *oc )
4363 ehdr = (Elf_Ehdr *) oc->image;
4364 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
4366 for( i = 0; i < ehdr->e_shnum; i++ )
4367 if( shdr[i].sh_type == SHT_SYMTAB )
4370 if( i == ehdr->e_shnum )
4372 errorBelch( "This ELF file contains no symtab" );
4376 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
4378 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
4379 (int) shdr[i].sh_entsize, (int) sizeof( Elf_Sym ) );
4384 return ocAllocateSymbolExtras( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
4387 #endif /* powerpc */
4391 /* --------------------------------------------------------------------------
4393 * ------------------------------------------------------------------------*/
4395 #if defined(OBJFORMAT_MACHO)
4398 Support for MachO linking on Darwin/MacOS X
4399 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
4401 I hereby formally apologize for the hackish nature of this code.
4402 Things that need to be done:
4403 *) implement ocVerifyImage_MachO
4404 *) add still more sanity checks.
4407 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
4408 #define mach_header mach_header_64
4409 #define segment_command segment_command_64
4410 #define section section_64
4411 #define nlist nlist_64
4414 #ifdef powerpc_HOST_ARCH
4415 static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
4417 struct mach_header *header = (struct mach_header *) oc->image;
4418 struct load_command *lc = (struct load_command *) (header + 1);
4421 for( i = 0; i < header->ncmds; i++ )
4423 if( lc->cmd == LC_SYMTAB )
4425 // Find out the first and last undefined external
4426 // symbol, so we don't have to allocate too many
4428 struct symtab_command *symLC = (struct symtab_command *) lc;
4429 unsigned min = symLC->nsyms, max = 0;
4430 struct nlist *nlist =
4431 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
4433 for(i=0;i<symLC->nsyms;i++)
4435 if(nlist[i].n_type & N_STAB)
4437 else if(nlist[i].n_type & N_EXT)
4439 if((nlist[i].n_type & N_TYPE) == N_UNDF
4440 && (nlist[i].n_value == 0))
4450 return ocAllocateSymbolExtras(oc, max - min + 1, min);
4455 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
4457 return ocAllocateSymbolExtras(oc,0,0);
4460 #ifdef x86_64_HOST_ARCH
4461 static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
4463 struct mach_header *header = (struct mach_header *) oc->image;
4464 struct load_command *lc = (struct load_command *) (header + 1);
4467 for( i = 0; i < header->ncmds; i++ )
4469 if( lc->cmd == LC_SYMTAB )
4471 // Just allocate one entry for every symbol
4472 struct symtab_command *symLC = (struct symtab_command *) lc;
4474 return ocAllocateSymbolExtras(oc, symLC->nsyms, 0);
4477 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
4479 return ocAllocateSymbolExtras(oc,0,0);
4483 static int ocVerifyImage_MachO(ObjectCode* oc)
4485 char *image = (char*) oc->image;
4486 struct mach_header *header = (struct mach_header*) image;
4488 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
4489 if(header->magic != MH_MAGIC_64) {
4490 errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
4491 oc->fileName, MH_MAGIC_64, header->magic);
4495 if(header->magic != MH_MAGIC) {
4496 errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
4497 oc->fileName, MH_MAGIC, header->magic);
4501 // FIXME: do some more verifying here
4505 static int resolveImports(
4508 struct symtab_command *symLC,
4509 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
4510 unsigned long *indirectSyms,
4511 struct nlist *nlist)
4514 size_t itemSize = 4;
4516 IF_DEBUG(linker, debugBelch("resolveImports: start\n"));
4519 int isJumpTable = 0;
4520 if(!strcmp(sect->sectname,"__jump_table"))
4524 ASSERT(sect->reserved2 == itemSize);
4528 for(i=0; i*itemSize < sect->size;i++)
4530 // according to otool, reserved1 contains the first index into the indirect symbol table
4531 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
4532 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4535 IF_DEBUG(linker, debugBelch("resolveImports: resolving %s\n", nm));
4536 if ((symbol->n_type & N_TYPE) == N_UNDF
4537 && (symbol->n_type & N_EXT) && (symbol->n_value != 0)) {
4538 addr = (void*) (symbol->n_value);
4539 IF_DEBUG(linker, debugBelch("resolveImports: undefined external %s has value %p\n", nm, addr));
4541 addr = lookupSymbol(nm);
4542 IF_DEBUG(linker, debugBelch("resolveImports: looking up %s, %p\n", nm, addr));
4546 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
4554 checkProddableBlock(oc,image + sect->offset + i*itemSize);
4555 *(image + sect->offset + i*itemSize) = 0xe9; // jmp
4556 *(unsigned*)(image + sect->offset + i*itemSize + 1)
4557 = (char*)addr - (image + sect->offset + i*itemSize + 5);
4562 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
4563 ((void**)(image + sect->offset))[i] = addr;
4567 IF_DEBUG(linker, debugBelch("resolveImports: done\n"));
4571 static unsigned long relocateAddress(
4574 struct section* sections,
4575 unsigned long address)
4578 IF_DEBUG(linker, debugBelch("relocateAddress: start\n"));
4579 for (i = 0; i < nSections; i++)
4581 IF_DEBUG(linker, debugBelch(" relocating address in section %d\n", i));
4582 if (sections[i].addr <= address
4583 && address < sections[i].addr + sections[i].size)
4585 return (unsigned long)oc->image
4586 + sections[i].offset + address - sections[i].addr;
4589 barf("Invalid Mach-O file:"
4590 "Address out of bounds while relocating object file");
4594 static int relocateSection(
4597 struct symtab_command *symLC, struct nlist *nlist,
4598 int nSections, struct section* sections, struct section *sect)
4600 struct relocation_info *relocs;
4603 IF_DEBUG(linker, debugBelch("relocateSection: start\n"));
4605 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
4607 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
4609 else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
4611 else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
4615 IF_DEBUG(linker, debugBelch("relocateSection: number of relocations: %d\n", n));
4617 relocs = (struct relocation_info*) (image + sect->reloff);
4621 #ifdef x86_64_HOST_ARCH
4622 struct relocation_info *reloc = &relocs[i];
4624 char *thingPtr = image + sect->offset + reloc->r_address;
4626 /* We shouldn't need to initialise this, but gcc on OS X 64 bit
4627 complains that it may be used uninitialized if we don't */
4630 int type = reloc->r_type;
4632 checkProddableBlock(oc,thingPtr);
4633 switch(reloc->r_length)
4636 thing = *(uint8_t*)thingPtr;
4637 baseValue = (uint64_t)thingPtr + 1;
4640 thing = *(uint16_t*)thingPtr;
4641 baseValue = (uint64_t)thingPtr + 2;
4644 thing = *(uint32_t*)thingPtr;
4645 baseValue = (uint64_t)thingPtr + 4;
4648 thing = *(uint64_t*)thingPtr;
4649 baseValue = (uint64_t)thingPtr + 8;
4652 barf("Unknown size.");
4656 debugBelch("relocateSection: length = %d, thing = %" PRId64 ", baseValue = %p\n",
4657 reloc->r_length, thing, (char *)baseValue));
4659 if (type == X86_64_RELOC_GOT
4660 || type == X86_64_RELOC_GOT_LOAD)
4662 struct nlist *symbol = &nlist[reloc->r_symbolnum];
4663 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4665 IF_DEBUG(linker, debugBelch("relocateSection: making jump island for %s, extern = %d, X86_64_RELOC_GOT\n", nm, reloc->r_extern));
4666 ASSERT(reloc->r_extern);
4667 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, (unsigned long)lookupSymbol(nm))->addr;
4669 type = X86_64_RELOC_SIGNED;
4671 else if(reloc->r_extern)
4673 struct nlist *symbol = &nlist[reloc->r_symbolnum];
4674 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4676 IF_DEBUG(linker, debugBelch("relocateSection: looking up external symbol %s\n", nm));
4677 IF_DEBUG(linker, debugBelch(" : type = %d\n", symbol->n_type));
4678 IF_DEBUG(linker, debugBelch(" : sect = %d\n", symbol->n_sect));
4679 IF_DEBUG(linker, debugBelch(" : desc = %d\n", symbol->n_desc));
4680 IF_DEBUG(linker, debugBelch(" : value = %p\n", (void *)symbol->n_value));
4681 if ((symbol->n_type & N_TYPE) == N_SECT) {
4682 value = relocateAddress(oc, nSections, sections,
4684 IF_DEBUG(linker, debugBelch("relocateSection, defined external symbol %s, relocated address %p\n", nm, (void *)value));
4687 value = (uint64_t) lookupSymbol(nm);
4688 IF_DEBUG(linker, debugBelch("relocateSection: external symbol %s, address %p\n", nm, (void *)value));
4693 value = sections[reloc->r_symbolnum-1].offset
4694 - sections[reloc->r_symbolnum-1].addr
4698 IF_DEBUG(linker, debugBelch("relocateSection: value = %p\n", (void *)value));
4700 if (type == X86_64_RELOC_BRANCH)
4702 if((int32_t)(value - baseValue) != (int64_t)(value - baseValue))
4704 ASSERT(reloc->r_extern);
4705 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)
4708 ASSERT((int32_t)(value - baseValue) == (int64_t)(value - baseValue));
4709 type = X86_64_RELOC_SIGNED;
4714 case X86_64_RELOC_UNSIGNED:
4715 ASSERT(!reloc->r_pcrel);
4718 case X86_64_RELOC_SIGNED:
4719 case X86_64_RELOC_SIGNED_1:
4720 case X86_64_RELOC_SIGNED_2:
4721 case X86_64_RELOC_SIGNED_4:
4722 ASSERT(reloc->r_pcrel);
4723 thing += value - baseValue;
4725 case X86_64_RELOC_SUBTRACTOR:
4726 ASSERT(!reloc->r_pcrel);
4730 barf("unkown relocation");
4733 switch(reloc->r_length)
4736 *(uint8_t*)thingPtr = thing;
4739 *(uint16_t*)thingPtr = thing;
4742 *(uint32_t*)thingPtr = thing;
4745 *(uint64_t*)thingPtr = thing;
4749 if(relocs[i].r_address & R_SCATTERED)
4751 struct scattered_relocation_info *scat =
4752 (struct scattered_relocation_info*) &relocs[i];
4756 if(scat->r_length == 2)
4758 unsigned long word = 0;
4759 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
4760 checkProddableBlock(oc,wordPtr);
4762 // Note on relocation types:
4763 // i386 uses the GENERIC_RELOC_* types,
4764 // while ppc uses special PPC_RELOC_* types.
4765 // *_RELOC_VANILLA and *_RELOC_PAIR have the same value
4766 // in both cases, all others are different.
4767 // Therefore, we use GENERIC_RELOC_VANILLA
4768 // and GENERIC_RELOC_PAIR instead of the PPC variants,
4769 // and use #ifdefs for the other types.
4771 // Step 1: Figure out what the relocated value should be
4772 if(scat->r_type == GENERIC_RELOC_VANILLA)
4774 word = *wordPtr + (unsigned long) relocateAddress(
4781 #ifdef powerpc_HOST_ARCH
4782 else if(scat->r_type == PPC_RELOC_SECTDIFF
4783 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
4784 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
4785 || scat->r_type == PPC_RELOC_HA16_SECTDIFF
4786 || scat->r_type == PPC_RELOC_LOCAL_SECTDIFF)
4788 else if(scat->r_type == GENERIC_RELOC_SECTDIFF
4789 || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
4792 struct scattered_relocation_info *pair =
4793 (struct scattered_relocation_info*) &relocs[i+1];
4795 if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR)
4796 barf("Invalid Mach-O file: "
4797 "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
4799 word = (unsigned long)
4800 (relocateAddress(oc, nSections, sections, scat->r_value)
4801 - relocateAddress(oc, nSections, sections, pair->r_value));
4804 #ifdef powerpc_HOST_ARCH
4805 else if(scat->r_type == PPC_RELOC_HI16
4806 || scat->r_type == PPC_RELOC_LO16
4807 || scat->r_type == PPC_RELOC_HA16
4808 || scat->r_type == PPC_RELOC_LO14)
4809 { // these are generated by label+offset things
4810 struct relocation_info *pair = &relocs[i+1];
4811 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
4812 barf("Invalid Mach-O file: "
4813 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
4815 if(scat->r_type == PPC_RELOC_LO16)
4817 word = ((unsigned short*) wordPtr)[1];
4818 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4820 else if(scat->r_type == PPC_RELOC_LO14)
4822 barf("Unsupported Relocation: PPC_RELOC_LO14");
4823 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
4824 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4826 else if(scat->r_type == PPC_RELOC_HI16)
4828 word = ((unsigned short*) wordPtr)[1] << 16;
4829 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4831 else if(scat->r_type == PPC_RELOC_HA16)
4833 word = ((unsigned short*) wordPtr)[1] << 16;
4834 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4838 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
4846 barf ("Don't know how to handle this Mach-O "
4847 "scattered relocation entry: "
4848 "object file %s; entry type %ld; "
4850 OC_INFORMATIVE_FILENAME(oc),
4856 #ifdef powerpc_HOST_ARCH
4857 if(scat->r_type == GENERIC_RELOC_VANILLA
4858 || scat->r_type == PPC_RELOC_SECTDIFF)
4860 if(scat->r_type == GENERIC_RELOC_VANILLA
4861 || scat->r_type == GENERIC_RELOC_SECTDIFF
4862 || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
4867 #ifdef powerpc_HOST_ARCH
4868 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
4870 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4872 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
4874 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4876 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
4878 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4879 + ((word & (1<<15)) ? 1 : 0);
4885 barf("Can't handle Mach-O scattered relocation entry "
4886 "with this r_length tag: "
4887 "object file %s; entry type %ld; "
4888 "r_length tag %ld; address %#lx\n",
4889 OC_INFORMATIVE_FILENAME(oc),
4896 else /* scat->r_pcrel */
4898 barf("Don't know how to handle *PC-relative* Mach-O "
4899 "scattered relocation entry: "
4900 "object file %s; entry type %ld; address %#lx\n",
4901 OC_INFORMATIVE_FILENAME(oc),
4908 else /* !(relocs[i].r_address & R_SCATTERED) */
4910 struct relocation_info *reloc = &relocs[i];
4911 if(reloc->r_pcrel && !reloc->r_extern)
4914 if(reloc->r_length == 2)
4916 unsigned long word = 0;
4917 #ifdef powerpc_HOST_ARCH
4918 unsigned long jumpIsland = 0;
4919 long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
4920 // to avoid warning and to catch
4924 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
4925 checkProddableBlock(oc,wordPtr);
4927 if(reloc->r_type == GENERIC_RELOC_VANILLA)
4931 #ifdef powerpc_HOST_ARCH
4932 else if(reloc->r_type == PPC_RELOC_LO16)
4934 word = ((unsigned short*) wordPtr)[1];
4935 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4937 else if(reloc->r_type == PPC_RELOC_HI16)
4939 word = ((unsigned short*) wordPtr)[1] << 16;
4940 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4942 else if(reloc->r_type == PPC_RELOC_HA16)
4944 word = ((unsigned short*) wordPtr)[1] << 16;
4945 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4947 else if(reloc->r_type == PPC_RELOC_BR24)
4950 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
4955 barf("Can't handle this Mach-O relocation entry "
4957 "object file %s; entry type %ld; address %#lx\n",
4958 OC_INFORMATIVE_FILENAME(oc),
4964 if(!reloc->r_extern)
4967 sections[reloc->r_symbolnum-1].offset
4968 - sections[reloc->r_symbolnum-1].addr
4975 struct nlist *symbol = &nlist[reloc->r_symbolnum];
4976 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4977 void *symbolAddress = lookupSymbol(nm);
4980 errorBelch("\nunknown symbol `%s'", nm);
4986 #ifdef powerpc_HOST_ARCH
4987 // In the .o file, this should be a relative jump to NULL
4988 // and we'll change it to a relative jump to the symbol
4989 ASSERT(word + reloc->r_address == 0);
4990 jumpIsland = (unsigned long)
4991 &makeSymbolExtra(oc,
4993 (unsigned long) symbolAddress)
4997 offsetToJumpIsland = word + jumpIsland
4998 - (((long)image) + sect->offset - sect->addr);
5001 word += (unsigned long) symbolAddress
5002 - (((long)image) + sect->offset - sect->addr);
5006 word += (unsigned long) symbolAddress;
5010 if(reloc->r_type == GENERIC_RELOC_VANILLA)
5015 #ifdef powerpc_HOST_ARCH
5016 else if(reloc->r_type == PPC_RELOC_LO16)
5018 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
5021 else if(reloc->r_type == PPC_RELOC_HI16)
5023 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
5026 else if(reloc->r_type == PPC_RELOC_HA16)
5028 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
5029 + ((word & (1<<15)) ? 1 : 0);
5032 else if(reloc->r_type == PPC_RELOC_BR24)
5034 if((word & 0x03) != 0)
5035 barf("%s: unconditional relative branch with a displacement "
5036 "which isn't a multiple of 4 bytes: %#lx",
5037 OC_INFORMATIVE_FILENAME(oc),
5040 if((word & 0xFE000000) != 0xFE000000 &&
5041 (word & 0xFE000000) != 0x00000000)
5043 // The branch offset is too large.
5044 // Therefore, we try to use a jump island.
5047 barf("%s: unconditional relative branch out of range: "
5048 "no jump island available: %#lx",
5049 OC_INFORMATIVE_FILENAME(oc),
5053 word = offsetToJumpIsland;
5054 if((word & 0xFE000000) != 0xFE000000 &&
5055 (word & 0xFE000000) != 0x00000000)
5056 barf("%s: unconditional relative branch out of range: "
5057 "jump island out of range: %#lx",
5058 OC_INFORMATIVE_FILENAME(oc),
5061 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
5068 barf("Can't handle Mach-O relocation entry (not scattered) "
5069 "with this r_length tag: "
5070 "object file %s; entry type %ld; "
5071 "r_length tag %ld; address %#lx\n",
5072 OC_INFORMATIVE_FILENAME(oc),
5081 IF_DEBUG(linker, debugBelch("relocateSection: done\n"));
5085 static int ocGetNames_MachO(ObjectCode* oc)
5087 char *image = (char*) oc->image;
5088 struct mach_header *header = (struct mach_header*) image;
5089 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
5090 unsigned i,curSymbol = 0;
5091 struct segment_command *segLC = NULL;
5092 struct section *sections;
5093 struct symtab_command *symLC = NULL;
5094 struct nlist *nlist;
5095 unsigned long commonSize = 0;
5096 char *commonStorage = NULL;
5097 unsigned long commonCounter;
5099 IF_DEBUG(linker,debugBelch("ocGetNames_MachO: start\n"));
5101 for(i=0;i<header->ncmds;i++)
5103 if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
5104 segLC = (struct segment_command*) lc;
5105 else if(lc->cmd == LC_SYMTAB)
5106 symLC = (struct symtab_command*) lc;
5107 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
5110 sections = (struct section*) (segLC+1);
5111 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
5115 barf("ocGetNames_MachO: no segment load command");
5117 for(i=0;i<segLC->nsects;i++)
5119 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: segment %d\n", i));
5120 if (sections[i].size == 0)
5123 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
5125 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
5126 "ocGetNames_MachO(common symbols)");
5127 sections[i].offset = zeroFillArea - image;
5130 if(!strcmp(sections[i].sectname,"__text"))
5131 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
5132 (void*) (image + sections[i].offset),
5133 (void*) (image + sections[i].offset + sections[i].size));
5134 else if(!strcmp(sections[i].sectname,"__const"))
5135 addSection(oc, SECTIONKIND_RWDATA,
5136 (void*) (image + sections[i].offset),
5137 (void*) (image + sections[i].offset + sections[i].size));
5138 else if(!strcmp(sections[i].sectname,"__data"))
5139 addSection(oc, SECTIONKIND_RWDATA,
5140 (void*) (image + sections[i].offset),
5141 (void*) (image + sections[i].offset + sections[i].size));
5142 else if(!strcmp(sections[i].sectname,"__bss")
5143 || !strcmp(sections[i].sectname,"__common"))
5144 addSection(oc, SECTIONKIND_RWDATA,
5145 (void*) (image + sections[i].offset),
5146 (void*) (image + sections[i].offset + sections[i].size));
5148 addProddableBlock(oc, (void*) (image + sections[i].offset),
5152 // count external symbols defined here
5156 for(i=0;i<symLC->nsyms;i++)
5158 if(nlist[i].n_type & N_STAB)
5160 else if(nlist[i].n_type & N_EXT)
5162 if((nlist[i].n_type & N_TYPE) == N_UNDF
5163 && (nlist[i].n_value != 0))
5165 commonSize += nlist[i].n_value;
5168 else if((nlist[i].n_type & N_TYPE) == N_SECT)
5173 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: %d external symbols\n", oc->n_symbols));
5174 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
5175 "ocGetNames_MachO(oc->symbols)");
5179 for(i=0;i<symLC->nsyms;i++)
5181 if(nlist[i].n_type & N_STAB)
5183 else if((nlist[i].n_type & N_TYPE) == N_SECT)
5185 if(nlist[i].n_type & N_EXT)
5187 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
5188 if ((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm)) {
5189 // weak definition, and we already have a definition
5190 IF_DEBUG(linker, debugBelch(" weak: %s\n", nm));
5194 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting %s\n", nm));
5195 ghciInsertStrHashTable(oc->fileName, symhash, nm,
5197 + sections[nlist[i].n_sect-1].offset
5198 - sections[nlist[i].n_sect-1].addr
5199 + nlist[i].n_value);
5200 oc->symbols[curSymbol++] = nm;
5207 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
5208 commonCounter = (unsigned long)commonStorage;
5211 for(i=0;i<symLC->nsyms;i++)
5213 if((nlist[i].n_type & N_TYPE) == N_UNDF
5214 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
5216 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
5217 unsigned long sz = nlist[i].n_value;
5219 nlist[i].n_value = commonCounter;
5221 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting common symbol: %s\n", nm));
5222 ghciInsertStrHashTable(oc->fileName, symhash, nm,
5223 (void*)commonCounter);
5224 oc->symbols[curSymbol++] = nm;
5226 commonCounter += sz;
5233 static int ocResolve_MachO(ObjectCode* oc)
5235 char *image = (char*) oc->image;
5236 struct mach_header *header = (struct mach_header*) image;
5237 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
5239 struct segment_command *segLC = NULL;
5240 struct section *sections;
5241 struct symtab_command *symLC = NULL;
5242 struct dysymtab_command *dsymLC = NULL;
5243 struct nlist *nlist;
5245 IF_DEBUG(linker, debugBelch("ocResolve_MachO: start\n"));
5246 for (i = 0; i < header->ncmds; i++)
5248 if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
5249 segLC = (struct segment_command*) lc;
5250 else if(lc->cmd == LC_SYMTAB)
5251 symLC = (struct symtab_command*) lc;
5252 else if(lc->cmd == LC_DYSYMTAB)
5253 dsymLC = (struct dysymtab_command*) lc;
5254 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
5257 sections = (struct section*) (segLC+1);
5258 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
5263 unsigned long *indirectSyms
5264 = (unsigned long*) (image + dsymLC->indirectsymoff);
5266 IF_DEBUG(linker, debugBelch("ocResolve_MachO: resolving dsymLC\n"));
5267 for (i = 0; i < segLC->nsects; i++)
5269 if( !strcmp(sections[i].sectname,"__la_symbol_ptr")
5270 || !strcmp(sections[i].sectname,"__la_sym_ptr2")
5271 || !strcmp(sections[i].sectname,"__la_sym_ptr3"))
5273 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
5276 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr")
5277 || !strcmp(sections[i].sectname,"__pointers"))
5279 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
5282 else if(!strcmp(sections[i].sectname,"__jump_table"))
5284 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
5289 IF_DEBUG(linker, debugBelch("ocResolve_MachO: unknown section\n"));
5294 for(i=0;i<segLC->nsects;i++)
5296 IF_DEBUG(linker, debugBelch("ocResolve_MachO: relocating section %d\n", i));
5298 if (!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
5302 #if defined (powerpc_HOST_ARCH)
5303 ocFlushInstructionCache( oc );
5309 #ifdef powerpc_HOST_ARCH
5311 * The Mach-O object format uses leading underscores. But not everywhere.
5312 * There is a small number of runtime support functions defined in
5313 * libcc_dynamic.a whose name does not have a leading underscore.
5314 * As a consequence, we can't get their address from C code.
5315 * We have to use inline assembler just to take the address of a function.
5319 extern void* symbolsWithoutUnderscore[];
5321 static void machoInitSymbolsWithoutUnderscore()
5323 void **p = symbolsWithoutUnderscore;
5324 __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
5326 #undef SymI_NeedsProto
5327 #define SymI_NeedsProto(x) \
5328 __asm__ volatile(".long " # x);
5330 RTS_MACHO_NOUNDERLINE_SYMBOLS
5332 __asm__ volatile(".text");
5334 #undef SymI_NeedsProto
5335 #define SymI_NeedsProto(x) \
5336 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
5338 RTS_MACHO_NOUNDERLINE_SYMBOLS
5340 #undef SymI_NeedsProto
5346 * Figure out by how much to shift the entire Mach-O file in memory
5347 * when loading so that its single segment ends up 16-byte-aligned
5349 static int machoGetMisalignment( FILE * f )
5351 struct mach_header header;
5355 int n = fread(&header, sizeof(header), 1, f);
5357 barf("machoGetMisalignment: can't read the Mach-O header");
5360 fseek(f, -sizeof(header), SEEK_CUR);
5362 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
5363 if(header.magic != MH_MAGIC_64) {
5364 barf("Bad magic. Expected: %08x, got: %08x.",
5365 MH_MAGIC_64, header.magic);
5368 if(header.magic != MH_MAGIC) {
5369 barf("Bad magic. Expected: %08x, got: %08x.",
5370 MH_MAGIC, header.magic);
5374 misalignment = (header.sizeofcmds + sizeof(header))
5377 return misalignment ? (16 - misalignment) : 0;