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>.
25 #include "LinkerInternals.h"
29 #include "RtsTypeable.h"
31 #ifdef HAVE_SYS_TYPES_H
32 #include <sys/types.h>
38 #ifdef HAVE_SYS_STAT_H
42 #if defined(HAVE_DLFCN_H)
46 #if defined(cygwin32_HOST_OS)
51 #ifdef HAVE_SYS_TIME_H
55 #include <sys/fcntl.h>
56 #include <sys/termios.h>
57 #include <sys/utime.h>
58 #include <sys/utsname.h>
62 #if defined(ia64_HOST_ARCH) || defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
67 #if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
75 #if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
76 # define OBJFORMAT_ELF
77 #elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
78 # define OBJFORMAT_PEi386
81 #elif defined(darwin_HOST_OS)
82 # define OBJFORMAT_MACHO
83 # include <mach-o/loader.h>
84 # include <mach-o/nlist.h>
85 # include <mach-o/reloc.h>
86 #if !defined(HAVE_DLFCN_H)
87 # include <mach-o/dyld.h>
89 #if defined(powerpc_HOST_ARCH)
90 # include <mach-o/ppc/reloc.h>
92 #if defined(x86_64_HOST_ARCH)
93 # include <mach-o/x86_64/reloc.h>
97 /* Hash table mapping symbol names to Symbol */
98 static /*Str*/HashTable *symhash;
100 /* Hash table mapping symbol names to StgStablePtr */
101 static /*Str*/HashTable *stablehash;
103 /* List of currently loaded objects */
104 ObjectCode *objects = NULL; /* initially empty */
106 #if defined(OBJFORMAT_ELF)
107 static int ocVerifyImage_ELF ( ObjectCode* oc );
108 static int ocGetNames_ELF ( ObjectCode* oc );
109 static int ocResolve_ELF ( ObjectCode* oc );
110 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
111 static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc );
113 #elif defined(OBJFORMAT_PEi386)
114 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
115 static int ocGetNames_PEi386 ( ObjectCode* oc );
116 static int ocResolve_PEi386 ( ObjectCode* oc );
117 #elif defined(OBJFORMAT_MACHO)
118 static int ocVerifyImage_MachO ( ObjectCode* oc );
119 static int ocGetNames_MachO ( ObjectCode* oc );
120 static int ocResolve_MachO ( ObjectCode* oc );
122 static int machoGetMisalignment( FILE * );
123 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
124 static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
126 #ifdef powerpc_HOST_ARCH
127 static void machoInitSymbolsWithoutUnderscore( void );
131 /* on x86_64 we have a problem with relocating symbol references in
132 * code that was compiled without -fPIC. By default, the small memory
133 * model is used, which assumes that symbol references can fit in a
134 * 32-bit slot. The system dynamic linker makes this work for
135 * references to shared libraries by either (a) allocating a jump
136 * table slot for code references, or (b) moving the symbol at load
137 * time (and copying its contents, if necessary) for data references.
139 * We unfortunately can't tell whether symbol references are to code
140 * or data. So for now we assume they are code (the vast majority
141 * are), and allocate jump-table slots. Unfortunately this will
142 * SILENTLY generate crashing code for data references. This hack is
143 * enabled by X86_64_ELF_NONPIC_HACK.
145 * One workaround is to use shared Haskell libraries. This is
146 * coming. Another workaround is to keep the static libraries but
147 * compile them with -fPIC, because that will generate PIC references
148 * to data which can be relocated. The PIC code is still too green to
149 * do this systematically, though.
152 * See thread http://www.haskell.org/pipermail/cvs-ghc/2007-September/038458.html
154 #define X86_64_ELF_NONPIC_HACK 1
156 /* -----------------------------------------------------------------------------
157 * Built-in symbols from the RTS
160 typedef struct _RtsSymbolVal {
167 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
168 SymX(makeStableNamezh_fast) \
169 SymX(finalizzeWeakzh_fast)
171 /* These are not available in GUM!!! -- HWL */
172 #define Maybe_Stable_Names
175 #if !defined (mingw32_HOST_OS)
176 #define RTS_POSIX_ONLY_SYMBOLS \
179 SymX(signal_handlers) \
180 SymX(stg_sig_install) \
184 #if defined (cygwin32_HOST_OS)
185 #define RTS_MINGW_ONLY_SYMBOLS /**/
186 /* Don't have the ability to read import libs / archives, so
187 * we have to stupidly list a lot of what libcygwin.a
190 #define RTS_CYGWIN_ONLY_SYMBOLS \
268 #elif !defined(mingw32_HOST_OS)
269 #define RTS_MINGW_ONLY_SYMBOLS /**/
270 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
271 #else /* defined(mingw32_HOST_OS) */
272 #define RTS_POSIX_ONLY_SYMBOLS /**/
273 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
275 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
277 #define RTS_MINGW_EXTRA_SYMS \
278 Sym(_imp____mb_cur_max) \
281 #define RTS_MINGW_EXTRA_SYMS
284 #if HAVE_GETTIMEOFDAY
285 #define RTS_MINGW_GETTIMEOFDAY_SYM Sym(gettimeofday)
287 #define RTS_MINGW_GETTIMEOFDAY_SYM /**/
290 /* These are statically linked from the mingw libraries into the ghc
291 executable, so we have to employ this hack. */
292 #define RTS_MINGW_ONLY_SYMBOLS \
293 SymX(asyncReadzh_fast) \
294 SymX(asyncWritezh_fast) \
295 SymX(asyncDoProczh_fast) \
307 SymX(getservbyname) \
308 SymX(getservbyport) \
309 SymX(getprotobynumber) \
310 SymX(getprotobyname) \
311 SymX(gethostbyname) \
312 SymX(gethostbyaddr) \
359 SymX(rts_InstallConsoleEvent) \
360 SymX(rts_ConsoleHandlerDone) \
362 Sym(_imp___timezone) \
372 RTS_MINGW_EXTRA_SYMS \
373 RTS_MINGW_GETTIMEOFDAY_SYM \
377 #if defined(darwin_TARGET_OS) && HAVE_PRINTF_LDBLSTUB
378 #define RTS_DARWIN_ONLY_SYMBOLS \
379 Sym(asprintf$LDBLStub) \
383 Sym(fprintf$LDBLStub) \
384 Sym(fscanf$LDBLStub) \
385 Sym(fwprintf$LDBLStub) \
386 Sym(fwscanf$LDBLStub) \
387 Sym(printf$LDBLStub) \
388 Sym(scanf$LDBLStub) \
389 Sym(snprintf$LDBLStub) \
390 Sym(sprintf$LDBLStub) \
391 Sym(sscanf$LDBLStub) \
392 Sym(strtold$LDBLStub) \
393 Sym(swprintf$LDBLStub) \
394 Sym(swscanf$LDBLStub) \
395 Sym(syslog$LDBLStub) \
396 Sym(vasprintf$LDBLStub) \
398 Sym(verrc$LDBLStub) \
399 Sym(verrx$LDBLStub) \
400 Sym(vfprintf$LDBLStub) \
401 Sym(vfscanf$LDBLStub) \
402 Sym(vfwprintf$LDBLStub) \
403 Sym(vfwscanf$LDBLStub) \
404 Sym(vprintf$LDBLStub) \
405 Sym(vscanf$LDBLStub) \
406 Sym(vsnprintf$LDBLStub) \
407 Sym(vsprintf$LDBLStub) \
408 Sym(vsscanf$LDBLStub) \
409 Sym(vswprintf$LDBLStub) \
410 Sym(vswscanf$LDBLStub) \
411 Sym(vsyslog$LDBLStub) \
412 Sym(vwarn$LDBLStub) \
413 Sym(vwarnc$LDBLStub) \
414 Sym(vwarnx$LDBLStub) \
415 Sym(vwprintf$LDBLStub) \
416 Sym(vwscanf$LDBLStub) \
418 Sym(warnc$LDBLStub) \
419 Sym(warnx$LDBLStub) \
420 Sym(wcstold$LDBLStub) \
421 Sym(wprintf$LDBLStub) \
424 #define RTS_DARWIN_ONLY_SYMBOLS
428 # define MAIN_CAP_SYM SymX(MainCapability)
430 # define MAIN_CAP_SYM
433 #if !defined(mingw32_HOST_OS)
434 #define RTS_USER_SIGNALS_SYMBOLS \
435 SymX(setIOManagerPipe)
437 #define RTS_USER_SIGNALS_SYMBOLS \
438 SymX(sendIOManagerEvent) \
439 SymX(readIOManagerEvent) \
440 SymX(getIOManagerEvent) \
441 SymX(console_handler)
444 #define RTS_LIBFFI_SYMBOLS \
448 Sym(ffi_type_float) \
449 Sym(ffi_type_double) \
450 Sym(ffi_type_sint64) \
451 Sym(ffi_type_uint64) \
452 Sym(ffi_type_sint32) \
453 Sym(ffi_type_uint32) \
454 Sym(ffi_type_sint16) \
455 Sym(ffi_type_uint16) \
456 Sym(ffi_type_sint8) \
457 Sym(ffi_type_uint8) \
458 Sym(ffi_type_pointer)
460 #ifdef TABLES_NEXT_TO_CODE
461 #define RTS_RET_SYMBOLS /* nothing */
463 #define RTS_RET_SYMBOLS \
464 SymX(stg_enter_ret) \
465 SymX(stg_gc_fun_ret) \
472 SymX(stg_ap_pv_ret) \
473 SymX(stg_ap_pp_ret) \
474 SymX(stg_ap_ppv_ret) \
475 SymX(stg_ap_ppp_ret) \
476 SymX(stg_ap_pppv_ret) \
477 SymX(stg_ap_pppp_ret) \
478 SymX(stg_ap_ppppp_ret) \
479 SymX(stg_ap_pppppp_ret)
482 /* On Windows, we link libgmp.a statically into libHSrts.dll */
483 #ifdef mingw32_HOST_OS
486 SymX(__gmpz_cmp_si) \
487 SymX(__gmpz_cmp_ui) \
488 SymX(__gmpz_get_si) \
492 SymExtern(__gmpz_cmp) \
493 SymExtern(__gmpz_cmp_si) \
494 SymExtern(__gmpz_cmp_ui) \
495 SymExtern(__gmpz_get_si) \
496 SymExtern(__gmpz_get_ui)
499 #define RTS_SYMBOLS \
502 SymX(stg_enter_info) \
503 SymX(stg_gc_void_info) \
504 SymX(__stg_gc_enter_1) \
505 SymX(stg_gc_noregs) \
506 SymX(stg_gc_unpt_r1_info) \
507 SymX(stg_gc_unpt_r1) \
508 SymX(stg_gc_unbx_r1_info) \
509 SymX(stg_gc_unbx_r1) \
510 SymX(stg_gc_f1_info) \
512 SymX(stg_gc_d1_info) \
514 SymX(stg_gc_l1_info) \
517 SymX(stg_gc_fun_info) \
519 SymX(stg_gc_gen_info) \
520 SymX(stg_gc_gen_hp) \
522 SymX(stg_gen_yield) \
523 SymX(stg_yield_noregs) \
524 SymX(stg_yield_to_interpreter) \
525 SymX(stg_gen_block) \
526 SymX(stg_block_noregs) \
528 SymX(stg_block_takemvar) \
529 SymX(stg_block_putmvar) \
531 SymX(MallocFailHook) \
533 SymX(OutOfHeapHook) \
534 SymX(StackOverflowHook) \
535 SymX(__encodeDouble) \
536 SymX(__encodeFloat) \
539 SymX(__int_encodeDouble) \
540 SymX(__int_encodeFloat) \
541 SymX(andIntegerzh_fast) \
542 SymX(atomicallyzh_fast) \
546 SymX(blockAsyncExceptionszh_fast) \
548 SymX(catchRetryzh_fast) \
549 SymX(catchSTMzh_fast) \
551 SymX(closure_flags) \
553 SymX(cmpIntegerzh_fast) \
554 SymX(cmpIntegerIntzh_fast) \
555 SymX(complementIntegerzh_fast) \
556 SymX(createAdjustor) \
557 SymX(decodeDoublezh_fast) \
558 SymX(decodeFloatzh_fast) \
561 SymX(deRefWeakzh_fast) \
562 SymX(deRefStablePtrzh_fast) \
563 SymX(dirty_MUT_VAR) \
564 SymX(divExactIntegerzh_fast) \
565 SymX(divModIntegerzh_fast) \
567 SymX(forkOnzh_fast) \
569 SymX(forkOS_createThread) \
570 SymX(freeHaskellFunctionPtr) \
571 SymX(freeStablePtr) \
572 SymX(getOrSetTypeableStore) \
573 SymX(gcdIntegerzh_fast) \
574 SymX(gcdIntegerIntzh_fast) \
575 SymX(gcdIntzh_fast) \
579 SymX(getFullProgArgv) \
585 SymX(hs_perform_gc) \
586 SymX(hs_free_stable_ptr) \
587 SymX(hs_free_fun_ptr) \
588 SymX(hs_hpc_rootModule) \
590 SymX(unpackClosurezh_fast) \
591 SymX(getApStackValzh_fast) \
592 SymX(int2Integerzh_fast) \
593 SymX(integer2Intzh_fast) \
594 SymX(integer2Wordzh_fast) \
595 SymX(isCurrentThreadBoundzh_fast) \
596 SymX(isDoubleDenormalized) \
597 SymX(isDoubleInfinite) \
599 SymX(isDoubleNegativeZero) \
600 SymX(isEmptyMVarzh_fast) \
601 SymX(isFloatDenormalized) \
602 SymX(isFloatInfinite) \
604 SymX(isFloatNegativeZero) \
605 SymX(killThreadzh_fast) \
607 SymX(insertStableSymbol) \
610 SymX(makeStablePtrzh_fast) \
611 SymX(minusIntegerzh_fast) \
612 SymX(mkApUpd0zh_fast) \
613 SymX(myThreadIdzh_fast) \
614 SymX(labelThreadzh_fast) \
615 SymX(newArrayzh_fast) \
616 SymX(newBCOzh_fast) \
617 SymX(newByteArrayzh_fast) \
618 SymX_redirect(newCAF, newDynCAF) \
619 SymX(newMVarzh_fast) \
620 SymX(newMutVarzh_fast) \
621 SymX(newTVarzh_fast) \
622 SymX(noDuplicatezh_fast) \
623 SymX(atomicModifyMutVarzh_fast) \
624 SymX(newPinnedByteArrayzh_fast) \
626 SymX(orIntegerzh_fast) \
628 SymX(performMajorGC) \
629 SymX(plusIntegerzh_fast) \
632 SymX(putMVarzh_fast) \
633 SymX(quotIntegerzh_fast) \
634 SymX(quotRemIntegerzh_fast) \
636 SymX(raiseIOzh_fast) \
637 SymX(readTVarzh_fast) \
638 SymX(remIntegerzh_fast) \
639 SymX(resetNonBlockingFd) \
644 SymX(rts_checkSchedStatus) \
647 SymX(rts_evalLazyIO) \
648 SymX(rts_evalStableIO) \
652 SymX(rts_getDouble) \
660 SymX(rts_getFunPtr) \
661 SymX(rts_getStablePtr) \
662 SymX(rts_getThreadId) \
665 SymX(rts_getWord16) \
666 SymX(rts_getWord32) \
667 SymX(rts_getWord64) \
680 SymX(rts_mkStablePtr) \
688 SymX(rtsSupportsBoundThreads) \
689 SymX(__hscore_get_saved_termios) \
690 SymX(__hscore_set_saved_termios) \
692 SymX(startupHaskell) \
693 SymX(shutdownHaskell) \
694 SymX(shutdownHaskellAndExit) \
695 SymX(stable_ptr_table) \
696 SymX(stackOverflow) \
697 SymX(stg_CAF_BLACKHOLE_info) \
698 SymX(awakenBlockedQueue) \
699 SymX(stg_CHARLIKE_closure) \
700 SymX(stg_MVAR_CLEAN_info) \
701 SymX(stg_MVAR_DIRTY_info) \
702 SymX(stg_IND_STATIC_info) \
703 SymX(stg_INTLIKE_closure) \
704 SymX(stg_MUT_ARR_PTRS_DIRTY_info) \
705 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
706 SymX(stg_MUT_ARR_PTRS_FROZEN0_info) \
707 SymX(stg_WEAK_info) \
708 SymX(stg_ap_v_info) \
709 SymX(stg_ap_f_info) \
710 SymX(stg_ap_d_info) \
711 SymX(stg_ap_l_info) \
712 SymX(stg_ap_n_info) \
713 SymX(stg_ap_p_info) \
714 SymX(stg_ap_pv_info) \
715 SymX(stg_ap_pp_info) \
716 SymX(stg_ap_ppv_info) \
717 SymX(stg_ap_ppp_info) \
718 SymX(stg_ap_pppv_info) \
719 SymX(stg_ap_pppp_info) \
720 SymX(stg_ap_ppppp_info) \
721 SymX(stg_ap_pppppp_info) \
722 SymX(stg_ap_0_fast) \
723 SymX(stg_ap_v_fast) \
724 SymX(stg_ap_f_fast) \
725 SymX(stg_ap_d_fast) \
726 SymX(stg_ap_l_fast) \
727 SymX(stg_ap_n_fast) \
728 SymX(stg_ap_p_fast) \
729 SymX(stg_ap_pv_fast) \
730 SymX(stg_ap_pp_fast) \
731 SymX(stg_ap_ppv_fast) \
732 SymX(stg_ap_ppp_fast) \
733 SymX(stg_ap_pppv_fast) \
734 SymX(stg_ap_pppp_fast) \
735 SymX(stg_ap_ppppp_fast) \
736 SymX(stg_ap_pppppp_fast) \
737 SymX(stg_ap_1_upd_info) \
738 SymX(stg_ap_2_upd_info) \
739 SymX(stg_ap_3_upd_info) \
740 SymX(stg_ap_4_upd_info) \
741 SymX(stg_ap_5_upd_info) \
742 SymX(stg_ap_6_upd_info) \
743 SymX(stg_ap_7_upd_info) \
745 SymX(stg_sel_0_upd_info) \
746 SymX(stg_sel_10_upd_info) \
747 SymX(stg_sel_11_upd_info) \
748 SymX(stg_sel_12_upd_info) \
749 SymX(stg_sel_13_upd_info) \
750 SymX(stg_sel_14_upd_info) \
751 SymX(stg_sel_15_upd_info) \
752 SymX(stg_sel_1_upd_info) \
753 SymX(stg_sel_2_upd_info) \
754 SymX(stg_sel_3_upd_info) \
755 SymX(stg_sel_4_upd_info) \
756 SymX(stg_sel_5_upd_info) \
757 SymX(stg_sel_6_upd_info) \
758 SymX(stg_sel_7_upd_info) \
759 SymX(stg_sel_8_upd_info) \
760 SymX(stg_sel_9_upd_info) \
761 SymX(stg_upd_frame_info) \
762 SymX(suspendThread) \
763 SymX(takeMVarzh_fast) \
764 SymX(timesIntegerzh_fast) \
765 SymX(tryPutMVarzh_fast) \
766 SymX(tryTakeMVarzh_fast) \
767 SymX(unblockAsyncExceptionszh_fast) \
769 SymX(unsafeThawArrayzh_fast) \
770 SymX(waitReadzh_fast) \
771 SymX(waitWritezh_fast) \
772 SymX(word2Integerzh_fast) \
773 SymX(writeTVarzh_fast) \
774 SymX(xorIntegerzh_fast) \
776 Sym(stg_interp_constr_entry) \
779 SymX(getAllocations) \
782 Sym(rts_breakpoint_io_action) \
783 Sym(rts_stop_next_breakpoint) \
784 Sym(rts_stop_on_exception) \
786 SymX(n_capabilities) \
787 RTS_USER_SIGNALS_SYMBOLS
789 #ifdef SUPPORT_LONG_LONGS
790 #define RTS_LONG_LONG_SYMS \
791 SymX(int64ToIntegerzh_fast) \
792 SymX(word64ToIntegerzh_fast)
794 #define RTS_LONG_LONG_SYMS /* nothing */
797 // 64-bit support functions in libgcc.a
798 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
799 #define RTS_LIBGCC_SYMBOLS \
809 #elif defined(ia64_HOST_ARCH)
810 #define RTS_LIBGCC_SYMBOLS \
818 #define RTS_LIBGCC_SYMBOLS
821 #if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
822 // Symbols that don't have a leading underscore
823 // on Mac OS X. They have to receive special treatment,
824 // see machoInitSymbolsWithoutUnderscore()
825 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
830 /* entirely bogus claims about types of these symbols */
831 #define Sym(vvv) extern void vvv(void);
832 #if defined(__PIC__) && defined(mingw32_TARGET_OS)
833 #define SymExtern(vvv) extern void _imp__ ## vvv (void);
835 #define SymExtern(vvv) SymX(vvv)
837 #define SymX(vvv) /**/
838 #define SymX_redirect(vvv,xxx) /**/
842 RTS_POSIX_ONLY_SYMBOLS
843 RTS_MINGW_ONLY_SYMBOLS
844 RTS_CYGWIN_ONLY_SYMBOLS
845 RTS_DARWIN_ONLY_SYMBOLS
853 #ifdef LEADING_UNDERSCORE
854 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
856 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
859 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
861 #define SymX(vvv) Sym(vvv)
862 #define SymExtern(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
863 (void*)DLL_IMPORT_DATA_REF(vvv) },
865 // SymX_redirect allows us to redirect references to one symbol to
866 // another symbol. See newCAF/newDynCAF for an example.
867 #define SymX_redirect(vvv,xxx) \
868 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
871 static RtsSymbolVal rtsSyms[] = {
875 RTS_POSIX_ONLY_SYMBOLS
876 RTS_MINGW_ONLY_SYMBOLS
877 RTS_CYGWIN_ONLY_SYMBOLS
878 RTS_DARWIN_ONLY_SYMBOLS
881 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
882 // dyld stub code contains references to this,
883 // but it should never be called because we treat
884 // lazy pointers as nonlazy.
885 { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
887 { 0, 0 } /* sentinel */
892 /* -----------------------------------------------------------------------------
893 * Insert symbols into hash tables, checking for duplicates.
896 static void ghciInsertStrHashTable ( char* obj_name,
902 if (lookupHashTable(table, (StgWord)key) == NULL)
904 insertStrHashTable(table, (StgWord)key, data);
909 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
911 "whilst processing object file\n"
913 "This could be caused by:\n"
914 " * Loading two different object files which export the same symbol\n"
915 " * Specifying the same object file twice on the GHCi command line\n"
916 " * An incorrect `package.conf' entry, causing some object to be\n"
918 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
925 /* -----------------------------------------------------------------------------
926 * initialize the object linker
930 static int linker_init_done = 0 ;
932 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
933 static void *dl_prog_handle;
941 /* Make initLinker idempotent, so we can call it
942 before evey relevant operation; that means we
943 don't need to initialise the linker separately */
944 if (linker_init_done == 1) { return; } else {
945 linker_init_done = 1;
948 stablehash = allocStrHashTable();
949 symhash = allocStrHashTable();
951 /* populate the symbol table with stuff from the RTS */
952 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
953 ghciInsertStrHashTable("(GHCi built-in symbols)",
954 symhash, sym->lbl, sym->addr);
956 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
957 machoInitSymbolsWithoutUnderscore();
960 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
961 # if defined(RTLD_DEFAULT)
962 dl_prog_handle = RTLD_DEFAULT;
964 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
965 # endif /* RTLD_DEFAULT */
969 /* -----------------------------------------------------------------------------
970 * Loading DLL or .so dynamic libraries
971 * -----------------------------------------------------------------------------
973 * Add a DLL from which symbols may be found. In the ELF case, just
974 * do RTLD_GLOBAL-style add, so no further messing around needs to
975 * happen in order that symbols in the loaded .so are findable --
976 * lookupSymbol() will subsequently see them by dlsym on the program's
977 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
979 * In the PEi386 case, open the DLLs and put handles to them in a
980 * linked list. When looking for a symbol, try all handles in the
981 * list. This means that we need to load even DLLs that are guaranteed
982 * to be in the ghc.exe image already, just so we can get a handle
983 * to give to loadSymbol, so that we can find the symbols. For such
984 * libraries, the LoadLibrary call should be a no-op except for returning
989 #if defined(OBJFORMAT_PEi386)
990 /* A record for storing handles into DLLs. */
995 struct _OpenedDLL* next;
1000 /* A list thereof. */
1001 static OpenedDLL* opened_dlls = NULL;
1005 addDLL( char *dll_name )
1007 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1008 /* ------------------- ELF DLL loader ------------------- */
1014 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
1017 /* dlopen failed; return a ptr to the error msg. */
1019 if (errmsg == NULL) errmsg = "addDLL: unknown error";
1026 # elif defined(OBJFORMAT_PEi386)
1027 /* ------------------- Win32 DLL loader ------------------- */
1035 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
1037 /* See if we've already got it, and ignore if so. */
1038 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1039 if (0 == strcmp(o_dll->name, dll_name))
1043 /* The file name has no suffix (yet) so that we can try
1044 both foo.dll and foo.drv
1046 The documentation for LoadLibrary says:
1047 If no file name extension is specified in the lpFileName
1048 parameter, the default library extension .dll is
1049 appended. However, the file name string can include a trailing
1050 point character (.) to indicate that the module name has no
1053 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
1054 sprintf(buf, "%s.DLL", dll_name);
1055 instance = LoadLibrary(buf);
1056 if (instance == NULL) {
1057 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
1058 instance = LoadLibrary(buf);
1059 if (instance == NULL) {
1062 /* LoadLibrary failed; return a ptr to the error msg. */
1063 return "addDLL: unknown error";
1068 /* Add this DLL to the list of DLLs in which to search for symbols. */
1069 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
1070 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
1071 strcpy(o_dll->name, dll_name);
1072 o_dll->instance = instance;
1073 o_dll->next = opened_dlls;
1074 opened_dlls = o_dll;
1078 barf("addDLL: not implemented on this platform");
1082 /* -----------------------------------------------------------------------------
1083 * insert a stable symbol in the hash table
1087 insertStableSymbol(char* obj_name, char* key, StgPtr p)
1089 ghciInsertStrHashTable(obj_name, stablehash, key, getStablePtr(p));
1093 /* -----------------------------------------------------------------------------
1094 * insert a symbol in the hash table
1097 insertSymbol(char* obj_name, char* key, void* data)
1099 ghciInsertStrHashTable(obj_name, symhash, key, data);
1102 /* -----------------------------------------------------------------------------
1103 * lookup a symbol in the hash table
1106 lookupSymbol( char *lbl )
1110 ASSERT(symhash != NULL);
1111 val = lookupStrHashTable(symhash, lbl);
1114 # if defined(OBJFORMAT_ELF)
1115 return dlsym(dl_prog_handle, lbl);
1116 # elif defined(OBJFORMAT_MACHO)
1118 /* On OS X 10.3 and later, we use dlsym instead of the old legacy
1121 HACK: On OS X, global symbols are prefixed with an underscore.
1122 However, dlsym wants us to omit the leading underscore from the
1123 symbol name. For now, we simply strip it off here (and ONLY
1126 ASSERT(lbl[0] == '_');
1127 return dlsym(dl_prog_handle, lbl+1);
1129 if(NSIsSymbolNameDefined(lbl)) {
1130 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
1131 return NSAddressOfSymbol(symbol);
1135 # endif /* HAVE_DLFCN_H */
1136 # elif defined(OBJFORMAT_PEi386)
1139 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1140 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
1141 if (lbl[0] == '_') {
1142 /* HACK: if the name has an initial underscore, try stripping
1143 it off & look that up first. I've yet to verify whether there's
1144 a Rule that governs whether an initial '_' *should always* be
1145 stripped off when mapping from import lib name to the DLL name.
1147 sym = GetProcAddress(o_dll->instance, (lbl+1));
1149 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
1153 sym = GetProcAddress(o_dll->instance, lbl);
1155 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
1170 __attribute((unused))
1172 lookupLocalSymbol( ObjectCode* oc, char *lbl )
1176 val = lookupStrHashTable(oc->lochash, lbl);
1186 /* -----------------------------------------------------------------------------
1187 * Debugging aid: look in GHCi's object symbol tables for symbols
1188 * within DELTA bytes of the specified address, and show their names.
1191 void ghci_enquire ( char* addr );
1193 void ghci_enquire ( char* addr )
1198 const int DELTA = 64;
1203 for (oc = objects; oc; oc = oc->next) {
1204 for (i = 0; i < oc->n_symbols; i++) {
1205 sym = oc->symbols[i];
1206 if (sym == NULL) continue;
1207 // debugBelch("enquire %p %p\n", sym, oc->lochash);
1209 if (oc->lochash != NULL) {
1210 a = lookupStrHashTable(oc->lochash, sym);
1213 a = lookupStrHashTable(symhash, sym);
1216 // debugBelch("ghci_enquire: can't find %s\n", sym);
1218 else if (addr-DELTA <= a && a <= addr+DELTA) {
1219 debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym);
1226 #ifdef ia64_HOST_ARCH
1227 static unsigned int PLTSize(void);
1230 /* -----------------------------------------------------------------------------
1231 * Load an obj (populate the global symbol table, but don't resolve yet)
1233 * Returns: 1 if ok, 0 on error.
1236 loadObj( char *path )
1243 void *map_addr = NULL;
1249 /* debugBelch("loadObj %s\n", path ); */
1251 /* Check that we haven't already loaded this object.
1252 Ignore requests to load multiple times */
1256 for (o = objects; o; o = o->next) {
1257 if (0 == strcmp(o->fileName, path)) {
1259 break; /* don't need to search further */
1263 IF_DEBUG(linker, debugBelch(
1264 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1265 "same object file twice:\n"
1267 "GHCi will ignore this, but be warned.\n"
1269 return 1; /* success */
1273 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1275 # if defined(OBJFORMAT_ELF)
1276 oc->formatName = "ELF";
1277 # elif defined(OBJFORMAT_PEi386)
1278 oc->formatName = "PEi386";
1279 # elif defined(OBJFORMAT_MACHO)
1280 oc->formatName = "Mach-O";
1283 barf("loadObj: not implemented on this platform");
1286 r = stat(path, &st);
1287 if (r == -1) { return 0; }
1289 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1290 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1291 strcpy(oc->fileName, path);
1293 oc->fileSize = st.st_size;
1295 oc->sections = NULL;
1296 oc->lochash = allocStrHashTable();
1297 oc->proddables = NULL;
1299 /* chain it onto the list of objects */
1304 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1306 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1308 #if defined(openbsd_HOST_OS)
1309 fd = open(path, O_RDONLY, S_IRUSR);
1311 fd = open(path, O_RDONLY);
1314 barf("loadObj: can't open `%s'", path);
1316 pagesize = getpagesize();
1318 #ifdef ia64_HOST_ARCH
1319 /* The PLT needs to be right before the object */
1320 n = ROUND_UP(PLTSize(), pagesize);
1321 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1322 if (oc->plt == MAP_FAILED)
1323 barf("loadObj: can't allocate PLT");
1326 map_addr = oc->plt + n;
1329 n = ROUND_UP(oc->fileSize, pagesize);
1331 /* Link objects into the lower 2Gb on x86_64. GHC assumes the
1332 * small memory model on this architecture (see gcc docs,
1335 * MAP_32BIT not available on OpenBSD/amd64
1337 #if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
1338 #define EXTRA_MAP_FLAGS MAP_32BIT
1340 #define EXTRA_MAP_FLAGS 0
1343 /* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
1344 #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
1345 #define MAP_ANONYMOUS MAP_ANON
1348 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE,
1349 MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
1350 if (oc->image == MAP_FAILED)
1351 barf("loadObj: can't map `%s'", path);
1355 #else /* !USE_MMAP */
1357 /* load the image into memory */
1358 f = fopen(path, "rb");
1360 barf("loadObj: can't read `%s'", path);
1362 # if defined(mingw32_HOST_OS)
1363 // TODO: We would like to use allocateExec here, but allocateExec
1364 // cannot currently allocate blocks large enough.
1365 oc->image = VirtualAlloc(NULL, oc->fileSize, MEM_RESERVE | MEM_COMMIT,
1366 PAGE_EXECUTE_READWRITE);
1367 # elif defined(darwin_HOST_OS)
1368 // In a Mach-O .o file, all sections can and will be misaligned
1369 // if the total size of the headers is not a multiple of the
1370 // desired alignment. This is fine for .o files that only serve
1371 // as input for the static linker, but it's not fine for us,
1372 // as SSE (used by gcc for floating point) and Altivec require
1373 // 16-byte alignment.
1374 // We calculate the correct alignment from the header before
1375 // reading the file, and then we misalign oc->image on purpose so
1376 // that the actual sections end up aligned again.
1377 oc->misalignment = machoGetMisalignment(f);
1378 oc->image = stgMallocBytes(oc->fileSize + oc->misalignment, "loadObj(image)");
1379 oc->image += oc->misalignment;
1381 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1384 n = fread ( oc->image, 1, oc->fileSize, f );
1385 if (n != oc->fileSize)
1386 barf("loadObj: error whilst reading `%s'", path);
1389 #endif /* USE_MMAP */
1391 # if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
1392 r = ocAllocateSymbolExtras_MachO ( oc );
1393 if (!r) { return r; }
1394 # elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
1395 r = ocAllocateSymbolExtras_ELF ( oc );
1396 if (!r) { return r; }
1399 /* verify the in-memory image */
1400 # if defined(OBJFORMAT_ELF)
1401 r = ocVerifyImage_ELF ( oc );
1402 # elif defined(OBJFORMAT_PEi386)
1403 r = ocVerifyImage_PEi386 ( oc );
1404 # elif defined(OBJFORMAT_MACHO)
1405 r = ocVerifyImage_MachO ( oc );
1407 barf("loadObj: no verify method");
1409 if (!r) { return r; }
1411 /* build the symbol list for this image */
1412 # if defined(OBJFORMAT_ELF)
1413 r = ocGetNames_ELF ( oc );
1414 # elif defined(OBJFORMAT_PEi386)
1415 r = ocGetNames_PEi386 ( oc );
1416 # elif defined(OBJFORMAT_MACHO)
1417 r = ocGetNames_MachO ( oc );
1419 barf("loadObj: no getNames method");
1421 if (!r) { return r; }
1423 /* loaded, but not resolved yet */
1424 oc->status = OBJECT_LOADED;
1429 /* -----------------------------------------------------------------------------
1430 * resolve all the currently unlinked objects in memory
1432 * Returns: 1 if ok, 0 on error.
1442 for (oc = objects; oc; oc = oc->next) {
1443 if (oc->status != OBJECT_RESOLVED) {
1444 # if defined(OBJFORMAT_ELF)
1445 r = ocResolve_ELF ( oc );
1446 # elif defined(OBJFORMAT_PEi386)
1447 r = ocResolve_PEi386 ( oc );
1448 # elif defined(OBJFORMAT_MACHO)
1449 r = ocResolve_MachO ( oc );
1451 barf("resolveObjs: not implemented on this platform");
1453 if (!r) { return r; }
1454 oc->status = OBJECT_RESOLVED;
1460 /* -----------------------------------------------------------------------------
1461 * delete an object from the pool
1464 unloadObj( char *path )
1466 ObjectCode *oc, *prev;
1468 ASSERT(symhash != NULL);
1469 ASSERT(objects != NULL);
1474 for (oc = objects; oc; prev = oc, oc = oc->next) {
1475 if (!strcmp(oc->fileName,path)) {
1477 /* Remove all the mappings for the symbols within this
1482 for (i = 0; i < oc->n_symbols; i++) {
1483 if (oc->symbols[i] != NULL) {
1484 removeStrHashTable(symhash, oc->symbols[i], NULL);
1492 prev->next = oc->next;
1495 // We're going to leave this in place, in case there are
1496 // any pointers from the heap into it:
1497 // #ifdef mingw32_HOST_OS
1498 // VirtualFree(oc->image);
1500 // stgFree(oc->image);
1502 stgFree(oc->fileName);
1503 stgFree(oc->symbols);
1504 stgFree(oc->sections);
1505 /* The local hash table should have been freed at the end
1506 of the ocResolve_ call on it. */
1507 ASSERT(oc->lochash == NULL);
1513 errorBelch("unloadObj: can't find `%s' to unload", path);
1517 /* -----------------------------------------------------------------------------
1518 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1519 * which may be prodded during relocation, and abort if we try and write
1520 * outside any of these.
1522 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1525 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1526 /* debugBelch("aPB %p %p %d\n", oc, start, size); */
1530 pb->next = oc->proddables;
1531 oc->proddables = pb;
1534 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1537 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1538 char* s = (char*)(pb->start);
1539 char* e = s + pb->size - 1;
1540 char* a = (char*)addr;
1541 /* Assumes that the biggest fixup involves a 4-byte write. This
1542 probably needs to be changed to 8 (ie, +7) on 64-bit
1544 if (a >= s && (a+3) <= e) return;
1546 barf("checkProddableBlock: invalid fixup in runtime linker");
1549 /* -----------------------------------------------------------------------------
1550 * Section management.
1552 static void addSection ( ObjectCode* oc, SectionKind kind,
1553 void* start, void* end )
1555 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1559 s->next = oc->sections;
1562 debugBelch("addSection: %p-%p (size %d), kind %d\n",
1563 start, ((char*)end)-1, end - start + 1, kind );
1568 /* --------------------------------------------------------------------------
1570 * This is about allocating a small chunk of memory for every symbol in the
1571 * object file. We make sure that the SymboLExtras are always "in range" of
1572 * limited-range PC-relative instructions on various platforms by allocating
1573 * them right next to the object code itself.
1576 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
1579 ocAllocateSymbolExtras
1581 Allocate additional space at the end of the object file image to make room
1582 for jump islands (powerpc, x86_64) and GOT entries (x86_64).
1584 PowerPC relative branch instructions have a 24 bit displacement field.
1585 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
1586 If a particular imported symbol is outside this range, we have to redirect
1587 the jump to a short piece of new code that just loads the 32bit absolute
1588 address and jumps there.
1589 On x86_64, PC-relative jumps and PC-relative accesses to the GOT are limited
1592 This function just allocates space for one SymbolExtra for every
1593 undefined symbol in the object file. The code for the jump islands is
1594 filled in by makeSymbolExtra below.
1597 static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
1604 int misalignment = 0;
1605 #ifdef darwin_HOST_OS
1606 misalignment = oc->misalignment;
1612 // round up to the nearest 4
1613 aligned = (oc->fileSize + 3) & ~3;
1616 #ifndef linux_HOST_OS /* mremap is a linux extension */
1617 #error ocAllocateSymbolExtras doesnt want USE_MMAP to be defined
1620 pagesize = getpagesize();
1621 n = ROUND_UP( oc->fileSize, pagesize );
1622 m = ROUND_UP( aligned + sizeof (SymbolExtra) * count, pagesize );
1624 /* If we have a half-page-size file and map one page of it then
1625 * the part of the page after the size of the file remains accessible.
1626 * If, however, we map in 2 pages, the 2nd page is not accessible
1627 * and will give a "Bus Error" on access. To get around this, we check
1628 * if we need any extra pages for the jump islands and map them in
1629 * anonymously. We must check that we actually require extra pages
1630 * otherwise the attempt to mmap 0 pages of anonymous memory will
1636 /* The effect of this mremap() call is only the ensure that we have
1637 * a sufficient number of virtually contiguous pages. As returned from
1638 * mremap, the pages past the end of the file are not backed. We give
1639 * them a backing by using MAP_FIXED to map in anonymous pages.
1641 oc->image = mremap( oc->image, n, m, MREMAP_MAYMOVE );
1643 if( oc->image == MAP_FAILED )
1645 errorBelch( "Unable to mremap for Jump Islands\n" );
1649 if( mmap( oc->image + n, m - n, PROT_READ | PROT_WRITE | PROT_EXEC,
1650 MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, 0, 0 ) == MAP_FAILED )
1652 errorBelch( "Unable to mmap( MAP_FIXED ) for Jump Islands\n" );
1658 oc->image -= misalignment;
1659 oc->image = stgReallocBytes( oc->image,
1661 aligned + sizeof (SymbolExtra) * count,
1662 "ocAllocateSymbolExtras" );
1663 oc->image += misalignment;
1664 #endif /* USE_MMAP */
1666 oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
1667 memset( oc->symbol_extras, 0, sizeof (SymbolExtra) * count );
1670 oc->symbol_extras = NULL;
1672 oc->first_symbol_extra = first;
1673 oc->n_symbol_extras = count;
1678 static SymbolExtra* makeSymbolExtra( ObjectCode* oc,
1679 unsigned long symbolNumber,
1680 unsigned long target )
1684 ASSERT( symbolNumber >= oc->first_symbol_extra
1685 && symbolNumber - oc->first_symbol_extra < oc->n_symbol_extras);
1687 extra = &oc->symbol_extras[symbolNumber - oc->first_symbol_extra];
1689 #ifdef powerpc_HOST_ARCH
1690 // lis r12, hi16(target)
1691 extra->jumpIsland.lis_r12 = 0x3d80;
1692 extra->jumpIsland.hi_addr = target >> 16;
1694 // ori r12, r12, lo16(target)
1695 extra->jumpIsland.ori_r12_r12 = 0x618c;
1696 extra->jumpIsland.lo_addr = target & 0xffff;
1699 extra->jumpIsland.mtctr_r12 = 0x7d8903a6;
1702 extra->jumpIsland.bctr = 0x4e800420;
1704 #ifdef x86_64_HOST_ARCH
1706 static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
1707 extra->addr = target;
1708 memcpy(extra->jumpIsland, jmp, 6);
1716 /* --------------------------------------------------------------------------
1717 * PowerPC specifics (instruction cache flushing)
1718 * ------------------------------------------------------------------------*/
1720 #ifdef powerpc_TARGET_ARCH
1722 ocFlushInstructionCache
1724 Flush the data & instruction caches.
1725 Because the PPC has split data/instruction caches, we have to
1726 do that whenever we modify code at runtime.
1729 static void ocFlushInstructionCache( ObjectCode *oc )
1731 int n = (oc->fileSize + sizeof( SymbolExtra ) * oc->n_symbol_extras + 3) / 4;
1732 unsigned long *p = (unsigned long *) oc->image;
1736 __asm__ volatile ( "dcbf 0,%0\n\t"
1744 __asm__ volatile ( "sync\n\t"
1750 /* --------------------------------------------------------------------------
1751 * PEi386 specifics (Win32 targets)
1752 * ------------------------------------------------------------------------*/
1754 /* The information for this linker comes from
1755 Microsoft Portable Executable
1756 and Common Object File Format Specification
1757 revision 5.1 January 1998
1758 which SimonM says comes from the MS Developer Network CDs.
1760 It can be found there (on older CDs), but can also be found
1763 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1765 (this is Rev 6.0 from February 1999).
1767 Things move, so if that fails, try searching for it via
1769 http://www.google.com/search?q=PE+COFF+specification
1771 The ultimate reference for the PE format is the Winnt.h
1772 header file that comes with the Platform SDKs; as always,
1773 implementations will drift wrt their documentation.
1775 A good background article on the PE format is Matt Pietrek's
1776 March 1994 article in Microsoft System Journal (MSJ)
1777 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1778 Win32 Portable Executable File Format." The info in there
1779 has recently been updated in a two part article in
1780 MSDN magazine, issues Feb and March 2002,
1781 "Inside Windows: An In-Depth Look into the Win32 Portable
1782 Executable File Format"
1784 John Levine's book "Linkers and Loaders" contains useful
1789 #if defined(OBJFORMAT_PEi386)
1793 typedef unsigned char UChar;
1794 typedef unsigned short UInt16;
1795 typedef unsigned int UInt32;
1802 UInt16 NumberOfSections;
1803 UInt32 TimeDateStamp;
1804 UInt32 PointerToSymbolTable;
1805 UInt32 NumberOfSymbols;
1806 UInt16 SizeOfOptionalHeader;
1807 UInt16 Characteristics;
1811 #define sizeof_COFF_header 20
1818 UInt32 VirtualAddress;
1819 UInt32 SizeOfRawData;
1820 UInt32 PointerToRawData;
1821 UInt32 PointerToRelocations;
1822 UInt32 PointerToLinenumbers;
1823 UInt16 NumberOfRelocations;
1824 UInt16 NumberOfLineNumbers;
1825 UInt32 Characteristics;
1829 #define sizeof_COFF_section 40
1836 UInt16 SectionNumber;
1839 UChar NumberOfAuxSymbols;
1843 #define sizeof_COFF_symbol 18
1848 UInt32 VirtualAddress;
1849 UInt32 SymbolTableIndex;
1854 #define sizeof_COFF_reloc 10
1857 /* From PE spec doc, section 3.3.2 */
1858 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1859 windows.h -- for the same purpose, but I want to know what I'm
1861 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1862 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1863 #define MYIMAGE_FILE_DLL 0x2000
1864 #define MYIMAGE_FILE_SYSTEM 0x1000
1865 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1866 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1867 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1869 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1870 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1871 #define MYIMAGE_SYM_CLASS_STATIC 3
1872 #define MYIMAGE_SYM_UNDEFINED 0
1874 /* From PE spec doc, section 4.1 */
1875 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1876 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1877 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1879 /* From PE spec doc, section 5.2.1 */
1880 #define MYIMAGE_REL_I386_DIR32 0x0006
1881 #define MYIMAGE_REL_I386_REL32 0x0014
1884 /* We use myindex to calculate array addresses, rather than
1885 simply doing the normal subscript thing. That's because
1886 some of the above structs have sizes which are not
1887 a whole number of words. GCC rounds their sizes up to a
1888 whole number of words, which means that the address calcs
1889 arising from using normal C indexing or pointer arithmetic
1890 are just plain wrong. Sigh.
1893 myindex ( int scale, void* base, int index )
1896 ((UChar*)base) + scale * index;
1901 printName ( UChar* name, UChar* strtab )
1903 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1904 UInt32 strtab_offset = * (UInt32*)(name+4);
1905 debugBelch("%s", strtab + strtab_offset );
1908 for (i = 0; i < 8; i++) {
1909 if (name[i] == 0) break;
1910 debugBelch("%c", name[i] );
1917 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1919 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1920 UInt32 strtab_offset = * (UInt32*)(name+4);
1921 strncpy ( dst, strtab+strtab_offset, dstSize );
1927 if (name[i] == 0) break;
1937 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1940 /* If the string is longer than 8 bytes, look in the
1941 string table for it -- this will be correctly zero terminated.
1943 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1944 UInt32 strtab_offset = * (UInt32*)(name+4);
1945 return ((UChar*)strtab) + strtab_offset;
1947 /* Otherwise, if shorter than 8 bytes, return the original,
1948 which by defn is correctly terminated.
1950 if (name[7]==0) return name;
1951 /* The annoying case: 8 bytes. Copy into a temporary
1952 (which is never freed ...)
1954 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1956 strncpy(newstr,name,8);
1962 /* Just compares the short names (first 8 chars) */
1963 static COFF_section *
1964 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1968 = (COFF_header*)(oc->image);
1969 COFF_section* sectab
1971 ((UChar*)(oc->image))
1972 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1974 for (i = 0; i < hdr->NumberOfSections; i++) {
1977 COFF_section* section_i
1979 myindex ( sizeof_COFF_section, sectab, i );
1980 n1 = (UChar*) &(section_i->Name);
1982 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1983 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1984 n1[6]==n2[6] && n1[7]==n2[7])
1993 zapTrailingAtSign ( UChar* sym )
1995 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1997 if (sym[0] == 0) return;
1999 while (sym[i] != 0) i++;
2002 while (j > 0 && my_isdigit(sym[j])) j--;
2003 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
2009 ocVerifyImage_PEi386 ( ObjectCode* oc )
2014 COFF_section* sectab;
2015 COFF_symbol* symtab;
2017 /* debugBelch("\nLOADING %s\n", oc->fileName); */
2018 hdr = (COFF_header*)(oc->image);
2019 sectab = (COFF_section*) (
2020 ((UChar*)(oc->image))
2021 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2023 symtab = (COFF_symbol*) (
2024 ((UChar*)(oc->image))
2025 + hdr->PointerToSymbolTable
2027 strtab = ((UChar*)symtab)
2028 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2030 if (hdr->Machine != 0x14c) {
2031 errorBelch("%s: Not x86 PEi386", oc->fileName);
2034 if (hdr->SizeOfOptionalHeader != 0) {
2035 errorBelch("%s: PEi386 with nonempty optional header", oc->fileName);
2038 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
2039 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
2040 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
2041 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
2042 errorBelch("%s: Not a PEi386 object file", oc->fileName);
2045 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
2046 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
2047 errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
2049 (int)(hdr->Characteristics));
2052 /* If the string table size is way crazy, this might indicate that
2053 there are more than 64k relocations, despite claims to the
2054 contrary. Hence this test. */
2055 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
2057 if ( (*(UInt32*)strtab) > 600000 ) {
2058 /* Note that 600k has no special significance other than being
2059 big enough to handle the almost-2MB-sized lumps that
2060 constitute HSwin32*.o. */
2061 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
2066 /* No further verification after this point; only debug printing. */
2068 IF_DEBUG(linker, i=1);
2069 if (i == 0) return 1;
2071 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
2072 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
2073 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
2076 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
2077 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
2078 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
2079 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
2080 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
2081 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
2082 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
2084 /* Print the section table. */
2086 for (i = 0; i < hdr->NumberOfSections; i++) {
2088 COFF_section* sectab_i
2090 myindex ( sizeof_COFF_section, sectab, i );
2097 printName ( sectab_i->Name, strtab );
2107 sectab_i->VirtualSize,
2108 sectab_i->VirtualAddress,
2109 sectab_i->SizeOfRawData,
2110 sectab_i->PointerToRawData,
2111 sectab_i->NumberOfRelocations,
2112 sectab_i->PointerToRelocations,
2113 sectab_i->PointerToRawData
2115 reltab = (COFF_reloc*) (
2116 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2119 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2120 /* If the relocation field (a short) has overflowed, the
2121 * real count can be found in the first reloc entry.
2123 * See Section 4.1 (last para) of the PE spec (rev6.0).
2125 COFF_reloc* rel = (COFF_reloc*)
2126 myindex ( sizeof_COFF_reloc, reltab, 0 );
2127 noRelocs = rel->VirtualAddress;
2130 noRelocs = sectab_i->NumberOfRelocations;
2134 for (; j < noRelocs; j++) {
2136 COFF_reloc* rel = (COFF_reloc*)
2137 myindex ( sizeof_COFF_reloc, reltab, j );
2139 " type 0x%-4x vaddr 0x%-8x name `",
2141 rel->VirtualAddress );
2142 sym = (COFF_symbol*)
2143 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
2144 /* Hmm..mysterious looking offset - what's it for? SOF */
2145 printName ( sym->Name, strtab -10 );
2152 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
2153 debugBelch("---START of string table---\n");
2154 for (i = 4; i < *(Int32*)strtab; i++) {
2156 debugBelch("\n"); else
2157 debugBelch("%c", strtab[i] );
2159 debugBelch("--- END of string table---\n");
2164 COFF_symbol* symtab_i;
2165 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2166 symtab_i = (COFF_symbol*)
2167 myindex ( sizeof_COFF_symbol, symtab, i );
2173 printName ( symtab_i->Name, strtab );
2182 (Int32)(symtab_i->SectionNumber),
2183 (UInt32)symtab_i->Type,
2184 (UInt32)symtab_i->StorageClass,
2185 (UInt32)symtab_i->NumberOfAuxSymbols
2187 i += symtab_i->NumberOfAuxSymbols;
2197 ocGetNames_PEi386 ( ObjectCode* oc )
2200 COFF_section* sectab;
2201 COFF_symbol* symtab;
2208 hdr = (COFF_header*)(oc->image);
2209 sectab = (COFF_section*) (
2210 ((UChar*)(oc->image))
2211 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2213 symtab = (COFF_symbol*) (
2214 ((UChar*)(oc->image))
2215 + hdr->PointerToSymbolTable
2217 strtab = ((UChar*)(oc->image))
2218 + hdr->PointerToSymbolTable
2219 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2221 /* Allocate space for any (local, anonymous) .bss sections. */
2223 for (i = 0; i < hdr->NumberOfSections; i++) {
2226 COFF_section* sectab_i
2228 myindex ( sizeof_COFF_section, sectab, i );
2229 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
2230 /* sof 10/05: the PE spec text isn't too clear regarding what
2231 * the SizeOfRawData field is supposed to hold for object
2232 * file sections containing just uninitialized data -- for executables,
2233 * it is supposed to be zero; unclear what it's supposed to be
2234 * for object files. However, VirtualSize is guaranteed to be
2235 * zero for object files, which definitely suggests that SizeOfRawData
2236 * will be non-zero (where else would the size of this .bss section be
2237 * stored?) Looking at the COFF_section info for incoming object files,
2238 * this certainly appears to be the case.
2240 * => I suspect we've been incorrectly handling .bss sections in (relocatable)
2241 * object files up until now. This turned out to bite us with ghc-6.4.1's use
2242 * of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
2243 * variable decls into to the .bss section. (The specific function in Q which
2244 * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
2246 if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
2247 /* This is a non-empty .bss section. Allocate zeroed space for
2248 it, and set its PointerToRawData field such that oc->image +
2249 PointerToRawData == addr_of_zeroed_space. */
2250 bss_sz = sectab_i->VirtualSize;
2251 if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
2252 zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
2253 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
2254 addProddableBlock(oc, zspace, bss_sz);
2255 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
2258 /* Copy section information into the ObjectCode. */
2260 for (i = 0; i < hdr->NumberOfSections; i++) {
2266 = SECTIONKIND_OTHER;
2267 COFF_section* sectab_i
2269 myindex ( sizeof_COFF_section, sectab, i );
2270 IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
2273 /* I'm sure this is the Right Way to do it. However, the
2274 alternative of testing the sectab_i->Name field seems to
2275 work ok with Cygwin.
2277 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
2278 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
2279 kind = SECTIONKIND_CODE_OR_RODATA;
2282 if (0==strcmp(".text",sectab_i->Name) ||
2283 0==strcmp(".rdata",sectab_i->Name)||
2284 0==strcmp(".rodata",sectab_i->Name))
2285 kind = SECTIONKIND_CODE_OR_RODATA;
2286 if (0==strcmp(".data",sectab_i->Name) ||
2287 0==strcmp(".bss",sectab_i->Name))
2288 kind = SECTIONKIND_RWDATA;
2290 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
2291 sz = sectab_i->SizeOfRawData;
2292 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
2294 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
2295 end = start + sz - 1;
2297 if (kind == SECTIONKIND_OTHER
2298 /* Ignore sections called which contain stabs debugging
2300 && 0 != strcmp(".stab", sectab_i->Name)
2301 && 0 != strcmp(".stabstr", sectab_i->Name)
2302 /* ignore constructor section for now */
2303 && 0 != strcmp(".ctors", sectab_i->Name)
2304 /* ignore section generated from .ident */
2305 && 0!= strcmp("/4", sectab_i->Name)
2307 errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
2311 if (kind != SECTIONKIND_OTHER && end >= start) {
2312 addSection(oc, kind, start, end);
2313 addProddableBlock(oc, start, end - start + 1);
2317 /* Copy exported symbols into the ObjectCode. */
2319 oc->n_symbols = hdr->NumberOfSymbols;
2320 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2321 "ocGetNames_PEi386(oc->symbols)");
2322 /* Call me paranoid; I don't care. */
2323 for (i = 0; i < oc->n_symbols; i++)
2324 oc->symbols[i] = NULL;
2328 COFF_symbol* symtab_i;
2329 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2330 symtab_i = (COFF_symbol*)
2331 myindex ( sizeof_COFF_symbol, symtab, i );
2335 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
2336 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
2337 /* This symbol is global and defined, viz, exported */
2338 /* for MYIMAGE_SYMCLASS_EXTERNAL
2339 && !MYIMAGE_SYM_UNDEFINED,
2340 the address of the symbol is:
2341 address of relevant section + offset in section
2343 COFF_section* sectabent
2344 = (COFF_section*) myindex ( sizeof_COFF_section,
2346 symtab_i->SectionNumber-1 );
2347 addr = ((UChar*)(oc->image))
2348 + (sectabent->PointerToRawData
2352 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
2353 && symtab_i->Value > 0) {
2354 /* This symbol isn't in any section at all, ie, global bss.
2355 Allocate zeroed space for it. */
2356 addr = stgCallocBytes(1, symtab_i->Value,
2357 "ocGetNames_PEi386(non-anonymous bss)");
2358 addSection(oc, SECTIONKIND_RWDATA, addr,
2359 ((UChar*)addr) + symtab_i->Value - 1);
2360 addProddableBlock(oc, addr, symtab_i->Value);
2361 /* debugBelch("BSS section at 0x%x\n", addr); */
2364 if (addr != NULL ) {
2365 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
2366 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
2367 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
2368 ASSERT(i >= 0 && i < oc->n_symbols);
2369 /* cstring_from_COFF_symbol_name always succeeds. */
2370 oc->symbols[i] = sname;
2371 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
2375 "IGNORING symbol %d\n"
2379 printName ( symtab_i->Name, strtab );
2388 (Int32)(symtab_i->SectionNumber),
2389 (UInt32)symtab_i->Type,
2390 (UInt32)symtab_i->StorageClass,
2391 (UInt32)symtab_i->NumberOfAuxSymbols
2396 i += symtab_i->NumberOfAuxSymbols;
2405 ocResolve_PEi386 ( ObjectCode* oc )
2408 COFF_section* sectab;
2409 COFF_symbol* symtab;
2419 /* ToDo: should be variable-sized? But is at least safe in the
2420 sense of buffer-overrun-proof. */
2422 /* debugBelch("resolving for %s\n", oc->fileName); */
2424 hdr = (COFF_header*)(oc->image);
2425 sectab = (COFF_section*) (
2426 ((UChar*)(oc->image))
2427 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2429 symtab = (COFF_symbol*) (
2430 ((UChar*)(oc->image))
2431 + hdr->PointerToSymbolTable
2433 strtab = ((UChar*)(oc->image))
2434 + hdr->PointerToSymbolTable
2435 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2437 for (i = 0; i < hdr->NumberOfSections; i++) {
2438 COFF_section* sectab_i
2440 myindex ( sizeof_COFF_section, sectab, i );
2443 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2446 /* Ignore sections called which contain stabs debugging
2448 if (0 == strcmp(".stab", sectab_i->Name)
2449 || 0 == strcmp(".stabstr", sectab_i->Name)
2450 || 0 == strcmp(".ctors", sectab_i->Name))
2453 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2454 /* If the relocation field (a short) has overflowed, the
2455 * real count can be found in the first reloc entry.
2457 * See Section 4.1 (last para) of the PE spec (rev6.0).
2459 * Nov2003 update: the GNU linker still doesn't correctly
2460 * handle the generation of relocatable object files with
2461 * overflown relocations. Hence the output to warn of potential
2464 COFF_reloc* rel = (COFF_reloc*)
2465 myindex ( sizeof_COFF_reloc, reltab, 0 );
2466 noRelocs = rel->VirtualAddress;
2468 /* 10/05: we now assume (and check for) a GNU ld that is capable
2469 * of handling object files with (>2^16) of relocs.
2472 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
2477 noRelocs = sectab_i->NumberOfRelocations;
2482 for (; j < noRelocs; j++) {
2484 COFF_reloc* reltab_j
2486 myindex ( sizeof_COFF_reloc, reltab, j );
2488 /* the location to patch */
2490 ((UChar*)(oc->image))
2491 + (sectab_i->PointerToRawData
2492 + reltab_j->VirtualAddress
2493 - sectab_i->VirtualAddress )
2495 /* the existing contents of pP */
2497 /* the symbol to connect to */
2498 sym = (COFF_symbol*)
2499 myindex ( sizeof_COFF_symbol,
2500 symtab, reltab_j->SymbolTableIndex );
2503 "reloc sec %2d num %3d: type 0x%-4x "
2504 "vaddr 0x%-8x name `",
2506 (UInt32)reltab_j->Type,
2507 reltab_j->VirtualAddress );
2508 printName ( sym->Name, strtab );
2509 debugBelch("'\n" ));
2511 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2512 COFF_section* section_sym
2513 = findPEi386SectionCalled ( oc, sym->Name );
2515 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
2518 S = ((UInt32)(oc->image))
2519 + (section_sym->PointerToRawData
2522 copyName ( sym->Name, strtab, symbol, 1000-1 );
2523 S = (UInt32) lookupLocalSymbol( oc, symbol );
2524 if ((void*)S != NULL) goto foundit;
2525 S = (UInt32) lookupSymbol( symbol );
2526 if ((void*)S != NULL) goto foundit;
2527 zapTrailingAtSign ( symbol );
2528 S = (UInt32) lookupLocalSymbol( oc, symbol );
2529 if ((void*)S != NULL) goto foundit;
2530 S = (UInt32) lookupSymbol( symbol );
2531 if ((void*)S != NULL) goto foundit;
2532 /* Newline first because the interactive linker has printed "linking..." */
2533 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2537 checkProddableBlock(oc, pP);
2538 switch (reltab_j->Type) {
2539 case MYIMAGE_REL_I386_DIR32:
2542 case MYIMAGE_REL_I386_REL32:
2543 /* Tricky. We have to insert a displacement at
2544 pP which, when added to the PC for the _next_
2545 insn, gives the address of the target (S).
2546 Problem is to know the address of the next insn
2547 when we only know pP. We assume that this
2548 literal field is always the last in the insn,
2549 so that the address of the next insn is pP+4
2550 -- hence the constant 4.
2551 Also I don't know if A should be added, but so
2552 far it has always been zero.
2554 SOF 05/2005: 'A' (old contents of *pP) have been observed
2555 to contain values other than zero (the 'wx' object file
2556 that came with wxhaskell-0.9.4; dunno how it was compiled..).
2557 So, add displacement to old value instead of asserting
2558 A to be zero. Fixes wxhaskell-related crashes, and no other
2559 ill effects have been observed.
2561 Update: the reason why we're seeing these more elaborate
2562 relocations is due to a switch in how the NCG compiles SRTs
2563 and offsets to them from info tables. SRTs live in .(ro)data,
2564 while info tables live in .text, causing GAS to emit REL32/DISP32
2565 relocations with non-zero values. Adding the displacement is
2566 the right thing to do.
2568 *pP = S - ((UInt32)pP) - 4 + A;
2571 debugBelch("%s: unhandled PEi386 relocation type %d",
2572 oc->fileName, reltab_j->Type);
2579 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
2583 #endif /* defined(OBJFORMAT_PEi386) */
2586 /* --------------------------------------------------------------------------
2588 * ------------------------------------------------------------------------*/
2590 #if defined(OBJFORMAT_ELF)
2595 #if defined(sparc_HOST_ARCH)
2596 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2597 #elif defined(i386_HOST_ARCH)
2598 # define ELF_TARGET_386 /* Used inside <elf.h> */
2599 #elif defined(x86_64_HOST_ARCH)
2600 # define ELF_TARGET_X64_64
2602 #elif defined (ia64_HOST_ARCH)
2603 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2605 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2606 # define ELF_NEED_GOT /* needs Global Offset Table */
2607 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2610 #if !defined(openbsd_HOST_OS)
2613 /* openbsd elf has things in different places, with diff names */
2614 # include <elf_abi.h>
2615 # include <machine/reloc.h>
2616 # define R_386_32 RELOC_32
2617 # define R_386_PC32 RELOC_PC32
2620 /* If elf.h doesn't define it */
2621 # ifndef R_X86_64_PC64
2622 # define R_X86_64_PC64 24
2626 * Define a set of types which can be used for both ELF32 and ELF64
2630 #define ELFCLASS ELFCLASS64
2631 #define Elf_Addr Elf64_Addr
2632 #define Elf_Word Elf64_Word
2633 #define Elf_Sword Elf64_Sword
2634 #define Elf_Ehdr Elf64_Ehdr
2635 #define Elf_Phdr Elf64_Phdr
2636 #define Elf_Shdr Elf64_Shdr
2637 #define Elf_Sym Elf64_Sym
2638 #define Elf_Rel Elf64_Rel
2639 #define Elf_Rela Elf64_Rela
2640 #define ELF_ST_TYPE ELF64_ST_TYPE
2641 #define ELF_ST_BIND ELF64_ST_BIND
2642 #define ELF_R_TYPE ELF64_R_TYPE
2643 #define ELF_R_SYM ELF64_R_SYM
2645 #define ELFCLASS ELFCLASS32
2646 #define Elf_Addr Elf32_Addr
2647 #define Elf_Word Elf32_Word
2648 #define Elf_Sword Elf32_Sword
2649 #define Elf_Ehdr Elf32_Ehdr
2650 #define Elf_Phdr Elf32_Phdr
2651 #define Elf_Shdr Elf32_Shdr
2652 #define Elf_Sym Elf32_Sym
2653 #define Elf_Rel Elf32_Rel
2654 #define Elf_Rela Elf32_Rela
2656 #define ELF_ST_TYPE ELF32_ST_TYPE
2659 #define ELF_ST_BIND ELF32_ST_BIND
2662 #define ELF_R_TYPE ELF32_R_TYPE
2665 #define ELF_R_SYM ELF32_R_SYM
2671 * Functions to allocate entries in dynamic sections. Currently we simply
2672 * preallocate a large number, and we don't check if a entry for the given
2673 * target already exists (a linear search is too slow). Ideally these
2674 * entries would be associated with symbols.
2677 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2678 #define GOT_SIZE 0x20000
2679 #define FUNCTION_TABLE_SIZE 0x10000
2680 #define PLT_SIZE 0x08000
2683 static Elf_Addr got[GOT_SIZE];
2684 static unsigned int gotIndex;
2685 static Elf_Addr gp_val = (Elf_Addr)got;
2688 allocateGOTEntry(Elf_Addr target)
2692 if (gotIndex >= GOT_SIZE)
2693 barf("Global offset table overflow");
2695 entry = &got[gotIndex++];
2697 return (Elf_Addr)entry;
2701 #ifdef ELF_FUNCTION_DESC
2707 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2708 static unsigned int functionTableIndex;
2711 allocateFunctionDesc(Elf_Addr target)
2713 FunctionDesc *entry;
2715 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2716 barf("Function table overflow");
2718 entry = &functionTable[functionTableIndex++];
2720 entry->gp = (Elf_Addr)gp_val;
2721 return (Elf_Addr)entry;
2725 copyFunctionDesc(Elf_Addr target)
2727 FunctionDesc *olddesc = (FunctionDesc *)target;
2728 FunctionDesc *newdesc;
2730 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2731 newdesc->gp = olddesc->gp;
2732 return (Elf_Addr)newdesc;
2737 #ifdef ia64_HOST_ARCH
2738 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2739 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2741 static unsigned char plt_code[] =
2743 /* taken from binutils bfd/elfxx-ia64.c */
2744 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2745 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2746 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2747 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2748 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2749 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2752 /* If we can't get to the function descriptor via gp, take a local copy of it */
2753 #define PLT_RELOC(code, target) { \
2754 Elf64_Sxword rel_value = target - gp_val; \
2755 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2756 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2758 ia64_reloc_gprel22((Elf_Addr)code, target); \
2763 unsigned char code[sizeof(plt_code)];
2767 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2769 PLTEntry *plt = (PLTEntry *)oc->plt;
2772 if (oc->pltIndex >= PLT_SIZE)
2773 barf("Procedure table overflow");
2775 entry = &plt[oc->pltIndex++];
2776 memcpy(entry->code, plt_code, sizeof(entry->code));
2777 PLT_RELOC(entry->code, target);
2778 return (Elf_Addr)entry;
2784 return (PLT_SIZE * sizeof(PLTEntry));
2790 * Generic ELF functions
2794 findElfSection ( void* objImage, Elf_Word sh_type )
2796 char* ehdrC = (char*)objImage;
2797 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2798 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2799 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2803 for (i = 0; i < ehdr->e_shnum; i++) {
2804 if (shdr[i].sh_type == sh_type
2805 /* Ignore the section header's string table. */
2806 && i != ehdr->e_shstrndx
2807 /* Ignore string tables named .stabstr, as they contain
2809 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2811 ptr = ehdrC + shdr[i].sh_offset;
2818 #if defined(ia64_HOST_ARCH)
2820 findElfSegment ( void* objImage, Elf_Addr vaddr )
2822 char* ehdrC = (char*)objImage;
2823 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2824 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2825 Elf_Addr segaddr = 0;
2828 for (i = 0; i < ehdr->e_phnum; i++) {
2829 segaddr = phdr[i].p_vaddr;
2830 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2838 ocVerifyImage_ELF ( ObjectCode* oc )
2842 int i, j, nent, nstrtab, nsymtabs;
2846 char* ehdrC = (char*)(oc->image);
2847 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2849 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2850 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2851 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2852 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2853 errorBelch("%s: not an ELF object", oc->fileName);
2857 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2858 errorBelch("%s: unsupported ELF format", oc->fileName);
2862 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2863 IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
2865 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2866 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
2868 errorBelch("%s: unknown endiannness", oc->fileName);
2872 if (ehdr->e_type != ET_REL) {
2873 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
2876 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
2878 IF_DEBUG(linker,debugBelch( "Architecture is " ));
2879 switch (ehdr->e_machine) {
2880 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
2881 #ifdef EM_SPARC32PLUS
2882 case EM_SPARC32PLUS:
2884 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
2886 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
2888 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
2890 case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
2891 #elif defined(EM_AMD64)
2892 case EM_AMD64: IF_DEBUG(linker,debugBelch( "amd64" )); break;
2894 default: IF_DEBUG(linker,debugBelch( "unknown" ));
2895 errorBelch("%s: unknown architecture (e_machine == %d)"
2896 , oc->fileName, ehdr->e_machine);
2900 IF_DEBUG(linker,debugBelch(
2901 "\nSection header table: start %ld, n_entries %d, ent_size %d\n",
2902 (long)ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2904 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2906 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2908 if (ehdr->e_shstrndx == SHN_UNDEF) {
2909 errorBelch("%s: no section header string table", oc->fileName);
2912 IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
2914 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2917 for (i = 0; i < ehdr->e_shnum; i++) {
2918 IF_DEBUG(linker,debugBelch("%2d: ", i ));
2919 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
2920 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
2921 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
2922 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
2923 ehdrC + shdr[i].sh_offset,
2924 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2926 if (shdr[i].sh_type == SHT_REL) {
2927 IF_DEBUG(linker,debugBelch("Rel " ));
2928 } else if (shdr[i].sh_type == SHT_RELA) {
2929 IF_DEBUG(linker,debugBelch("RelA " ));
2931 IF_DEBUG(linker,debugBelch(" "));
2934 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
2938 IF_DEBUG(linker,debugBelch( "\nString tables" ));
2941 for (i = 0; i < ehdr->e_shnum; i++) {
2942 if (shdr[i].sh_type == SHT_STRTAB
2943 /* Ignore the section header's string table. */
2944 && i != ehdr->e_shstrndx
2945 /* Ignore string tables named .stabstr, as they contain
2947 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2949 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
2950 strtab = ehdrC + shdr[i].sh_offset;
2955 errorBelch("%s: no string tables, or too many", oc->fileName);
2960 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
2961 for (i = 0; i < ehdr->e_shnum; i++) {
2962 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2963 IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
2965 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2966 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2967 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%ld rem)\n",
2969 (long)shdr[i].sh_size % sizeof(Elf_Sym)
2971 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2972 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
2975 for (j = 0; j < nent; j++) {
2976 IF_DEBUG(linker,debugBelch(" %2d ", j ));
2977 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
2978 (int)stab[j].st_shndx,
2979 (int)stab[j].st_size,
2980 (char*)stab[j].st_value ));
2982 IF_DEBUG(linker,debugBelch("type=" ));
2983 switch (ELF_ST_TYPE(stab[j].st_info)) {
2984 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
2985 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
2986 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
2987 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
2988 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
2989 default: IF_DEBUG(linker,debugBelch("? " )); break;
2991 IF_DEBUG(linker,debugBelch(" " ));
2993 IF_DEBUG(linker,debugBelch("bind=" ));
2994 switch (ELF_ST_BIND(stab[j].st_info)) {
2995 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
2996 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
2997 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
2998 default: IF_DEBUG(linker,debugBelch("? " )); break;
3000 IF_DEBUG(linker,debugBelch(" " ));
3002 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
3006 if (nsymtabs == 0) {
3007 errorBelch("%s: didn't find any symbol tables", oc->fileName);
3014 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
3018 if (hdr->sh_type == SHT_PROGBITS
3019 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
3020 /* .text-style section */
3021 return SECTIONKIND_CODE_OR_RODATA;
3024 if (hdr->sh_type == SHT_PROGBITS
3025 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3026 /* .data-style section */
3027 return SECTIONKIND_RWDATA;
3030 if (hdr->sh_type == SHT_PROGBITS
3031 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
3032 /* .rodata-style section */
3033 return SECTIONKIND_CODE_OR_RODATA;
3036 if (hdr->sh_type == SHT_NOBITS
3037 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3038 /* .bss-style section */
3040 return SECTIONKIND_RWDATA;
3043 return SECTIONKIND_OTHER;
3048 ocGetNames_ELF ( ObjectCode* oc )
3053 char* ehdrC = (char*)(oc->image);
3054 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3055 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
3056 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3058 ASSERT(symhash != NULL);
3061 errorBelch("%s: no strtab", oc->fileName);
3066 for (i = 0; i < ehdr->e_shnum; i++) {
3067 /* Figure out what kind of section it is. Logic derived from
3068 Figure 1.14 ("Special Sections") of the ELF document
3069 ("Portable Formats Specification, Version 1.1"). */
3071 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
3073 if (is_bss && shdr[i].sh_size > 0) {
3074 /* This is a non-empty .bss section. Allocate zeroed space for
3075 it, and set its .sh_offset field such that
3076 ehdrC + .sh_offset == addr_of_zeroed_space. */
3077 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
3078 "ocGetNames_ELF(BSS)");
3079 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
3081 debugBelch("BSS section at 0x%x, size %d\n",
3082 zspace, shdr[i].sh_size);
3086 /* fill in the section info */
3087 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
3088 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
3089 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
3090 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
3093 if (shdr[i].sh_type != SHT_SYMTAB) continue;
3095 /* copy stuff into this module's object symbol table */
3096 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
3097 nent = shdr[i].sh_size / sizeof(Elf_Sym);
3099 oc->n_symbols = nent;
3100 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3101 "ocGetNames_ELF(oc->symbols)");
3103 for (j = 0; j < nent; j++) {
3105 char isLocal = FALSE; /* avoids uninit-var warning */
3107 char* nm = strtab + stab[j].st_name;
3108 int secno = stab[j].st_shndx;
3110 /* Figure out if we want to add it; if so, set ad to its
3111 address. Otherwise leave ad == NULL. */
3113 if (secno == SHN_COMMON) {
3115 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
3117 debugBelch("COMMON symbol, size %d name %s\n",
3118 stab[j].st_size, nm);
3120 /* Pointless to do addProddableBlock() for this area,
3121 since the linker should never poke around in it. */
3124 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
3125 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
3127 /* and not an undefined symbol */
3128 && stab[j].st_shndx != SHN_UNDEF
3129 /* and not in a "special section" */
3130 && stab[j].st_shndx < SHN_LORESERVE
3132 /* and it's a not a section or string table or anything silly */
3133 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
3134 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
3135 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
3138 /* Section 0 is the undefined section, hence > and not >=. */
3139 ASSERT(secno > 0 && secno < ehdr->e_shnum);
3141 if (shdr[secno].sh_type == SHT_NOBITS) {
3142 debugBelch(" BSS symbol, size %d off %d name %s\n",
3143 stab[j].st_size, stab[j].st_value, nm);
3146 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
3147 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
3150 #ifdef ELF_FUNCTION_DESC
3151 /* dlsym() and the initialisation table both give us function
3152 * descriptors, so to be consistent we store function descriptors
3153 * in the symbol table */
3154 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
3155 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
3157 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s",
3158 ad, oc->fileName, nm ));
3163 /* And the decision is ... */
3167 oc->symbols[j] = nm;
3170 /* Ignore entirely. */
3172 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
3176 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
3177 strtab + stab[j].st_name ));
3180 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
3181 (int)ELF_ST_BIND(stab[j].st_info),
3182 (int)ELF_ST_TYPE(stab[j].st_info),
3183 (int)stab[j].st_shndx,
3184 strtab + stab[j].st_name
3187 oc->symbols[j] = NULL;
3196 /* Do ELF relocations which lack an explicit addend. All x86-linux
3197 relocations appear to be of this form. */
3199 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
3200 Elf_Shdr* shdr, int shnum,
3201 Elf_Sym* stab, char* strtab )
3206 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
3207 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
3208 int target_shndx = shdr[shnum].sh_info;
3209 int symtab_shndx = shdr[shnum].sh_link;
3211 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3212 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
3213 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3214 target_shndx, symtab_shndx ));
3216 /* Skip sections that we're not interested in. */
3219 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
3220 if (kind == SECTIONKIND_OTHER) {
3221 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
3226 for (j = 0; j < nent; j++) {
3227 Elf_Addr offset = rtab[j].r_offset;
3228 Elf_Addr info = rtab[j].r_info;
3230 Elf_Addr P = ((Elf_Addr)targ) + offset;
3231 Elf_Word* pP = (Elf_Word*)P;
3236 StgStablePtr stablePtr;
3239 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
3240 j, (void*)offset, (void*)info ));
3242 IF_DEBUG(linker,debugBelch( " ZERO" ));
3245 Elf_Sym sym = stab[ELF_R_SYM(info)];
3246 /* First see if it is a local symbol. */
3247 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3248 /* Yes, so we can get the address directly from the ELF symbol
3250 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3252 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3253 + stab[ELF_R_SYM(info)].st_value);
3256 symbol = strtab + sym.st_name;
3257 stablePtr = (StgStablePtr)lookupHashTable(stablehash, (StgWord)symbol);
3258 if (NULL == stablePtr) {
3259 /* No, so look up the name in our global table. */
3260 S_tmp = lookupSymbol( symbol );
3261 S = (Elf_Addr)S_tmp;
3263 stableVal = deRefStablePtr( stablePtr );
3265 S = (Elf_Addr)S_tmp;
3269 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3272 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
3275 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
3276 (void*)P, (void*)S, (void*)A ));
3277 checkProddableBlock ( oc, pP );
3281 switch (ELF_R_TYPE(info)) {
3282 # ifdef i386_HOST_ARCH
3283 case R_386_32: *pP = value; break;
3284 case R_386_PC32: *pP = value - P; break;
3287 errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n",
3288 oc->fileName, (lnat)ELF_R_TYPE(info));
3296 /* Do ELF relocations for which explicit addends are supplied.
3297 sparc-solaris relocations appear to be of this form. */
3299 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
3300 Elf_Shdr* shdr, int shnum,
3301 Elf_Sym* stab, char* strtab )
3304 char *symbol = NULL;
3306 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
3307 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
3308 int target_shndx = shdr[shnum].sh_info;
3309 int symtab_shndx = shdr[shnum].sh_link;
3311 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3312 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
3313 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3314 target_shndx, symtab_shndx ));
3316 for (j = 0; j < nent; j++) {
3317 #if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3318 /* This #ifdef only serves to avoid unused-var warnings. */
3319 Elf_Addr offset = rtab[j].r_offset;
3320 Elf_Addr P = targ + offset;
3322 Elf_Addr info = rtab[j].r_info;
3323 Elf_Addr A = rtab[j].r_addend;
3327 # if defined(sparc_HOST_ARCH)
3328 Elf_Word* pP = (Elf_Word*)P;
3330 # elif defined(ia64_HOST_ARCH)
3331 Elf64_Xword *pP = (Elf64_Xword *)P;
3333 # elif defined(powerpc_HOST_ARCH)
3337 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
3338 j, (void*)offset, (void*)info,
3341 IF_DEBUG(linker,debugBelch( " ZERO" ));
3344 Elf_Sym sym = stab[ELF_R_SYM(info)];
3345 /* First see if it is a local symbol. */
3346 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3347 /* Yes, so we can get the address directly from the ELF symbol
3349 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3351 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3352 + stab[ELF_R_SYM(info)].st_value);
3353 #ifdef ELF_FUNCTION_DESC
3354 /* Make a function descriptor for this function */
3355 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
3356 S = allocateFunctionDesc(S + A);
3361 /* No, so look up the name in our global table. */
3362 symbol = strtab + sym.st_name;
3363 S_tmp = lookupSymbol( symbol );
3364 S = (Elf_Addr)S_tmp;
3366 #ifdef ELF_FUNCTION_DESC
3367 /* If a function, already a function descriptor - we would
3368 have to copy it to add an offset. */
3369 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
3370 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
3374 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3377 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
3380 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
3381 (void*)P, (void*)S, (void*)A ));
3382 /* checkProddableBlock ( oc, (void*)P ); */
3386 switch (ELF_R_TYPE(info)) {
3387 # if defined(sparc_HOST_ARCH)
3388 case R_SPARC_WDISP30:
3389 w1 = *pP & 0xC0000000;
3390 w2 = (Elf_Word)((value - P) >> 2);
3391 ASSERT((w2 & 0xC0000000) == 0);
3396 w1 = *pP & 0xFFC00000;
3397 w2 = (Elf_Word)(value >> 10);
3398 ASSERT((w2 & 0xFFC00000) == 0);
3404 w2 = (Elf_Word)(value & 0x3FF);
3405 ASSERT((w2 & ~0x3FF) == 0);
3409 /* According to the Sun documentation:
3411 This relocation type resembles R_SPARC_32, except it refers to an
3412 unaligned word. That is, the word to be relocated must be treated
3413 as four separate bytes with arbitrary alignment, not as a word
3414 aligned according to the architecture requirements.
3416 (JRS: which means that freeloading on the R_SPARC_32 case
3417 is probably wrong, but hey ...)
3421 w2 = (Elf_Word)value;
3424 # elif defined(ia64_HOST_ARCH)
3425 case R_IA64_DIR64LSB:
3426 case R_IA64_FPTR64LSB:
3429 case R_IA64_PCREL64LSB:
3432 case R_IA64_SEGREL64LSB:
3433 addr = findElfSegment(ehdrC, value);
3436 case R_IA64_GPREL22:
3437 ia64_reloc_gprel22(P, value);
3439 case R_IA64_LTOFF22:
3440 case R_IA64_LTOFF22X:
3441 case R_IA64_LTOFF_FPTR22:
3442 addr = allocateGOTEntry(value);
3443 ia64_reloc_gprel22(P, addr);
3445 case R_IA64_PCREL21B:
3446 ia64_reloc_pcrel21(P, S, oc);
3449 /* This goes with R_IA64_LTOFF22X and points to the load to
3450 * convert into a move. We don't implement relaxation. */
3452 # elif defined(powerpc_HOST_ARCH)
3453 case R_PPC_ADDR16_LO:
3454 *(Elf32_Half*) P = value;
3457 case R_PPC_ADDR16_HI:
3458 *(Elf32_Half*) P = value >> 16;
3461 case R_PPC_ADDR16_HA:
3462 *(Elf32_Half*) P = (value + 0x8000) >> 16;
3466 *(Elf32_Word *) P = value;
3470 *(Elf32_Word *) P = value - P;
3476 if( delta << 6 >> 6 != delta )
3478 value = (Elf_Addr) (&makeSymbolExtra( oc, ELF_R_SYM(info), value )
3482 if( value == 0 || delta << 6 >> 6 != delta )
3484 barf( "Unable to make SymbolExtra for #%d",
3490 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3491 | (delta & 0x3fffffc);
3495 #if x86_64_HOST_ARCH
3497 *(Elf64_Xword *)P = value;
3502 StgInt64 off = value - P;
3503 if (off >= 0x7fffffffL || off < -0x80000000L) {
3504 #if X86_64_ELF_NONPIC_HACK
3505 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3507 off = pltAddress + A - P;
3509 barf("R_X86_64_PC32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
3510 symbol, off, oc->fileName );
3513 *(Elf64_Word *)P = (Elf64_Word)off;
3519 StgInt64 off = value - P;
3520 *(Elf64_Word *)P = (Elf64_Word)off;
3525 if (value >= 0x7fffffffL) {
3526 #if X86_64_ELF_NONPIC_HACK
3527 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3529 value = pltAddress + A;
3531 barf("R_X86_64_32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
3532 symbol, value, oc->fileName );
3535 *(Elf64_Word *)P = (Elf64_Word)value;
3539 if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
3540 #if X86_64_ELF_NONPIC_HACK
3541 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3543 value = pltAddress + A;
3545 barf("R_X86_64_32S relocation out of range: %s = %p\nRecompile %s with -fPIC.",
3546 symbol, value, oc->fileName );
3549 *(Elf64_Sword *)P = (Elf64_Sword)value;
3552 case R_X86_64_GOTPCREL:
3554 StgInt64 gotAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)->addr;
3555 StgInt64 off = gotAddress + A - P;
3556 *(Elf64_Word *)P = (Elf64_Word)off;
3560 case R_X86_64_PLT32:
3562 StgInt64 off = value - P;
3563 if (off >= 0x7fffffffL || off < -0x80000000L) {
3564 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3566 off = pltAddress + A - P;
3568 *(Elf64_Word *)P = (Elf64_Word)off;
3574 errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n",
3575 oc->fileName, (lnat)ELF_R_TYPE(info));
3584 ocResolve_ELF ( ObjectCode* oc )
3588 Elf_Sym* stab = NULL;
3589 char* ehdrC = (char*)(oc->image);
3590 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
3591 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3593 /* first find "the" symbol table */
3594 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
3596 /* also go find the string table */
3597 strtab = findElfSection ( ehdrC, SHT_STRTAB );
3599 if (stab == NULL || strtab == NULL) {
3600 errorBelch("%s: can't find string or symbol table", oc->fileName);
3604 /* Process the relocation sections. */
3605 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
3606 if (shdr[shnum].sh_type == SHT_REL) {
3607 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
3608 shnum, stab, strtab );
3612 if (shdr[shnum].sh_type == SHT_RELA) {
3613 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
3614 shnum, stab, strtab );
3619 /* Free the local symbol table; we won't need it again. */
3620 freeHashTable(oc->lochash, NULL);
3623 #if defined(powerpc_HOST_ARCH)
3624 ocFlushInstructionCache( oc );
3632 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
3633 * at the front. The following utility functions pack and unpack instructions, and
3634 * take care of the most common relocations.
3637 #ifdef ia64_HOST_ARCH
3640 ia64_extract_instruction(Elf64_Xword *target)
3643 int slot = (Elf_Addr)target & 3;
3644 target = (Elf_Addr)target & ~3;
3652 return ((w1 >> 5) & 0x1ffffffffff);
3654 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
3658 barf("ia64_extract_instruction: invalid slot %p", target);
3663 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
3665 int slot = (Elf_Addr)target & 3;
3666 target = (Elf_Addr)target & ~3;
3671 *target |= value << 5;
3674 *target |= value << 46;
3675 *(target+1) |= value >> 18;
3678 *(target+1) |= value << 23;
3684 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3686 Elf64_Xword instruction;
3687 Elf64_Sxword rel_value;
3689 rel_value = value - gp_val;
3690 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3691 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3693 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3694 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3695 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3696 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3697 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3698 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3702 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3704 Elf64_Xword instruction;
3705 Elf64_Sxword rel_value;
3708 entry = allocatePLTEntry(value, oc);
3710 rel_value = (entry >> 4) - (target >> 4);
3711 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3712 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3714 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3715 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3716 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3717 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3723 * PowerPC & X86_64 ELF specifics
3726 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3728 static int ocAllocateSymbolExtras_ELF( ObjectCode *oc )
3734 ehdr = (Elf_Ehdr *) oc->image;
3735 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
3737 for( i = 0; i < ehdr->e_shnum; i++ )
3738 if( shdr[i].sh_type == SHT_SYMTAB )
3741 if( i == ehdr->e_shnum )
3743 errorBelch( "This ELF file contains no symtab" );
3747 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
3749 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
3750 (int) shdr[i].sh_entsize, (int) sizeof( Elf_Sym ) );
3755 return ocAllocateSymbolExtras( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
3758 #endif /* powerpc */
3762 /* --------------------------------------------------------------------------
3764 * ------------------------------------------------------------------------*/
3766 #if defined(OBJFORMAT_MACHO)
3769 Support for MachO linking on Darwin/MacOS X
3770 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3772 I hereby formally apologize for the hackish nature of this code.
3773 Things that need to be done:
3774 *) implement ocVerifyImage_MachO
3775 *) add still more sanity checks.
3778 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
3779 #define mach_header mach_header_64
3780 #define segment_command segment_command_64
3781 #define section section_64
3782 #define nlist nlist_64
3785 #ifdef powerpc_HOST_ARCH
3786 static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
3788 struct mach_header *header = (struct mach_header *) oc->image;
3789 struct load_command *lc = (struct load_command *) (header + 1);
3792 for( i = 0; i < header->ncmds; i++ )
3794 if( lc->cmd == LC_SYMTAB )
3796 // Find out the first and last undefined external
3797 // symbol, so we don't have to allocate too many
3799 struct symtab_command *symLC = (struct symtab_command *) lc;
3800 unsigned min = symLC->nsyms, max = 0;
3801 struct nlist *nlist =
3802 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
3804 for(i=0;i<symLC->nsyms;i++)
3806 if(nlist[i].n_type & N_STAB)
3808 else if(nlist[i].n_type & N_EXT)
3810 if((nlist[i].n_type & N_TYPE) == N_UNDF
3811 && (nlist[i].n_value == 0))
3821 return ocAllocateSymbolExtras(oc, max - min + 1, min);
3826 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3828 return ocAllocateSymbolExtras(oc,0,0);
3831 #ifdef x86_64_HOST_ARCH
3832 static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
3834 struct mach_header *header = (struct mach_header *) oc->image;
3835 struct load_command *lc = (struct load_command *) (header + 1);
3838 for( i = 0; i < header->ncmds; i++ )
3840 if( lc->cmd == LC_SYMTAB )
3842 // Just allocate one entry for every symbol
3843 struct symtab_command *symLC = (struct symtab_command *) lc;
3845 return ocAllocateSymbolExtras(oc, symLC->nsyms, 0);
3848 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3850 return ocAllocateSymbolExtras(oc,0,0);
3854 static int ocVerifyImage_MachO(ObjectCode* oc)
3856 char *image = (char*) oc->image;
3857 struct mach_header *header = (struct mach_header*) image;
3859 #if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
3860 if(header->magic != MH_MAGIC_64)
3863 if(header->magic != MH_MAGIC)
3866 // FIXME: do some more verifying here
3870 static int resolveImports(
3873 struct symtab_command *symLC,
3874 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3875 unsigned long *indirectSyms,
3876 struct nlist *nlist)
3879 size_t itemSize = 4;
3882 int isJumpTable = 0;
3883 if(!strcmp(sect->sectname,"__jump_table"))
3887 ASSERT(sect->reserved2 == itemSize);
3891 for(i=0; i*itemSize < sect->size;i++)
3893 // according to otool, reserved1 contains the first index into the indirect symbol table
3894 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3895 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3898 if((symbol->n_type & N_TYPE) == N_UNDF
3899 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3900 addr = (void*) (symbol->n_value);
3901 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3904 addr = lookupSymbol(nm);
3907 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3915 checkProddableBlock(oc,image + sect->offset + i*itemSize);
3916 *(image + sect->offset + i*itemSize) = 0xe9; // jmp
3917 *(unsigned*)(image + sect->offset + i*itemSize + 1)
3918 = (char*)addr - (image + sect->offset + i*itemSize + 5);
3923 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3924 ((void**)(image + sect->offset))[i] = addr;
3931 static unsigned long relocateAddress(
3934 struct section* sections,
3935 unsigned long address)
3938 for(i = 0; i < nSections; i++)
3940 if(sections[i].addr <= address
3941 && address < sections[i].addr + sections[i].size)
3943 return (unsigned long)oc->image
3944 + sections[i].offset + address - sections[i].addr;
3947 barf("Invalid Mach-O file:"
3948 "Address out of bounds while relocating object file");
3952 static int relocateSection(
3955 struct symtab_command *symLC, struct nlist *nlist,
3956 int nSections, struct section* sections, struct section *sect)
3958 struct relocation_info *relocs;
3961 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3963 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3965 else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
3967 else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
3971 relocs = (struct relocation_info*) (image + sect->reloff);
3975 #ifdef x86_64_HOST_ARCH
3976 struct relocation_info *reloc = &relocs[i];
3978 char *thingPtr = image + sect->offset + reloc->r_address;
3982 int type = reloc->r_type;
3984 checkProddableBlock(oc,thingPtr);
3985 switch(reloc->r_length)
3988 thing = *(uint8_t*)thingPtr;
3989 baseValue = (uint64_t)thingPtr + 1;
3992 thing = *(uint16_t*)thingPtr;
3993 baseValue = (uint64_t)thingPtr + 2;
3996 thing = *(uint32_t*)thingPtr;
3997 baseValue = (uint64_t)thingPtr + 4;
4000 thing = *(uint64_t*)thingPtr;
4001 baseValue = (uint64_t)thingPtr + 8;
4004 barf("Unknown size.");
4007 if(type == X86_64_RELOC_GOT
4008 || type == X86_64_RELOC_GOT_LOAD)
4010 ASSERT(reloc->r_extern);
4011 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)->addr;
4013 type = X86_64_RELOC_SIGNED;
4015 else if(reloc->r_extern)
4017 struct nlist *symbol = &nlist[reloc->r_symbolnum];
4018 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4019 if(symbol->n_value == 0)
4020 value = (uint64_t) lookupSymbol(nm);
4022 value = relocateAddress(oc, nSections, sections,
4027 value = sections[reloc->r_symbolnum-1].offset
4028 - sections[reloc->r_symbolnum-1].addr
4032 if(type == X86_64_RELOC_BRANCH)
4034 if((int32_t)(value - baseValue) != (int64_t)(value - baseValue))
4036 ASSERT(reloc->r_extern);
4037 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)
4040 ASSERT((int32_t)(value - baseValue) == (int64_t)(value - baseValue));
4041 type = X86_64_RELOC_SIGNED;
4046 case X86_64_RELOC_UNSIGNED:
4047 ASSERT(!reloc->r_pcrel);
4050 case X86_64_RELOC_SIGNED:
4051 ASSERT(reloc->r_pcrel);
4052 thing += value - baseValue;
4054 case X86_64_RELOC_SUBTRACTOR:
4055 ASSERT(!reloc->r_pcrel);
4059 barf("unkown relocation");
4062 switch(reloc->r_length)
4065 *(uint8_t*)thingPtr = thing;
4068 *(uint16_t*)thingPtr = thing;
4071 *(uint32_t*)thingPtr = thing;
4074 *(uint64_t*)thingPtr = thing;
4078 if(relocs[i].r_address & R_SCATTERED)
4080 struct scattered_relocation_info *scat =
4081 (struct scattered_relocation_info*) &relocs[i];
4085 if(scat->r_length == 2)
4087 unsigned long word = 0;
4088 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
4089 checkProddableBlock(oc,wordPtr);
4091 // Note on relocation types:
4092 // i386 uses the GENERIC_RELOC_* types,
4093 // while ppc uses special PPC_RELOC_* types.
4094 // *_RELOC_VANILLA and *_RELOC_PAIR have the same value
4095 // in both cases, all others are different.
4096 // Therefore, we use GENERIC_RELOC_VANILLA
4097 // and GENERIC_RELOC_PAIR instead of the PPC variants,
4098 // and use #ifdefs for the other types.
4100 // Step 1: Figure out what the relocated value should be
4101 if(scat->r_type == GENERIC_RELOC_VANILLA)
4103 word = *wordPtr + (unsigned long) relocateAddress(
4110 #ifdef powerpc_HOST_ARCH
4111 else if(scat->r_type == PPC_RELOC_SECTDIFF
4112 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
4113 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
4114 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
4116 else if(scat->r_type == GENERIC_RELOC_SECTDIFF)
4119 struct scattered_relocation_info *pair =
4120 (struct scattered_relocation_info*) &relocs[i+1];
4122 if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR)
4123 barf("Invalid Mach-O file: "
4124 "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
4126 word = (unsigned long)
4127 (relocateAddress(oc, nSections, sections, scat->r_value)
4128 - relocateAddress(oc, nSections, sections, pair->r_value));
4131 #ifdef powerpc_HOST_ARCH
4132 else if(scat->r_type == PPC_RELOC_HI16
4133 || scat->r_type == PPC_RELOC_LO16
4134 || scat->r_type == PPC_RELOC_HA16
4135 || scat->r_type == PPC_RELOC_LO14)
4136 { // these are generated by label+offset things
4137 struct relocation_info *pair = &relocs[i+1];
4138 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
4139 barf("Invalid Mach-O file: "
4140 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
4142 if(scat->r_type == PPC_RELOC_LO16)
4144 word = ((unsigned short*) wordPtr)[1];
4145 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4147 else if(scat->r_type == PPC_RELOC_LO14)
4149 barf("Unsupported Relocation: PPC_RELOC_LO14");
4150 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
4151 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4153 else if(scat->r_type == PPC_RELOC_HI16)
4155 word = ((unsigned short*) wordPtr)[1] << 16;
4156 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4158 else if(scat->r_type == PPC_RELOC_HA16)
4160 word = ((unsigned short*) wordPtr)[1] << 16;
4161 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4165 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
4172 continue; // ignore the others
4174 #ifdef powerpc_HOST_ARCH
4175 if(scat->r_type == GENERIC_RELOC_VANILLA
4176 || scat->r_type == PPC_RELOC_SECTDIFF)
4178 if(scat->r_type == GENERIC_RELOC_VANILLA
4179 || scat->r_type == GENERIC_RELOC_SECTDIFF)
4184 #ifdef powerpc_HOST_ARCH
4185 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
4187 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4189 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
4191 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4193 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
4195 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4196 + ((word & (1<<15)) ? 1 : 0);
4202 continue; // FIXME: I hope it's OK to ignore all the others.
4206 struct relocation_info *reloc = &relocs[i];
4207 if(reloc->r_pcrel && !reloc->r_extern)
4210 if(reloc->r_length == 2)
4212 unsigned long word = 0;
4213 #ifdef powerpc_HOST_ARCH
4214 unsigned long jumpIsland = 0;
4215 long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
4216 // to avoid warning and to catch
4220 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
4221 checkProddableBlock(oc,wordPtr);
4223 if(reloc->r_type == GENERIC_RELOC_VANILLA)
4227 #ifdef powerpc_HOST_ARCH
4228 else if(reloc->r_type == PPC_RELOC_LO16)
4230 word = ((unsigned short*) wordPtr)[1];
4231 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4233 else if(reloc->r_type == PPC_RELOC_HI16)
4235 word = ((unsigned short*) wordPtr)[1] << 16;
4236 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4238 else if(reloc->r_type == PPC_RELOC_HA16)
4240 word = ((unsigned short*) wordPtr)[1] << 16;
4241 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4243 else if(reloc->r_type == PPC_RELOC_BR24)
4246 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
4250 if(!reloc->r_extern)
4253 sections[reloc->r_symbolnum-1].offset
4254 - sections[reloc->r_symbolnum-1].addr
4261 struct nlist *symbol = &nlist[reloc->r_symbolnum];
4262 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4263 void *symbolAddress = lookupSymbol(nm);
4266 errorBelch("\nunknown symbol `%s'", nm);
4272 #ifdef powerpc_HOST_ARCH
4273 // In the .o file, this should be a relative jump to NULL
4274 // and we'll change it to a relative jump to the symbol
4275 ASSERT(word + reloc->r_address == 0);
4276 jumpIsland = (unsigned long)
4277 &makeSymbolExtra(oc,
4279 (unsigned long) symbolAddress)
4283 offsetToJumpIsland = word + jumpIsland
4284 - (((long)image) + sect->offset - sect->addr);
4287 word += (unsigned long) symbolAddress
4288 - (((long)image) + sect->offset - sect->addr);
4292 word += (unsigned long) symbolAddress;
4296 if(reloc->r_type == GENERIC_RELOC_VANILLA)
4301 #ifdef powerpc_HOST_ARCH
4302 else if(reloc->r_type == PPC_RELOC_LO16)
4304 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4307 else if(reloc->r_type == PPC_RELOC_HI16)
4309 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4312 else if(reloc->r_type == PPC_RELOC_HA16)
4314 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4315 + ((word & (1<<15)) ? 1 : 0);
4318 else if(reloc->r_type == PPC_RELOC_BR24)
4320 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4322 // The branch offset is too large.
4323 // Therefore, we try to use a jump island.
4326 barf("unconditional relative branch out of range: "
4327 "no jump island available");
4330 word = offsetToJumpIsland;
4331 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4332 barf("unconditional relative branch out of range: "
4333 "jump island out of range");
4335 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
4340 barf("\nunknown relocation %d",reloc->r_type);
4348 static int ocGetNames_MachO(ObjectCode* oc)
4350 char *image = (char*) oc->image;
4351 struct mach_header *header = (struct mach_header*) image;
4352 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4353 unsigned i,curSymbol = 0;
4354 struct segment_command *segLC = NULL;
4355 struct section *sections;
4356 struct symtab_command *symLC = NULL;
4357 struct nlist *nlist;
4358 unsigned long commonSize = 0;
4359 char *commonStorage = NULL;
4360 unsigned long commonCounter;
4362 for(i=0;i<header->ncmds;i++)
4364 if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
4365 segLC = (struct segment_command*) lc;
4366 else if(lc->cmd == LC_SYMTAB)
4367 symLC = (struct symtab_command*) lc;
4368 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4371 sections = (struct section*) (segLC+1);
4372 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4376 barf("ocGetNames_MachO: no segment load command");
4378 for(i=0;i<segLC->nsects;i++)
4380 if(sections[i].size == 0)
4383 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
4385 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
4386 "ocGetNames_MachO(common symbols)");
4387 sections[i].offset = zeroFillArea - image;
4390 if(!strcmp(sections[i].sectname,"__text"))
4391 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
4392 (void*) (image + sections[i].offset),
4393 (void*) (image + sections[i].offset + sections[i].size));
4394 else if(!strcmp(sections[i].sectname,"__const"))
4395 addSection(oc, SECTIONKIND_RWDATA,
4396 (void*) (image + sections[i].offset),
4397 (void*) (image + sections[i].offset + sections[i].size));
4398 else if(!strcmp(sections[i].sectname,"__data"))
4399 addSection(oc, SECTIONKIND_RWDATA,
4400 (void*) (image + sections[i].offset),
4401 (void*) (image + sections[i].offset + sections[i].size));
4402 else if(!strcmp(sections[i].sectname,"__bss")
4403 || !strcmp(sections[i].sectname,"__common"))
4404 addSection(oc, SECTIONKIND_RWDATA,
4405 (void*) (image + sections[i].offset),
4406 (void*) (image + sections[i].offset + sections[i].size));
4408 addProddableBlock(oc, (void*) (image + sections[i].offset),
4412 // count external symbols defined here
4416 for(i=0;i<symLC->nsyms;i++)
4418 if(nlist[i].n_type & N_STAB)
4420 else if(nlist[i].n_type & N_EXT)
4422 if((nlist[i].n_type & N_TYPE) == N_UNDF
4423 && (nlist[i].n_value != 0))
4425 commonSize += nlist[i].n_value;
4428 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4433 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
4434 "ocGetNames_MachO(oc->symbols)");
4438 for(i=0;i<symLC->nsyms;i++)
4440 if(nlist[i].n_type & N_STAB)
4442 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4444 if(nlist[i].n_type & N_EXT)
4446 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4447 if((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm))
4448 ; // weak definition, and we already have a definition
4451 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4453 + sections[nlist[i].n_sect-1].offset
4454 - sections[nlist[i].n_sect-1].addr
4455 + nlist[i].n_value);
4456 oc->symbols[curSymbol++] = nm;
4463 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
4464 commonCounter = (unsigned long)commonStorage;
4467 for(i=0;i<symLC->nsyms;i++)
4469 if((nlist[i].n_type & N_TYPE) == N_UNDF
4470 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
4472 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4473 unsigned long sz = nlist[i].n_value;
4475 nlist[i].n_value = commonCounter;
4477 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4478 (void*)commonCounter);
4479 oc->symbols[curSymbol++] = nm;
4481 commonCounter += sz;
4488 static int ocResolve_MachO(ObjectCode* oc)
4490 char *image = (char*) oc->image;
4491 struct mach_header *header = (struct mach_header*) image;
4492 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4494 struct segment_command *segLC = NULL;
4495 struct section *sections;
4496 struct symtab_command *symLC = NULL;
4497 struct dysymtab_command *dsymLC = NULL;
4498 struct nlist *nlist;
4500 for(i=0;i<header->ncmds;i++)
4502 if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
4503 segLC = (struct segment_command*) lc;
4504 else if(lc->cmd == LC_SYMTAB)
4505 symLC = (struct symtab_command*) lc;
4506 else if(lc->cmd == LC_DYSYMTAB)
4507 dsymLC = (struct dysymtab_command*) lc;
4508 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4511 sections = (struct section*) (segLC+1);
4512 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4517 unsigned long *indirectSyms
4518 = (unsigned long*) (image + dsymLC->indirectsymoff);
4520 for(i=0;i<segLC->nsects;i++)
4522 if( !strcmp(sections[i].sectname,"__la_symbol_ptr")
4523 || !strcmp(sections[i].sectname,"__la_sym_ptr2")
4524 || !strcmp(sections[i].sectname,"__la_sym_ptr3"))
4526 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
4529 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr")
4530 || !strcmp(sections[i].sectname,"__pointers"))
4532 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
4535 else if(!strcmp(sections[i].sectname,"__jump_table"))
4537 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
4543 for(i=0;i<segLC->nsects;i++)
4545 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
4549 /* Free the local symbol table; we won't need it again. */
4550 freeHashTable(oc->lochash, NULL);
4553 #if defined (powerpc_HOST_ARCH)
4554 ocFlushInstructionCache( oc );
4560 #ifdef powerpc_HOST_ARCH
4562 * The Mach-O object format uses leading underscores. But not everywhere.
4563 * There is a small number of runtime support functions defined in
4564 * libcc_dynamic.a whose name does not have a leading underscore.
4565 * As a consequence, we can't get their address from C code.
4566 * We have to use inline assembler just to take the address of a function.
4570 static void machoInitSymbolsWithoutUnderscore()
4572 extern void* symbolsWithoutUnderscore[];
4573 void **p = symbolsWithoutUnderscore;
4574 __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
4578 __asm__ volatile(".long " # x);
4580 RTS_MACHO_NOUNDERLINE_SYMBOLS
4582 __asm__ volatile(".text");
4586 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
4588 RTS_MACHO_NOUNDERLINE_SYMBOLS
4595 * Figure out by how much to shift the entire Mach-O file in memory
4596 * when loading so that its single segment ends up 16-byte-aligned
4598 static int machoGetMisalignment( FILE * f )
4600 struct mach_header header;
4603 fread(&header, sizeof(header), 1, f);
4606 #if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
4607 if(header.magic != MH_MAGIC_64)
4610 if(header.magic != MH_MAGIC)
4614 misalignment = (header.sizeofcmds + sizeof(header))
4617 return misalignment ? (16 - misalignment) : 0;