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"
32 #ifdef HAVE_SYS_TYPES_H
33 #include <sys/types.h>
39 #ifdef HAVE_SYS_STAT_H
43 #if defined(HAVE_DLFCN_H)
47 #if defined(cygwin32_HOST_OS)
52 #ifdef HAVE_SYS_TIME_H
56 #include <sys/fcntl.h>
57 #include <sys/termios.h>
58 #include <sys/utime.h>
59 #include <sys/utsname.h>
63 #if defined(ia64_HOST_ARCH) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
68 #if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
76 #if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
77 # define OBJFORMAT_ELF
78 #elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
79 # define OBJFORMAT_PEi386
82 #elif defined(darwin_HOST_OS)
83 # define OBJFORMAT_MACHO
84 # include <mach-o/loader.h>
85 # include <mach-o/nlist.h>
86 # include <mach-o/reloc.h>
87 #if !defined(HAVE_DLFCN_H)
88 # include <mach-o/dyld.h>
90 #if defined(powerpc_HOST_ARCH)
91 # include <mach-o/ppc/reloc.h>
93 #if defined(x86_64_HOST_ARCH)
94 # include <mach-o/x86_64/reloc.h>
98 /* Hash table mapping symbol names to Symbol */
99 static /*Str*/HashTable *symhash;
101 /* Hash table mapping symbol names to StgStablePtr */
102 static /*Str*/HashTable *stablehash;
104 /* List of currently loaded objects */
105 ObjectCode *objects = NULL; /* initially empty */
107 #if defined(OBJFORMAT_ELF)
108 static int ocVerifyImage_ELF ( ObjectCode* oc );
109 static int ocGetNames_ELF ( ObjectCode* oc );
110 static int ocResolve_ELF ( ObjectCode* oc );
111 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
112 static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc );
114 #elif defined(OBJFORMAT_PEi386)
115 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
116 static int ocGetNames_PEi386 ( ObjectCode* oc );
117 static int ocResolve_PEi386 ( ObjectCode* oc );
118 #elif defined(OBJFORMAT_MACHO)
119 static int ocVerifyImage_MachO ( ObjectCode* oc );
120 static int ocGetNames_MachO ( ObjectCode* oc );
121 static int ocResolve_MachO ( ObjectCode* oc );
123 static int machoGetMisalignment( FILE * );
124 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
125 static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
127 #ifdef powerpc_HOST_ARCH
128 static void machoInitSymbolsWithoutUnderscore( void );
132 /* on x86_64 we have a problem with relocating symbol references in
133 * code that was compiled without -fPIC. By default, the small memory
134 * model is used, which assumes that symbol references can fit in a
135 * 32-bit slot. The system dynamic linker makes this work for
136 * references to shared libraries by either (a) allocating a jump
137 * table slot for code references, or (b) moving the symbol at load
138 * time (and copying its contents, if necessary) for data references.
140 * We unfortunately can't tell whether symbol references are to code
141 * or data. So for now we assume they are code (the vast majority
142 * are), and allocate jump-table slots. Unfortunately this will
143 * SILENTLY generate crashing code for data references. This hack is
144 * enabled by X86_64_ELF_NONPIC_HACK.
146 * One workaround is to use shared Haskell libraries. This is
147 * coming. Another workaround is to keep the static libraries but
148 * compile them with -fPIC, because that will generate PIC references
149 * to data which can be relocated. The PIC code is still too green to
150 * do this systematically, though.
153 * See thread http://www.haskell.org/pipermail/cvs-ghc/2007-September/038458.html
155 #define X86_64_ELF_NONPIC_HACK 1
157 /* -----------------------------------------------------------------------------
158 * Built-in symbols from the RTS
161 typedef struct _RtsSymbolVal {
168 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
169 SymX(makeStableNamezh_fast) \
170 SymX(finalizzeWeakzh_fast)
172 /* These are not available in GUM!!! -- HWL */
173 #define Maybe_Stable_Names
176 #if !defined (mingw32_HOST_OS)
177 #define RTS_POSIX_ONLY_SYMBOLS \
178 SymX(shutdownHaskellAndSignal) \
181 SymX(signal_handlers) \
182 SymX(stg_sig_install) \
186 #if defined (cygwin32_HOST_OS)
187 #define RTS_MINGW_ONLY_SYMBOLS /**/
188 /* Don't have the ability to read import libs / archives, so
189 * we have to stupidly list a lot of what libcygwin.a
192 #define RTS_CYGWIN_ONLY_SYMBOLS \
270 #elif !defined(mingw32_HOST_OS)
271 #define RTS_MINGW_ONLY_SYMBOLS /**/
272 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
273 #else /* defined(mingw32_HOST_OS) */
274 #define RTS_POSIX_ONLY_SYMBOLS /**/
275 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
277 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
279 #define RTS_MINGW_EXTRA_SYMS \
280 Sym(_imp____mb_cur_max) \
283 #define RTS_MINGW_EXTRA_SYMS
286 #if HAVE_GETTIMEOFDAY
287 #define RTS_MINGW_GETTIMEOFDAY_SYM Sym(gettimeofday)
289 #define RTS_MINGW_GETTIMEOFDAY_SYM /**/
292 /* These are statically linked from the mingw libraries into the ghc
293 executable, so we have to employ this hack. */
294 #define RTS_MINGW_ONLY_SYMBOLS \
295 SymX(asyncReadzh_fast) \
296 SymX(asyncWritezh_fast) \
297 SymX(asyncDoProczh_fast) \
309 SymX(getservbyname) \
310 SymX(getservbyport) \
311 SymX(getprotobynumber) \
312 SymX(getprotobyname) \
313 SymX(gethostbyname) \
314 SymX(gethostbyaddr) \
361 SymX(rts_InstallConsoleEvent) \
362 SymX(rts_ConsoleHandlerDone) \
364 Sym(_imp___timezone) \
374 RTS_MINGW_EXTRA_SYMS \
375 RTS_MINGW_GETTIMEOFDAY_SYM \
379 #if defined(darwin_TARGET_OS) && HAVE_PRINTF_LDBLSTUB
380 #define RTS_DARWIN_ONLY_SYMBOLS \
381 Sym(asprintf$LDBLStub) \
385 Sym(fprintf$LDBLStub) \
386 Sym(fscanf$LDBLStub) \
387 Sym(fwprintf$LDBLStub) \
388 Sym(fwscanf$LDBLStub) \
389 Sym(printf$LDBLStub) \
390 Sym(scanf$LDBLStub) \
391 Sym(snprintf$LDBLStub) \
392 Sym(sprintf$LDBLStub) \
393 Sym(sscanf$LDBLStub) \
394 Sym(strtold$LDBLStub) \
395 Sym(swprintf$LDBLStub) \
396 Sym(swscanf$LDBLStub) \
397 Sym(syslog$LDBLStub) \
398 Sym(vasprintf$LDBLStub) \
400 Sym(verrc$LDBLStub) \
401 Sym(verrx$LDBLStub) \
402 Sym(vfprintf$LDBLStub) \
403 Sym(vfscanf$LDBLStub) \
404 Sym(vfwprintf$LDBLStub) \
405 Sym(vfwscanf$LDBLStub) \
406 Sym(vprintf$LDBLStub) \
407 Sym(vscanf$LDBLStub) \
408 Sym(vsnprintf$LDBLStub) \
409 Sym(vsprintf$LDBLStub) \
410 Sym(vsscanf$LDBLStub) \
411 Sym(vswprintf$LDBLStub) \
412 Sym(vswscanf$LDBLStub) \
413 Sym(vsyslog$LDBLStub) \
414 Sym(vwarn$LDBLStub) \
415 Sym(vwarnc$LDBLStub) \
416 Sym(vwarnx$LDBLStub) \
417 Sym(vwprintf$LDBLStub) \
418 Sym(vwscanf$LDBLStub) \
420 Sym(warnc$LDBLStub) \
421 Sym(warnx$LDBLStub) \
422 Sym(wcstold$LDBLStub) \
423 Sym(wprintf$LDBLStub) \
426 #define RTS_DARWIN_ONLY_SYMBOLS
430 # define MAIN_CAP_SYM SymX(MainCapability)
432 # define MAIN_CAP_SYM
435 #if !defined(mingw32_HOST_OS)
436 #define RTS_USER_SIGNALS_SYMBOLS \
437 SymX(setIOManagerPipe)
439 #define RTS_USER_SIGNALS_SYMBOLS \
440 SymX(sendIOManagerEvent) \
441 SymX(readIOManagerEvent) \
442 SymX(getIOManagerEvent) \
443 SymX(console_handler)
446 #define RTS_LIBFFI_SYMBOLS \
450 Sym(ffi_type_float) \
451 Sym(ffi_type_double) \
452 Sym(ffi_type_sint64) \
453 Sym(ffi_type_uint64) \
454 Sym(ffi_type_sint32) \
455 Sym(ffi_type_uint32) \
456 Sym(ffi_type_sint16) \
457 Sym(ffi_type_uint16) \
458 Sym(ffi_type_sint8) \
459 Sym(ffi_type_uint8) \
460 Sym(ffi_type_pointer)
462 #ifdef TABLES_NEXT_TO_CODE
463 #define RTS_RET_SYMBOLS /* nothing */
465 #define RTS_RET_SYMBOLS \
466 SymX(stg_enter_ret) \
467 SymX(stg_gc_fun_ret) \
474 SymX(stg_ap_pv_ret) \
475 SymX(stg_ap_pp_ret) \
476 SymX(stg_ap_ppv_ret) \
477 SymX(stg_ap_ppp_ret) \
478 SymX(stg_ap_pppv_ret) \
479 SymX(stg_ap_pppp_ret) \
480 SymX(stg_ap_ppppp_ret) \
481 SymX(stg_ap_pppppp_ret)
484 /* On Windows, we link libgmp.a statically into libHSrts.dll */
485 #ifdef mingw32_HOST_OS
488 SymX(__gmpz_cmp_si) \
489 SymX(__gmpz_cmp_ui) \
490 SymX(__gmpz_get_si) \
494 SymExtern(__gmpz_cmp) \
495 SymExtern(__gmpz_cmp_si) \
496 SymExtern(__gmpz_cmp_ui) \
497 SymExtern(__gmpz_get_si) \
498 SymExtern(__gmpz_get_ui)
501 #define RTS_SYMBOLS \
504 SymX(stg_enter_info) \
505 SymX(stg_gc_void_info) \
506 SymX(__stg_gc_enter_1) \
507 SymX(stg_gc_noregs) \
508 SymX(stg_gc_unpt_r1_info) \
509 SymX(stg_gc_unpt_r1) \
510 SymX(stg_gc_unbx_r1_info) \
511 SymX(stg_gc_unbx_r1) \
512 SymX(stg_gc_f1_info) \
514 SymX(stg_gc_d1_info) \
516 SymX(stg_gc_l1_info) \
519 SymX(stg_gc_fun_info) \
521 SymX(stg_gc_gen_info) \
522 SymX(stg_gc_gen_hp) \
524 SymX(stg_gen_yield) \
525 SymX(stg_yield_noregs) \
526 SymX(stg_yield_to_interpreter) \
527 SymX(stg_gen_block) \
528 SymX(stg_block_noregs) \
530 SymX(stg_block_takemvar) \
531 SymX(stg_block_putmvar) \
533 SymX(MallocFailHook) \
535 SymX(OutOfHeapHook) \
536 SymX(StackOverflowHook) \
537 SymX(__encodeDouble) \
538 SymX(__encodeFloat) \
541 SymX(__int_encodeDouble) \
542 SymX(__word_encodeDouble) \
543 SymX(__2Int_encodeDouble) \
544 SymX(__int_encodeFloat) \
545 SymX(__word_encodeFloat) \
546 SymX(andIntegerzh_fast) \
547 SymX(atomicallyzh_fast) \
551 SymX(asyncExceptionsBlockedzh_fast) \
552 SymX(blockAsyncExceptionszh_fast) \
554 SymX(catchRetryzh_fast) \
555 SymX(catchSTMzh_fast) \
557 SymX(closure_flags) \
559 SymX(cmpIntegerzh_fast) \
560 SymX(cmpIntegerIntzh_fast) \
561 SymX(complementIntegerzh_fast) \
562 SymX(createAdjustor) \
563 SymX(decodeDoublezh_fast) \
564 SymX(decodeFloatzh_fast) \
565 SymX(decodeDoublezu2Intzh_fast) \
566 SymX(decodeFloatzuIntzh_fast) \
569 SymX(deRefWeakzh_fast) \
570 SymX(deRefStablePtrzh_fast) \
571 SymX(dirty_MUT_VAR) \
572 SymX(divExactIntegerzh_fast) \
573 SymX(divModIntegerzh_fast) \
575 SymX(forkOnzh_fast) \
577 SymX(forkOS_createThread) \
578 SymX(freeHaskellFunctionPtr) \
579 SymX(freeStablePtr) \
580 SymX(getOrSetTypeableStore) \
581 SymX(gcdIntegerzh_fast) \
582 SymX(gcdIntegerIntzh_fast) \
583 SymX(gcdIntzh_fast) \
587 SymX(getFullProgArgv) \
593 SymX(hs_perform_gc) \
594 SymX(hs_free_stable_ptr) \
595 SymX(hs_free_fun_ptr) \
596 SymX(hs_hpc_rootModule) \
598 SymX(unpackClosurezh_fast) \
599 SymX(getApStackValzh_fast) \
600 SymX(int2Integerzh_fast) \
601 SymX(integer2Intzh_fast) \
602 SymX(integer2Wordzh_fast) \
603 SymX(isCurrentThreadBoundzh_fast) \
604 SymX(isDoubleDenormalized) \
605 SymX(isDoubleInfinite) \
607 SymX(isDoubleNegativeZero) \
608 SymX(isEmptyMVarzh_fast) \
609 SymX(isFloatDenormalized) \
610 SymX(isFloatInfinite) \
612 SymX(isFloatNegativeZero) \
613 SymX(killThreadzh_fast) \
615 SymX(insertStableSymbol) \
618 SymX(makeStablePtrzh_fast) \
619 SymX(minusIntegerzh_fast) \
620 SymX(mkApUpd0zh_fast) \
621 SymX(myThreadIdzh_fast) \
622 SymX(labelThreadzh_fast) \
623 SymX(newArrayzh_fast) \
624 SymX(newBCOzh_fast) \
625 SymX(newByteArrayzh_fast) \
626 SymX_redirect(newCAF, newDynCAF) \
627 SymX(newMVarzh_fast) \
628 SymX(newMutVarzh_fast) \
629 SymX(newTVarzh_fast) \
630 SymX(noDuplicatezh_fast) \
631 SymX(atomicModifyMutVarzh_fast) \
632 SymX(newPinnedByteArrayzh_fast) \
634 SymX(orIntegerzh_fast) \
636 SymX(performMajorGC) \
637 SymX(plusIntegerzh_fast) \
640 SymX(putMVarzh_fast) \
641 SymX(quotIntegerzh_fast) \
642 SymX(quotRemIntegerzh_fast) \
644 SymX(raiseIOzh_fast) \
645 SymX(readTVarzh_fast) \
646 SymX(remIntegerzh_fast) \
647 SymX(resetNonBlockingFd) \
652 SymX(rts_checkSchedStatus) \
655 SymX(rts_evalLazyIO) \
656 SymX(rts_evalStableIO) \
660 SymX(rts_getDouble) \
668 SymX(rts_getFunPtr) \
669 SymX(rts_getStablePtr) \
670 SymX(rts_getThreadId) \
673 SymX(rts_getWord16) \
674 SymX(rts_getWord32) \
675 SymX(rts_getWord64) \
688 SymX(rts_mkStablePtr) \
696 SymX(rtsSupportsBoundThreads) \
697 SymX(__hscore_get_saved_termios) \
698 SymX(__hscore_set_saved_termios) \
700 SymX(startupHaskell) \
701 SymX(shutdownHaskell) \
702 SymX(shutdownHaskellAndExit) \
703 SymX(stable_ptr_table) \
704 SymX(stackOverflow) \
705 SymX(stg_CAF_BLACKHOLE_info) \
706 SymX(awakenBlockedQueue) \
708 SymX(stg_CHARLIKE_closure) \
709 SymX(stg_MVAR_CLEAN_info) \
710 SymX(stg_MVAR_DIRTY_info) \
711 SymX(stg_IND_STATIC_info) \
712 SymX(stg_INTLIKE_closure) \
713 SymX(stg_MUT_ARR_PTRS_DIRTY_info) \
714 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
715 SymX(stg_MUT_ARR_PTRS_FROZEN0_info) \
716 SymX(stg_WEAK_info) \
717 SymX(stg_ap_v_info) \
718 SymX(stg_ap_f_info) \
719 SymX(stg_ap_d_info) \
720 SymX(stg_ap_l_info) \
721 SymX(stg_ap_n_info) \
722 SymX(stg_ap_p_info) \
723 SymX(stg_ap_pv_info) \
724 SymX(stg_ap_pp_info) \
725 SymX(stg_ap_ppv_info) \
726 SymX(stg_ap_ppp_info) \
727 SymX(stg_ap_pppv_info) \
728 SymX(stg_ap_pppp_info) \
729 SymX(stg_ap_ppppp_info) \
730 SymX(stg_ap_pppppp_info) \
731 SymX(stg_ap_0_fast) \
732 SymX(stg_ap_v_fast) \
733 SymX(stg_ap_f_fast) \
734 SymX(stg_ap_d_fast) \
735 SymX(stg_ap_l_fast) \
736 SymX(stg_ap_n_fast) \
737 SymX(stg_ap_p_fast) \
738 SymX(stg_ap_pv_fast) \
739 SymX(stg_ap_pp_fast) \
740 SymX(stg_ap_ppv_fast) \
741 SymX(stg_ap_ppp_fast) \
742 SymX(stg_ap_pppv_fast) \
743 SymX(stg_ap_pppp_fast) \
744 SymX(stg_ap_ppppp_fast) \
745 SymX(stg_ap_pppppp_fast) \
746 SymX(stg_ap_1_upd_info) \
747 SymX(stg_ap_2_upd_info) \
748 SymX(stg_ap_3_upd_info) \
749 SymX(stg_ap_4_upd_info) \
750 SymX(stg_ap_5_upd_info) \
751 SymX(stg_ap_6_upd_info) \
752 SymX(stg_ap_7_upd_info) \
754 SymX(stg_sel_0_upd_info) \
755 SymX(stg_sel_10_upd_info) \
756 SymX(stg_sel_11_upd_info) \
757 SymX(stg_sel_12_upd_info) \
758 SymX(stg_sel_13_upd_info) \
759 SymX(stg_sel_14_upd_info) \
760 SymX(stg_sel_15_upd_info) \
761 SymX(stg_sel_1_upd_info) \
762 SymX(stg_sel_2_upd_info) \
763 SymX(stg_sel_3_upd_info) \
764 SymX(stg_sel_4_upd_info) \
765 SymX(stg_sel_5_upd_info) \
766 SymX(stg_sel_6_upd_info) \
767 SymX(stg_sel_7_upd_info) \
768 SymX(stg_sel_8_upd_info) \
769 SymX(stg_sel_9_upd_info) \
770 SymX(stg_upd_frame_info) \
771 SymX(suspendThread) \
772 SymX(takeMVarzh_fast) \
773 SymX(threadStatuszh_fast) \
774 SymX(timesIntegerzh_fast) \
775 SymX(tryPutMVarzh_fast) \
776 SymX(tryTakeMVarzh_fast) \
777 SymX(unblockAsyncExceptionszh_fast) \
779 SymX(unsafeThawArrayzh_fast) \
780 SymX(waitReadzh_fast) \
781 SymX(waitWritezh_fast) \
782 SymX(word2Integerzh_fast) \
783 SymX(writeTVarzh_fast) \
784 SymX(xorIntegerzh_fast) \
786 Sym(stg_interp_constr_entry) \
789 SymX(getAllocations) \
792 Sym(rts_breakpoint_io_action) \
793 Sym(rts_stop_next_breakpoint) \
794 Sym(rts_stop_on_exception) \
796 SymX(n_capabilities) \
797 RTS_USER_SIGNALS_SYMBOLS
799 #ifdef SUPPORT_LONG_LONGS
800 #define RTS_LONG_LONG_SYMS \
801 SymX(int64ToIntegerzh_fast) \
802 SymX(word64ToIntegerzh_fast)
804 #define RTS_LONG_LONG_SYMS /* nothing */
807 // 64-bit support functions in libgcc.a
808 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
809 #define RTS_LIBGCC_SYMBOLS \
819 #elif defined(ia64_HOST_ARCH)
820 #define RTS_LIBGCC_SYMBOLS \
828 #define RTS_LIBGCC_SYMBOLS
831 #if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
832 // Symbols that don't have a leading underscore
833 // on Mac OS X. They have to receive special treatment,
834 // see machoInitSymbolsWithoutUnderscore()
835 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
840 /* entirely bogus claims about types of these symbols */
841 #define Sym(vvv) extern void vvv(void);
842 #if defined(__PIC__) && defined(mingw32_TARGET_OS)
843 #define SymExtern(vvv) extern void _imp__ ## vvv (void);
845 #define SymExtern(vvv) SymX(vvv)
847 #define SymX(vvv) /**/
848 #define SymX_redirect(vvv,xxx) /**/
852 RTS_POSIX_ONLY_SYMBOLS
853 RTS_MINGW_ONLY_SYMBOLS
854 RTS_CYGWIN_ONLY_SYMBOLS
855 RTS_DARWIN_ONLY_SYMBOLS
863 #ifdef LEADING_UNDERSCORE
864 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
866 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
869 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
871 #define SymX(vvv) Sym(vvv)
872 #define SymExtern(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
873 (void*)DLL_IMPORT_DATA_REF(vvv) },
875 // SymX_redirect allows us to redirect references to one symbol to
876 // another symbol. See newCAF/newDynCAF for an example.
877 #define SymX_redirect(vvv,xxx) \
878 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
881 static RtsSymbolVal rtsSyms[] = {
885 RTS_POSIX_ONLY_SYMBOLS
886 RTS_MINGW_ONLY_SYMBOLS
887 RTS_CYGWIN_ONLY_SYMBOLS
888 RTS_DARWIN_ONLY_SYMBOLS
891 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
892 // dyld stub code contains references to this,
893 // but it should never be called because we treat
894 // lazy pointers as nonlazy.
895 { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
897 { 0, 0 } /* sentinel */
902 /* -----------------------------------------------------------------------------
903 * Insert symbols into hash tables, checking for duplicates.
906 static void ghciInsertStrHashTable ( char* obj_name,
912 if (lookupHashTable(table, (StgWord)key) == NULL)
914 insertStrHashTable(table, (StgWord)key, data);
919 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
921 "whilst processing object file\n"
923 "This could be caused by:\n"
924 " * Loading two different object files which export the same symbol\n"
925 " * Specifying the same object file twice on the GHCi command line\n"
926 " * An incorrect `package.conf' entry, causing some object to be\n"
928 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
935 /* -----------------------------------------------------------------------------
936 * initialize the object linker
940 static int linker_init_done = 0 ;
942 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
943 static void *dl_prog_handle;
951 /* Make initLinker idempotent, so we can call it
952 before evey relevant operation; that means we
953 don't need to initialise the linker separately */
954 if (linker_init_done == 1) { return; } else {
955 linker_init_done = 1;
958 stablehash = allocStrHashTable();
959 symhash = allocStrHashTable();
961 /* populate the symbol table with stuff from the RTS */
962 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
963 ghciInsertStrHashTable("(GHCi built-in symbols)",
964 symhash, sym->lbl, sym->addr);
966 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
967 machoInitSymbolsWithoutUnderscore();
970 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
971 # if defined(RTLD_DEFAULT)
972 dl_prog_handle = RTLD_DEFAULT;
974 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
975 # endif /* RTLD_DEFAULT */
979 /* -----------------------------------------------------------------------------
980 * Loading DLL or .so dynamic libraries
981 * -----------------------------------------------------------------------------
983 * Add a DLL from which symbols may be found. In the ELF case, just
984 * do RTLD_GLOBAL-style add, so no further messing around needs to
985 * happen in order that symbols in the loaded .so are findable --
986 * lookupSymbol() will subsequently see them by dlsym on the program's
987 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
989 * In the PEi386 case, open the DLLs and put handles to them in a
990 * linked list. When looking for a symbol, try all handles in the
991 * list. This means that we need to load even DLLs that are guaranteed
992 * to be in the ghc.exe image already, just so we can get a handle
993 * to give to loadSymbol, so that we can find the symbols. For such
994 * libraries, the LoadLibrary call should be a no-op except for returning
999 #if defined(OBJFORMAT_PEi386)
1000 /* A record for storing handles into DLLs. */
1005 struct _OpenedDLL* next;
1010 /* A list thereof. */
1011 static OpenedDLL* opened_dlls = NULL;
1015 addDLL( char *dll_name )
1017 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1018 /* ------------------- ELF DLL loader ------------------- */
1024 // omitted: RTLD_NOW
1025 // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
1026 hdl= dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
1029 /* dlopen failed; return a ptr to the error msg. */
1031 if (errmsg == NULL) errmsg = "addDLL: unknown error";
1038 # elif defined(OBJFORMAT_PEi386)
1039 /* ------------------- Win32 DLL loader ------------------- */
1047 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
1049 /* See if we've already got it, and ignore if so. */
1050 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1051 if (0 == strcmp(o_dll->name, dll_name))
1055 /* The file name has no suffix (yet) so that we can try
1056 both foo.dll and foo.drv
1058 The documentation for LoadLibrary says:
1059 If no file name extension is specified in the lpFileName
1060 parameter, the default library extension .dll is
1061 appended. However, the file name string can include a trailing
1062 point character (.) to indicate that the module name has no
1065 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
1066 sprintf(buf, "%s.DLL", dll_name);
1067 instance = LoadLibrary(buf);
1068 if (instance == NULL) {
1069 if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1070 // KAA: allow loading of drivers (like winspool.drv)
1071 sprintf(buf, "%s.DRV", dll_name);
1072 instance = LoadLibrary(buf);
1073 if (instance == NULL) {
1074 if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1075 // #1883: allow loading of unix-style libfoo.dll DLLs
1076 sprintf(buf, "lib%s.DLL", dll_name);
1077 instance = LoadLibrary(buf);
1078 if (instance == NULL) {
1085 /* Add this DLL to the list of DLLs in which to search for symbols. */
1086 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
1087 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
1088 strcpy(o_dll->name, dll_name);
1089 o_dll->instance = instance;
1090 o_dll->next = opened_dlls;
1091 opened_dlls = o_dll;
1097 sysErrorBelch(dll_name);
1099 /* LoadLibrary failed; return a ptr to the error msg. */
1100 return "addDLL: could not load DLL";
1103 barf("addDLL: not implemented on this platform");
1107 /* -----------------------------------------------------------------------------
1108 * insert a stable symbol in the hash table
1112 insertStableSymbol(char* obj_name, char* key, StgPtr p)
1114 ghciInsertStrHashTable(obj_name, stablehash, key, getStablePtr(p));
1118 /* -----------------------------------------------------------------------------
1119 * insert a symbol in the hash table
1122 insertSymbol(char* obj_name, char* key, void* data)
1124 ghciInsertStrHashTable(obj_name, symhash, key, data);
1127 /* -----------------------------------------------------------------------------
1128 * lookup a symbol in the hash table
1131 lookupSymbol( char *lbl )
1135 ASSERT(symhash != NULL);
1136 val = lookupStrHashTable(symhash, lbl);
1139 # if defined(OBJFORMAT_ELF)
1140 return dlsym(dl_prog_handle, lbl);
1141 # elif defined(OBJFORMAT_MACHO)
1143 /* On OS X 10.3 and later, we use dlsym instead of the old legacy
1146 HACK: On OS X, global symbols are prefixed with an underscore.
1147 However, dlsym wants us to omit the leading underscore from the
1148 symbol name. For now, we simply strip it off here (and ONLY
1151 ASSERT(lbl[0] == '_');
1152 return dlsym(dl_prog_handle, lbl+1);
1154 if(NSIsSymbolNameDefined(lbl)) {
1155 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
1156 return NSAddressOfSymbol(symbol);
1160 # endif /* HAVE_DLFCN_H */
1161 # elif defined(OBJFORMAT_PEi386)
1164 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1165 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
1166 if (lbl[0] == '_') {
1167 /* HACK: if the name has an initial underscore, try stripping
1168 it off & look that up first. I've yet to verify whether there's
1169 a Rule that governs whether an initial '_' *should always* be
1170 stripped off when mapping from import lib name to the DLL name.
1172 sym = GetProcAddress(o_dll->instance, (lbl+1));
1174 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
1178 sym = GetProcAddress(o_dll->instance, lbl);
1180 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
1194 /* -----------------------------------------------------------------------------
1195 * Debugging aid: look in GHCi's object symbol tables for symbols
1196 * within DELTA bytes of the specified address, and show their names.
1199 void ghci_enquire ( char* addr );
1201 void ghci_enquire ( char* addr )
1206 const int DELTA = 64;
1211 for (oc = objects; oc; oc = oc->next) {
1212 for (i = 0; i < oc->n_symbols; i++) {
1213 sym = oc->symbols[i];
1214 if (sym == NULL) continue;
1217 a = lookupStrHashTable(symhash, sym);
1220 // debugBelch("ghci_enquire: can't find %s\n", sym);
1222 else if (addr-DELTA <= a && a <= addr+DELTA) {
1223 debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym);
1230 #ifdef ia64_HOST_ARCH
1231 static unsigned int PLTSize(void);
1234 /* -----------------------------------------------------------------------------
1235 * Load an obj (populate the global symbol table, but don't resolve yet)
1237 * Returns: 1 if ok, 0 on error.
1240 loadObj( char *path )
1247 void *map_addr = NULL;
1253 /* debugBelch("loadObj %s\n", path ); */
1255 /* Check that we haven't already loaded this object.
1256 Ignore requests to load multiple times */
1260 for (o = objects; o; o = o->next) {
1261 if (0 == strcmp(o->fileName, path)) {
1263 break; /* don't need to search further */
1267 IF_DEBUG(linker, debugBelch(
1268 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1269 "same object file twice:\n"
1271 "GHCi will ignore this, but be warned.\n"
1273 return 1; /* success */
1277 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1279 # if defined(OBJFORMAT_ELF)
1280 oc->formatName = "ELF";
1281 # elif defined(OBJFORMAT_PEi386)
1282 oc->formatName = "PEi386";
1283 # elif defined(OBJFORMAT_MACHO)
1284 oc->formatName = "Mach-O";
1287 barf("loadObj: not implemented on this platform");
1290 r = stat(path, &st);
1291 if (r == -1) { return 0; }
1293 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1294 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1295 strcpy(oc->fileName, path);
1297 oc->fileSize = st.st_size;
1299 oc->sections = NULL;
1300 oc->proddables = NULL;
1302 /* chain it onto the list of objects */
1307 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1309 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1311 #if defined(openbsd_HOST_OS)
1312 fd = open(path, O_RDONLY, S_IRUSR);
1314 fd = open(path, O_RDONLY);
1317 barf("loadObj: can't open `%s'", path);
1319 pagesize = getpagesize();
1321 #ifdef ia64_HOST_ARCH
1322 /* The PLT needs to be right before the object */
1323 n = ROUND_UP(PLTSize(), pagesize);
1324 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1325 if (oc->plt == MAP_FAILED)
1326 barf("loadObj: can't allocate PLT");
1329 map_addr = oc->plt + n;
1332 n = ROUND_UP(oc->fileSize, pagesize);
1334 /* Link objects into the lower 2Gb on x86_64. GHC assumes the
1335 * small memory model on this architecture (see gcc docs,
1338 * MAP_32BIT not available on OpenBSD/amd64
1340 #if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
1341 #define EXTRA_MAP_FLAGS MAP_32BIT
1343 #define EXTRA_MAP_FLAGS 0
1346 /* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
1347 #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
1348 #define MAP_ANONYMOUS MAP_ANON
1351 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE,
1352 MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
1353 if (oc->image == MAP_FAILED)
1354 barf("loadObj: can't map `%s'", path);
1358 #else /* !USE_MMAP */
1360 /* load the image into memory */
1361 f = fopen(path, "rb");
1363 barf("loadObj: can't read `%s'", path);
1365 # if defined(mingw32_HOST_OS)
1366 // TODO: We would like to use allocateExec here, but allocateExec
1367 // cannot currently allocate blocks large enough.
1368 oc->image = VirtualAlloc(NULL, oc->fileSize, MEM_RESERVE | MEM_COMMIT,
1369 PAGE_EXECUTE_READWRITE);
1370 # elif defined(darwin_HOST_OS)
1371 // In a Mach-O .o file, all sections can and will be misaligned
1372 // if the total size of the headers is not a multiple of the
1373 // desired alignment. This is fine for .o files that only serve
1374 // as input for the static linker, but it's not fine for us,
1375 // as SSE (used by gcc for floating point) and Altivec require
1376 // 16-byte alignment.
1377 // We calculate the correct alignment from the header before
1378 // reading the file, and then we misalign oc->image on purpose so
1379 // that the actual sections end up aligned again.
1380 oc->misalignment = machoGetMisalignment(f);
1381 oc->image = stgMallocBytes(oc->fileSize + oc->misalignment, "loadObj(image)");
1382 oc->image += oc->misalignment;
1384 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1387 n = fread ( oc->image, 1, oc->fileSize, f );
1388 if (n != oc->fileSize)
1389 barf("loadObj: error whilst reading `%s'", path);
1392 #endif /* USE_MMAP */
1394 # if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
1395 r = ocAllocateSymbolExtras_MachO ( oc );
1396 if (!r) { return r; }
1397 # elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
1398 r = ocAllocateSymbolExtras_ELF ( oc );
1399 if (!r) { return r; }
1402 /* verify the in-memory image */
1403 # if defined(OBJFORMAT_ELF)
1404 r = ocVerifyImage_ELF ( oc );
1405 # elif defined(OBJFORMAT_PEi386)
1406 r = ocVerifyImage_PEi386 ( oc );
1407 # elif defined(OBJFORMAT_MACHO)
1408 r = ocVerifyImage_MachO ( oc );
1410 barf("loadObj: no verify method");
1412 if (!r) { return r; }
1414 /* build the symbol list for this image */
1415 # if defined(OBJFORMAT_ELF)
1416 r = ocGetNames_ELF ( oc );
1417 # elif defined(OBJFORMAT_PEi386)
1418 r = ocGetNames_PEi386 ( oc );
1419 # elif defined(OBJFORMAT_MACHO)
1420 r = ocGetNames_MachO ( oc );
1422 barf("loadObj: no getNames method");
1424 if (!r) { return r; }
1426 /* loaded, but not resolved yet */
1427 oc->status = OBJECT_LOADED;
1432 /* -----------------------------------------------------------------------------
1433 * resolve all the currently unlinked objects in memory
1435 * Returns: 1 if ok, 0 on error.
1445 for (oc = objects; oc; oc = oc->next) {
1446 if (oc->status != OBJECT_RESOLVED) {
1447 # if defined(OBJFORMAT_ELF)
1448 r = ocResolve_ELF ( oc );
1449 # elif defined(OBJFORMAT_PEi386)
1450 r = ocResolve_PEi386 ( oc );
1451 # elif defined(OBJFORMAT_MACHO)
1452 r = ocResolve_MachO ( oc );
1454 barf("resolveObjs: not implemented on this platform");
1456 if (!r) { return r; }
1457 oc->status = OBJECT_RESOLVED;
1463 /* -----------------------------------------------------------------------------
1464 * delete an object from the pool
1467 unloadObj( char *path )
1469 ObjectCode *oc, *prev;
1471 ASSERT(symhash != NULL);
1472 ASSERT(objects != NULL);
1477 for (oc = objects; oc; prev = oc, oc = oc->next) {
1478 if (!strcmp(oc->fileName,path)) {
1480 /* Remove all the mappings for the symbols within this
1485 for (i = 0; i < oc->n_symbols; i++) {
1486 if (oc->symbols[i] != NULL) {
1487 removeStrHashTable(symhash, oc->symbols[i], NULL);
1495 prev->next = oc->next;
1498 // We're going to leave this in place, in case there are
1499 // any pointers from the heap into it:
1500 // #ifdef mingw32_HOST_OS
1501 // VirtualFree(oc->image);
1503 // stgFree(oc->image);
1505 stgFree(oc->fileName);
1506 stgFree(oc->symbols);
1507 stgFree(oc->sections);
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)
2306 /* ignore unknown section that appeared in gcc 3.4.5(?) */
2307 && 0!= strcmp(".reloc", sectab_i->Name)
2309 errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
2313 if (kind != SECTIONKIND_OTHER && end >= start) {
2314 addSection(oc, kind, start, end);
2315 addProddableBlock(oc, start, end - start + 1);
2319 /* Copy exported symbols into the ObjectCode. */
2321 oc->n_symbols = hdr->NumberOfSymbols;
2322 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2323 "ocGetNames_PEi386(oc->symbols)");
2324 /* Call me paranoid; I don't care. */
2325 for (i = 0; i < oc->n_symbols; i++)
2326 oc->symbols[i] = NULL;
2330 COFF_symbol* symtab_i;
2331 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2332 symtab_i = (COFF_symbol*)
2333 myindex ( sizeof_COFF_symbol, symtab, i );
2337 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
2338 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
2339 /* This symbol is global and defined, viz, exported */
2340 /* for MYIMAGE_SYMCLASS_EXTERNAL
2341 && !MYIMAGE_SYM_UNDEFINED,
2342 the address of the symbol is:
2343 address of relevant section + offset in section
2345 COFF_section* sectabent
2346 = (COFF_section*) myindex ( sizeof_COFF_section,
2348 symtab_i->SectionNumber-1 );
2349 addr = ((UChar*)(oc->image))
2350 + (sectabent->PointerToRawData
2354 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
2355 && symtab_i->Value > 0) {
2356 /* This symbol isn't in any section at all, ie, global bss.
2357 Allocate zeroed space for it. */
2358 addr = stgCallocBytes(1, symtab_i->Value,
2359 "ocGetNames_PEi386(non-anonymous bss)");
2360 addSection(oc, SECTIONKIND_RWDATA, addr,
2361 ((UChar*)addr) + symtab_i->Value - 1);
2362 addProddableBlock(oc, addr, symtab_i->Value);
2363 /* debugBelch("BSS section at 0x%x\n", addr); */
2366 if (addr != NULL ) {
2367 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
2368 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
2369 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
2370 ASSERT(i >= 0 && i < oc->n_symbols);
2371 /* cstring_from_COFF_symbol_name always succeeds. */
2372 oc->symbols[i] = sname;
2373 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
2377 "IGNORING symbol %d\n"
2381 printName ( symtab_i->Name, strtab );
2390 (Int32)(symtab_i->SectionNumber),
2391 (UInt32)symtab_i->Type,
2392 (UInt32)symtab_i->StorageClass,
2393 (UInt32)symtab_i->NumberOfAuxSymbols
2398 i += symtab_i->NumberOfAuxSymbols;
2407 ocResolve_PEi386 ( ObjectCode* oc )
2410 COFF_section* sectab;
2411 COFF_symbol* symtab;
2421 /* ToDo: should be variable-sized? But is at least safe in the
2422 sense of buffer-overrun-proof. */
2424 /* debugBelch("resolving for %s\n", oc->fileName); */
2426 hdr = (COFF_header*)(oc->image);
2427 sectab = (COFF_section*) (
2428 ((UChar*)(oc->image))
2429 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2431 symtab = (COFF_symbol*) (
2432 ((UChar*)(oc->image))
2433 + hdr->PointerToSymbolTable
2435 strtab = ((UChar*)(oc->image))
2436 + hdr->PointerToSymbolTable
2437 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2439 for (i = 0; i < hdr->NumberOfSections; i++) {
2440 COFF_section* sectab_i
2442 myindex ( sizeof_COFF_section, sectab, i );
2445 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2448 /* Ignore sections called which contain stabs debugging
2450 if (0 == strcmp(".stab", sectab_i->Name)
2451 || 0 == strcmp(".stabstr", sectab_i->Name)
2452 || 0 == strcmp(".ctors", sectab_i->Name))
2455 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2456 /* If the relocation field (a short) has overflowed, the
2457 * real count can be found in the first reloc entry.
2459 * See Section 4.1 (last para) of the PE spec (rev6.0).
2461 * Nov2003 update: the GNU linker still doesn't correctly
2462 * handle the generation of relocatable object files with
2463 * overflown relocations. Hence the output to warn of potential
2466 COFF_reloc* rel = (COFF_reloc*)
2467 myindex ( sizeof_COFF_reloc, reltab, 0 );
2468 noRelocs = rel->VirtualAddress;
2470 /* 10/05: we now assume (and check for) a GNU ld that is capable
2471 * of handling object files with (>2^16) of relocs.
2474 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
2479 noRelocs = sectab_i->NumberOfRelocations;
2484 for (; j < noRelocs; j++) {
2486 COFF_reloc* reltab_j
2488 myindex ( sizeof_COFF_reloc, reltab, j );
2490 /* the location to patch */
2492 ((UChar*)(oc->image))
2493 + (sectab_i->PointerToRawData
2494 + reltab_j->VirtualAddress
2495 - sectab_i->VirtualAddress )
2497 /* the existing contents of pP */
2499 /* the symbol to connect to */
2500 sym = (COFF_symbol*)
2501 myindex ( sizeof_COFF_symbol,
2502 symtab, reltab_j->SymbolTableIndex );
2505 "reloc sec %2d num %3d: type 0x%-4x "
2506 "vaddr 0x%-8x name `",
2508 (UInt32)reltab_j->Type,
2509 reltab_j->VirtualAddress );
2510 printName ( sym->Name, strtab );
2511 debugBelch("'\n" ));
2513 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2514 COFF_section* section_sym
2515 = findPEi386SectionCalled ( oc, sym->Name );
2517 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
2520 S = ((UInt32)(oc->image))
2521 + (section_sym->PointerToRawData
2524 copyName ( sym->Name, strtab, symbol, 1000-1 );
2525 S = (UInt32) lookupSymbol( symbol );
2526 if ((void*)S != NULL) goto foundit;
2527 zapTrailingAtSign ( symbol );
2528 S = (UInt32) lookupSymbol( symbol );
2529 if ((void*)S != NULL) goto foundit;
2530 /* Newline first because the interactive linker has printed "linking..." */
2531 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2535 checkProddableBlock(oc, pP);
2536 switch (reltab_j->Type) {
2537 case MYIMAGE_REL_I386_DIR32:
2540 case MYIMAGE_REL_I386_REL32:
2541 /* Tricky. We have to insert a displacement at
2542 pP which, when added to the PC for the _next_
2543 insn, gives the address of the target (S).
2544 Problem is to know the address of the next insn
2545 when we only know pP. We assume that this
2546 literal field is always the last in the insn,
2547 so that the address of the next insn is pP+4
2548 -- hence the constant 4.
2549 Also I don't know if A should be added, but so
2550 far it has always been zero.
2552 SOF 05/2005: 'A' (old contents of *pP) have been observed
2553 to contain values other than zero (the 'wx' object file
2554 that came with wxhaskell-0.9.4; dunno how it was compiled..).
2555 So, add displacement to old value instead of asserting
2556 A to be zero. Fixes wxhaskell-related crashes, and no other
2557 ill effects have been observed.
2559 Update: the reason why we're seeing these more elaborate
2560 relocations is due to a switch in how the NCG compiles SRTs
2561 and offsets to them from info tables. SRTs live in .(ro)data,
2562 while info tables live in .text, causing GAS to emit REL32/DISP32
2563 relocations with non-zero values. Adding the displacement is
2564 the right thing to do.
2566 *pP = S - ((UInt32)pP) - 4 + A;
2569 debugBelch("%s: unhandled PEi386 relocation type %d",
2570 oc->fileName, reltab_j->Type);
2577 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
2581 #endif /* defined(OBJFORMAT_PEi386) */
2584 /* --------------------------------------------------------------------------
2586 * ------------------------------------------------------------------------*/
2588 #if defined(OBJFORMAT_ELF)
2593 #if defined(sparc_HOST_ARCH)
2594 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2595 #elif defined(i386_HOST_ARCH)
2596 # define ELF_TARGET_386 /* Used inside <elf.h> */
2597 #elif defined(x86_64_HOST_ARCH)
2598 # define ELF_TARGET_X64_64
2600 #elif defined (ia64_HOST_ARCH)
2601 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2603 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2604 # define ELF_NEED_GOT /* needs Global Offset Table */
2605 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2608 #if !defined(openbsd_HOST_OS)
2611 /* openbsd elf has things in different places, with diff names */
2612 # include <elf_abi.h>
2613 # include <machine/reloc.h>
2614 # define R_386_32 RELOC_32
2615 # define R_386_PC32 RELOC_PC32
2618 /* If elf.h doesn't define it */
2619 # ifndef R_X86_64_PC64
2620 # define R_X86_64_PC64 24
2624 * Define a set of types which can be used for both ELF32 and ELF64
2628 #define ELFCLASS ELFCLASS64
2629 #define Elf_Addr Elf64_Addr
2630 #define Elf_Word Elf64_Word
2631 #define Elf_Sword Elf64_Sword
2632 #define Elf_Ehdr Elf64_Ehdr
2633 #define Elf_Phdr Elf64_Phdr
2634 #define Elf_Shdr Elf64_Shdr
2635 #define Elf_Sym Elf64_Sym
2636 #define Elf_Rel Elf64_Rel
2637 #define Elf_Rela Elf64_Rela
2638 #define ELF_ST_TYPE ELF64_ST_TYPE
2639 #define ELF_ST_BIND ELF64_ST_BIND
2640 #define ELF_R_TYPE ELF64_R_TYPE
2641 #define ELF_R_SYM ELF64_R_SYM
2643 #define ELFCLASS ELFCLASS32
2644 #define Elf_Addr Elf32_Addr
2645 #define Elf_Word Elf32_Word
2646 #define Elf_Sword Elf32_Sword
2647 #define Elf_Ehdr Elf32_Ehdr
2648 #define Elf_Phdr Elf32_Phdr
2649 #define Elf_Shdr Elf32_Shdr
2650 #define Elf_Sym Elf32_Sym
2651 #define Elf_Rel Elf32_Rel
2652 #define Elf_Rela Elf32_Rela
2654 #define ELF_ST_TYPE ELF32_ST_TYPE
2657 #define ELF_ST_BIND ELF32_ST_BIND
2660 #define ELF_R_TYPE ELF32_R_TYPE
2663 #define ELF_R_SYM ELF32_R_SYM
2669 * Functions to allocate entries in dynamic sections. Currently we simply
2670 * preallocate a large number, and we don't check if a entry for the given
2671 * target already exists (a linear search is too slow). Ideally these
2672 * entries would be associated with symbols.
2675 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2676 #define GOT_SIZE 0x20000
2677 #define FUNCTION_TABLE_SIZE 0x10000
2678 #define PLT_SIZE 0x08000
2681 static Elf_Addr got[GOT_SIZE];
2682 static unsigned int gotIndex;
2683 static Elf_Addr gp_val = (Elf_Addr)got;
2686 allocateGOTEntry(Elf_Addr target)
2690 if (gotIndex >= GOT_SIZE)
2691 barf("Global offset table overflow");
2693 entry = &got[gotIndex++];
2695 return (Elf_Addr)entry;
2699 #ifdef ELF_FUNCTION_DESC
2705 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2706 static unsigned int functionTableIndex;
2709 allocateFunctionDesc(Elf_Addr target)
2711 FunctionDesc *entry;
2713 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2714 barf("Function table overflow");
2716 entry = &functionTable[functionTableIndex++];
2718 entry->gp = (Elf_Addr)gp_val;
2719 return (Elf_Addr)entry;
2723 copyFunctionDesc(Elf_Addr target)
2725 FunctionDesc *olddesc = (FunctionDesc *)target;
2726 FunctionDesc *newdesc;
2728 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2729 newdesc->gp = olddesc->gp;
2730 return (Elf_Addr)newdesc;
2735 #ifdef ia64_HOST_ARCH
2736 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2737 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2739 static unsigned char plt_code[] =
2741 /* taken from binutils bfd/elfxx-ia64.c */
2742 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2743 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2744 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2745 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2746 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2747 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2750 /* If we can't get to the function descriptor via gp, take a local copy of it */
2751 #define PLT_RELOC(code, target) { \
2752 Elf64_Sxword rel_value = target - gp_val; \
2753 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2754 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2756 ia64_reloc_gprel22((Elf_Addr)code, target); \
2761 unsigned char code[sizeof(plt_code)];
2765 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2767 PLTEntry *plt = (PLTEntry *)oc->plt;
2770 if (oc->pltIndex >= PLT_SIZE)
2771 barf("Procedure table overflow");
2773 entry = &plt[oc->pltIndex++];
2774 memcpy(entry->code, plt_code, sizeof(entry->code));
2775 PLT_RELOC(entry->code, target);
2776 return (Elf_Addr)entry;
2782 return (PLT_SIZE * sizeof(PLTEntry));
2788 * Generic ELF functions
2792 findElfSection ( void* objImage, Elf_Word sh_type )
2794 char* ehdrC = (char*)objImage;
2795 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2796 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2797 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2801 for (i = 0; i < ehdr->e_shnum; i++) {
2802 if (shdr[i].sh_type == sh_type
2803 /* Ignore the section header's string table. */
2804 && i != ehdr->e_shstrndx
2805 /* Ignore string tables named .stabstr, as they contain
2807 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2809 ptr = ehdrC + shdr[i].sh_offset;
2816 #if defined(ia64_HOST_ARCH)
2818 findElfSegment ( void* objImage, Elf_Addr vaddr )
2820 char* ehdrC = (char*)objImage;
2821 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2822 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2823 Elf_Addr segaddr = 0;
2826 for (i = 0; i < ehdr->e_phnum; i++) {
2827 segaddr = phdr[i].p_vaddr;
2828 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2836 ocVerifyImage_ELF ( ObjectCode* oc )
2840 int i, j, nent, nstrtab, nsymtabs;
2844 char* ehdrC = (char*)(oc->image);
2845 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2847 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2848 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2849 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2850 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2851 errorBelch("%s: not an ELF object", oc->fileName);
2855 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2856 errorBelch("%s: unsupported ELF format", oc->fileName);
2860 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2861 IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
2863 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2864 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
2866 errorBelch("%s: unknown endiannness", oc->fileName);
2870 if (ehdr->e_type != ET_REL) {
2871 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
2874 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
2876 IF_DEBUG(linker,debugBelch( "Architecture is " ));
2877 switch (ehdr->e_machine) {
2878 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
2879 #ifdef EM_SPARC32PLUS
2880 case EM_SPARC32PLUS:
2882 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
2884 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
2886 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
2888 case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
2889 #elif defined(EM_AMD64)
2890 case EM_AMD64: IF_DEBUG(linker,debugBelch( "amd64" )); break;
2892 default: IF_DEBUG(linker,debugBelch( "unknown" ));
2893 errorBelch("%s: unknown architecture (e_machine == %d)"
2894 , oc->fileName, ehdr->e_machine);
2898 IF_DEBUG(linker,debugBelch(
2899 "\nSection header table: start %ld, n_entries %d, ent_size %d\n",
2900 (long)ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2902 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2904 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2906 if (ehdr->e_shstrndx == SHN_UNDEF) {
2907 errorBelch("%s: no section header string table", oc->fileName);
2910 IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
2912 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2915 for (i = 0; i < ehdr->e_shnum; i++) {
2916 IF_DEBUG(linker,debugBelch("%2d: ", i ));
2917 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
2918 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
2919 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
2920 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
2921 ehdrC + shdr[i].sh_offset,
2922 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2924 if (shdr[i].sh_type == SHT_REL) {
2925 IF_DEBUG(linker,debugBelch("Rel " ));
2926 } else if (shdr[i].sh_type == SHT_RELA) {
2927 IF_DEBUG(linker,debugBelch("RelA " ));
2929 IF_DEBUG(linker,debugBelch(" "));
2932 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
2936 IF_DEBUG(linker,debugBelch( "\nString tables" ));
2939 for (i = 0; i < ehdr->e_shnum; i++) {
2940 if (shdr[i].sh_type == SHT_STRTAB
2941 /* Ignore the section header's string table. */
2942 && i != ehdr->e_shstrndx
2943 /* Ignore string tables named .stabstr, as they contain
2945 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2947 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
2948 strtab = ehdrC + shdr[i].sh_offset;
2953 errorBelch("%s: no string tables, or too many", oc->fileName);
2958 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
2959 for (i = 0; i < ehdr->e_shnum; i++) {
2960 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2961 IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
2963 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2964 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2965 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%ld rem)\n",
2967 (long)shdr[i].sh_size % sizeof(Elf_Sym)
2969 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2970 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
2973 for (j = 0; j < nent; j++) {
2974 IF_DEBUG(linker,debugBelch(" %2d ", j ));
2975 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
2976 (int)stab[j].st_shndx,
2977 (int)stab[j].st_size,
2978 (char*)stab[j].st_value ));
2980 IF_DEBUG(linker,debugBelch("type=" ));
2981 switch (ELF_ST_TYPE(stab[j].st_info)) {
2982 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
2983 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
2984 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
2985 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
2986 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
2987 default: IF_DEBUG(linker,debugBelch("? " )); break;
2989 IF_DEBUG(linker,debugBelch(" " ));
2991 IF_DEBUG(linker,debugBelch("bind=" ));
2992 switch (ELF_ST_BIND(stab[j].st_info)) {
2993 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
2994 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
2995 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
2996 default: IF_DEBUG(linker,debugBelch("? " )); break;
2998 IF_DEBUG(linker,debugBelch(" " ));
3000 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
3004 if (nsymtabs == 0) {
3005 errorBelch("%s: didn't find any symbol tables", oc->fileName);
3012 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
3016 if (hdr->sh_type == SHT_PROGBITS
3017 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
3018 /* .text-style section */
3019 return SECTIONKIND_CODE_OR_RODATA;
3022 if (hdr->sh_type == SHT_PROGBITS
3023 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3024 /* .data-style section */
3025 return SECTIONKIND_RWDATA;
3028 if (hdr->sh_type == SHT_PROGBITS
3029 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
3030 /* .rodata-style section */
3031 return SECTIONKIND_CODE_OR_RODATA;
3034 if (hdr->sh_type == SHT_NOBITS
3035 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3036 /* .bss-style section */
3038 return SECTIONKIND_RWDATA;
3041 return SECTIONKIND_OTHER;
3046 ocGetNames_ELF ( ObjectCode* oc )
3051 char* ehdrC = (char*)(oc->image);
3052 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3053 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
3054 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3056 ASSERT(symhash != NULL);
3059 errorBelch("%s: no strtab", oc->fileName);
3064 for (i = 0; i < ehdr->e_shnum; i++) {
3065 /* Figure out what kind of section it is. Logic derived from
3066 Figure 1.14 ("Special Sections") of the ELF document
3067 ("Portable Formats Specification, Version 1.1"). */
3069 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
3071 if (is_bss && shdr[i].sh_size > 0) {
3072 /* This is a non-empty .bss section. Allocate zeroed space for
3073 it, and set its .sh_offset field such that
3074 ehdrC + .sh_offset == addr_of_zeroed_space. */
3075 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
3076 "ocGetNames_ELF(BSS)");
3077 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
3079 debugBelch("BSS section at 0x%x, size %d\n",
3080 zspace, shdr[i].sh_size);
3084 /* fill in the section info */
3085 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
3086 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
3087 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
3088 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
3091 if (shdr[i].sh_type != SHT_SYMTAB) continue;
3093 /* copy stuff into this module's object symbol table */
3094 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
3095 nent = shdr[i].sh_size / sizeof(Elf_Sym);
3097 oc->n_symbols = nent;
3098 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3099 "ocGetNames_ELF(oc->symbols)");
3101 for (j = 0; j < nent; j++) {
3103 char isLocal = FALSE; /* avoids uninit-var warning */
3105 char* nm = strtab + stab[j].st_name;
3106 int secno = stab[j].st_shndx;
3108 /* Figure out if we want to add it; if so, set ad to its
3109 address. Otherwise leave ad == NULL. */
3111 if (secno == SHN_COMMON) {
3113 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
3115 debugBelch("COMMON symbol, size %d name %s\n",
3116 stab[j].st_size, nm);
3118 /* Pointless to do addProddableBlock() for this area,
3119 since the linker should never poke around in it. */
3122 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
3123 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
3125 /* and not an undefined symbol */
3126 && stab[j].st_shndx != SHN_UNDEF
3127 /* and not in a "special section" */
3128 && stab[j].st_shndx < SHN_LORESERVE
3130 /* and it's a not a section or string table or anything silly */
3131 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
3132 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
3133 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
3136 /* Section 0 is the undefined section, hence > and not >=. */
3137 ASSERT(secno > 0 && secno < ehdr->e_shnum);
3139 if (shdr[secno].sh_type == SHT_NOBITS) {
3140 debugBelch(" BSS symbol, size %d off %d name %s\n",
3141 stab[j].st_size, stab[j].st_value, nm);
3144 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
3145 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
3148 #ifdef ELF_FUNCTION_DESC
3149 /* dlsym() and the initialisation table both give us function
3150 * descriptors, so to be consistent we store function descriptors
3151 * in the symbol table */
3152 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
3153 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
3155 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s\n",
3156 ad, oc->fileName, nm ));
3161 /* And the decision is ... */
3165 oc->symbols[j] = nm;
3168 /* Ignore entirely. */
3170 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
3174 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
3175 strtab + stab[j].st_name ));
3178 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
3179 (int)ELF_ST_BIND(stab[j].st_info),
3180 (int)ELF_ST_TYPE(stab[j].st_info),
3181 (int)stab[j].st_shndx,
3182 strtab + stab[j].st_name
3185 oc->symbols[j] = NULL;
3194 /* Do ELF relocations which lack an explicit addend. All x86-linux
3195 relocations appear to be of this form. */
3197 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
3198 Elf_Shdr* shdr, int shnum,
3199 Elf_Sym* stab, char* strtab )
3204 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
3205 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
3206 int target_shndx = shdr[shnum].sh_info;
3207 int symtab_shndx = shdr[shnum].sh_link;
3209 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3210 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
3211 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3212 target_shndx, symtab_shndx ));
3214 /* Skip sections that we're not interested in. */
3217 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
3218 if (kind == SECTIONKIND_OTHER) {
3219 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
3224 for (j = 0; j < nent; j++) {
3225 Elf_Addr offset = rtab[j].r_offset;
3226 Elf_Addr info = rtab[j].r_info;
3228 Elf_Addr P = ((Elf_Addr)targ) + offset;
3229 Elf_Word* pP = (Elf_Word*)P;
3234 StgStablePtr stablePtr;
3237 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
3238 j, (void*)offset, (void*)info ));
3240 IF_DEBUG(linker,debugBelch( " ZERO" ));
3243 Elf_Sym sym = stab[ELF_R_SYM(info)];
3244 /* First see if it is a local symbol. */
3245 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3246 /* Yes, so we can get the address directly from the ELF symbol
3248 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3250 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3251 + stab[ELF_R_SYM(info)].st_value);
3254 symbol = strtab + sym.st_name;
3255 stablePtr = (StgStablePtr)lookupHashTable(stablehash, (StgWord)symbol);
3256 if (NULL == stablePtr) {
3257 /* No, so look up the name in our global table. */
3258 S_tmp = lookupSymbol( symbol );
3259 S = (Elf_Addr)S_tmp;
3261 stableVal = deRefStablePtr( stablePtr );
3263 S = (Elf_Addr)S_tmp;
3267 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3270 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
3273 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
3274 (void*)P, (void*)S, (void*)A ));
3275 checkProddableBlock ( oc, pP );
3279 switch (ELF_R_TYPE(info)) {
3280 # ifdef i386_HOST_ARCH
3281 case R_386_32: *pP = value; break;
3282 case R_386_PC32: *pP = value - P; break;
3285 errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n",
3286 oc->fileName, (lnat)ELF_R_TYPE(info));
3294 /* Do ELF relocations for which explicit addends are supplied.
3295 sparc-solaris relocations appear to be of this form. */
3297 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
3298 Elf_Shdr* shdr, int shnum,
3299 Elf_Sym* stab, char* strtab )
3302 char *symbol = NULL;
3304 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
3305 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
3306 int target_shndx = shdr[shnum].sh_info;
3307 int symtab_shndx = shdr[shnum].sh_link;
3309 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3310 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
3311 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3312 target_shndx, symtab_shndx ));
3314 for (j = 0; j < nent; j++) {
3315 #if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3316 /* This #ifdef only serves to avoid unused-var warnings. */
3317 Elf_Addr offset = rtab[j].r_offset;
3318 Elf_Addr P = targ + offset;
3320 Elf_Addr info = rtab[j].r_info;
3321 Elf_Addr A = rtab[j].r_addend;
3325 # if defined(sparc_HOST_ARCH)
3326 Elf_Word* pP = (Elf_Word*)P;
3328 # elif defined(ia64_HOST_ARCH)
3329 Elf64_Xword *pP = (Elf64_Xword *)P;
3331 # elif defined(powerpc_HOST_ARCH)
3335 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
3336 j, (void*)offset, (void*)info,
3339 IF_DEBUG(linker,debugBelch( " ZERO" ));
3342 Elf_Sym sym = stab[ELF_R_SYM(info)];
3343 /* First see if it is a local symbol. */
3344 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3345 /* Yes, so we can get the address directly from the ELF symbol
3347 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3349 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3350 + stab[ELF_R_SYM(info)].st_value);
3351 #ifdef ELF_FUNCTION_DESC
3352 /* Make a function descriptor for this function */
3353 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
3354 S = allocateFunctionDesc(S + A);
3359 /* No, so look up the name in our global table. */
3360 symbol = strtab + sym.st_name;
3361 S_tmp = lookupSymbol( symbol );
3362 S = (Elf_Addr)S_tmp;
3364 #ifdef ELF_FUNCTION_DESC
3365 /* If a function, already a function descriptor - we would
3366 have to copy it to add an offset. */
3367 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
3368 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
3372 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3375 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
3378 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
3379 (void*)P, (void*)S, (void*)A ));
3380 /* checkProddableBlock ( oc, (void*)P ); */
3384 switch (ELF_R_TYPE(info)) {
3385 # if defined(sparc_HOST_ARCH)
3386 case R_SPARC_WDISP30:
3387 w1 = *pP & 0xC0000000;
3388 w2 = (Elf_Word)((value - P) >> 2);
3389 ASSERT((w2 & 0xC0000000) == 0);
3394 w1 = *pP & 0xFFC00000;
3395 w2 = (Elf_Word)(value >> 10);
3396 ASSERT((w2 & 0xFFC00000) == 0);
3402 w2 = (Elf_Word)(value & 0x3FF);
3403 ASSERT((w2 & ~0x3FF) == 0);
3407 /* According to the Sun documentation:
3409 This relocation type resembles R_SPARC_32, except it refers to an
3410 unaligned word. That is, the word to be relocated must be treated
3411 as four separate bytes with arbitrary alignment, not as a word
3412 aligned according to the architecture requirements.
3414 (JRS: which means that freeloading on the R_SPARC_32 case
3415 is probably wrong, but hey ...)
3419 w2 = (Elf_Word)value;
3422 # elif defined(ia64_HOST_ARCH)
3423 case R_IA64_DIR64LSB:
3424 case R_IA64_FPTR64LSB:
3427 case R_IA64_PCREL64LSB:
3430 case R_IA64_SEGREL64LSB:
3431 addr = findElfSegment(ehdrC, value);
3434 case R_IA64_GPREL22:
3435 ia64_reloc_gprel22(P, value);
3437 case R_IA64_LTOFF22:
3438 case R_IA64_LTOFF22X:
3439 case R_IA64_LTOFF_FPTR22:
3440 addr = allocateGOTEntry(value);
3441 ia64_reloc_gprel22(P, addr);
3443 case R_IA64_PCREL21B:
3444 ia64_reloc_pcrel21(P, S, oc);
3447 /* This goes with R_IA64_LTOFF22X and points to the load to
3448 * convert into a move. We don't implement relaxation. */
3450 # elif defined(powerpc_HOST_ARCH)
3451 case R_PPC_ADDR16_LO:
3452 *(Elf32_Half*) P = value;
3455 case R_PPC_ADDR16_HI:
3456 *(Elf32_Half*) P = value >> 16;
3459 case R_PPC_ADDR16_HA:
3460 *(Elf32_Half*) P = (value + 0x8000) >> 16;
3464 *(Elf32_Word *) P = value;
3468 *(Elf32_Word *) P = value - P;
3474 if( delta << 6 >> 6 != delta )
3476 value = (Elf_Addr) (&makeSymbolExtra( oc, ELF_R_SYM(info), value )
3480 if( value == 0 || delta << 6 >> 6 != delta )
3482 barf( "Unable to make SymbolExtra for #%d",
3488 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3489 | (delta & 0x3fffffc);
3493 #if x86_64_HOST_ARCH
3495 *(Elf64_Xword *)P = value;
3500 StgInt64 off = value - P;
3501 if (off >= 0x7fffffffL || off < -0x80000000L) {
3502 #if X86_64_ELF_NONPIC_HACK
3503 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3505 off = pltAddress + A - P;
3507 barf("R_X86_64_PC32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
3508 symbol, off, oc->fileName );
3511 *(Elf64_Word *)P = (Elf64_Word)off;
3517 StgInt64 off = value - P;
3518 *(Elf64_Word *)P = (Elf64_Word)off;
3523 if (value >= 0x7fffffffL) {
3524 #if X86_64_ELF_NONPIC_HACK
3525 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3527 value = pltAddress + A;
3529 barf("R_X86_64_32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
3530 symbol, value, oc->fileName );
3533 *(Elf64_Word *)P = (Elf64_Word)value;
3537 if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
3538 #if X86_64_ELF_NONPIC_HACK
3539 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3541 value = pltAddress + A;
3543 barf("R_X86_64_32S relocation out of range: %s = %p\nRecompile %s with -fPIC.",
3544 symbol, value, oc->fileName );
3547 *(Elf64_Sword *)P = (Elf64_Sword)value;
3550 case R_X86_64_GOTPCREL:
3552 StgInt64 gotAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)->addr;
3553 StgInt64 off = gotAddress + A - P;
3554 *(Elf64_Word *)P = (Elf64_Word)off;
3558 case R_X86_64_PLT32:
3560 StgInt64 off = value - P;
3561 if (off >= 0x7fffffffL || off < -0x80000000L) {
3562 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3564 off = pltAddress + A - P;
3566 *(Elf64_Word *)P = (Elf64_Word)off;
3572 errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n",
3573 oc->fileName, (lnat)ELF_R_TYPE(info));
3582 ocResolve_ELF ( ObjectCode* oc )
3586 Elf_Sym* stab = NULL;
3587 char* ehdrC = (char*)(oc->image);
3588 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
3589 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3591 /* first find "the" symbol table */
3592 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
3594 /* also go find the string table */
3595 strtab = findElfSection ( ehdrC, SHT_STRTAB );
3597 if (stab == NULL || strtab == NULL) {
3598 errorBelch("%s: can't find string or symbol table", oc->fileName);
3602 /* Process the relocation sections. */
3603 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
3604 if (shdr[shnum].sh_type == SHT_REL) {
3605 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
3606 shnum, stab, strtab );
3610 if (shdr[shnum].sh_type == SHT_RELA) {
3611 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
3612 shnum, stab, strtab );
3617 #if defined(powerpc_HOST_ARCH)
3618 ocFlushInstructionCache( oc );
3626 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
3627 * at the front. The following utility functions pack and unpack instructions, and
3628 * take care of the most common relocations.
3631 #ifdef ia64_HOST_ARCH
3634 ia64_extract_instruction(Elf64_Xword *target)
3637 int slot = (Elf_Addr)target & 3;
3638 target = (Elf_Addr)target & ~3;
3646 return ((w1 >> 5) & 0x1ffffffffff);
3648 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
3652 barf("ia64_extract_instruction: invalid slot %p", target);
3657 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
3659 int slot = (Elf_Addr)target & 3;
3660 target = (Elf_Addr)target & ~3;
3665 *target |= value << 5;
3668 *target |= value << 46;
3669 *(target+1) |= value >> 18;
3672 *(target+1) |= value << 23;
3678 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3680 Elf64_Xword instruction;
3681 Elf64_Sxword rel_value;
3683 rel_value = value - gp_val;
3684 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3685 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3687 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3688 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3689 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3690 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3691 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3692 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3696 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3698 Elf64_Xword instruction;
3699 Elf64_Sxword rel_value;
3702 entry = allocatePLTEntry(value, oc);
3704 rel_value = (entry >> 4) - (target >> 4);
3705 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3706 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3708 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3709 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3710 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3711 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3717 * PowerPC & X86_64 ELF specifics
3720 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3722 static int ocAllocateSymbolExtras_ELF( ObjectCode *oc )
3728 ehdr = (Elf_Ehdr *) oc->image;
3729 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
3731 for( i = 0; i < ehdr->e_shnum; i++ )
3732 if( shdr[i].sh_type == SHT_SYMTAB )
3735 if( i == ehdr->e_shnum )
3737 errorBelch( "This ELF file contains no symtab" );
3741 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
3743 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
3744 (int) shdr[i].sh_entsize, (int) sizeof( Elf_Sym ) );
3749 return ocAllocateSymbolExtras( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
3752 #endif /* powerpc */
3756 /* --------------------------------------------------------------------------
3758 * ------------------------------------------------------------------------*/
3760 #if defined(OBJFORMAT_MACHO)
3763 Support for MachO linking on Darwin/MacOS X
3764 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3766 I hereby formally apologize for the hackish nature of this code.
3767 Things that need to be done:
3768 *) implement ocVerifyImage_MachO
3769 *) add still more sanity checks.
3772 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
3773 #define mach_header mach_header_64
3774 #define segment_command segment_command_64
3775 #define section section_64
3776 #define nlist nlist_64
3779 #ifdef powerpc_HOST_ARCH
3780 static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
3782 struct mach_header *header = (struct mach_header *) oc->image;
3783 struct load_command *lc = (struct load_command *) (header + 1);
3786 for( i = 0; i < header->ncmds; i++ )
3788 if( lc->cmd == LC_SYMTAB )
3790 // Find out the first and last undefined external
3791 // symbol, so we don't have to allocate too many
3793 struct symtab_command *symLC = (struct symtab_command *) lc;
3794 unsigned min = symLC->nsyms, max = 0;
3795 struct nlist *nlist =
3796 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
3798 for(i=0;i<symLC->nsyms;i++)
3800 if(nlist[i].n_type & N_STAB)
3802 else if(nlist[i].n_type & N_EXT)
3804 if((nlist[i].n_type & N_TYPE) == N_UNDF
3805 && (nlist[i].n_value == 0))
3815 return ocAllocateSymbolExtras(oc, max - min + 1, min);
3820 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3822 return ocAllocateSymbolExtras(oc,0,0);
3825 #ifdef x86_64_HOST_ARCH
3826 static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
3828 struct mach_header *header = (struct mach_header *) oc->image;
3829 struct load_command *lc = (struct load_command *) (header + 1);
3832 for( i = 0; i < header->ncmds; i++ )
3834 if( lc->cmd == LC_SYMTAB )
3836 // Just allocate one entry for every symbol
3837 struct symtab_command *symLC = (struct symtab_command *) lc;
3839 return ocAllocateSymbolExtras(oc, symLC->nsyms, 0);
3842 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3844 return ocAllocateSymbolExtras(oc,0,0);
3848 static int ocVerifyImage_MachO(ObjectCode* oc)
3850 char *image = (char*) oc->image;
3851 struct mach_header *header = (struct mach_header*) image;
3853 #if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
3854 if(header->magic != MH_MAGIC_64)
3857 if(header->magic != MH_MAGIC)
3860 // FIXME: do some more verifying here
3864 static int resolveImports(
3867 struct symtab_command *symLC,
3868 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3869 unsigned long *indirectSyms,
3870 struct nlist *nlist)
3873 size_t itemSize = 4;
3876 int isJumpTable = 0;
3877 if(!strcmp(sect->sectname,"__jump_table"))
3881 ASSERT(sect->reserved2 == itemSize);
3885 for(i=0; i*itemSize < sect->size;i++)
3887 // according to otool, reserved1 contains the first index into the indirect symbol table
3888 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3889 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3892 if((symbol->n_type & N_TYPE) == N_UNDF
3893 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3894 addr = (void*) (symbol->n_value);
3896 addr = lookupSymbol(nm);
3899 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3907 checkProddableBlock(oc,image + sect->offset + i*itemSize);
3908 *(image + sect->offset + i*itemSize) = 0xe9; // jmp
3909 *(unsigned*)(image + sect->offset + i*itemSize + 1)
3910 = (char*)addr - (image + sect->offset + i*itemSize + 5);
3915 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3916 ((void**)(image + sect->offset))[i] = addr;
3923 static unsigned long relocateAddress(
3926 struct section* sections,
3927 unsigned long address)
3930 for(i = 0; i < nSections; i++)
3932 if(sections[i].addr <= address
3933 && address < sections[i].addr + sections[i].size)
3935 return (unsigned long)oc->image
3936 + sections[i].offset + address - sections[i].addr;
3939 barf("Invalid Mach-O file:"
3940 "Address out of bounds while relocating object file");
3944 static int relocateSection(
3947 struct symtab_command *symLC, struct nlist *nlist,
3948 int nSections, struct section* sections, struct section *sect)
3950 struct relocation_info *relocs;
3953 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3955 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3957 else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
3959 else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
3963 relocs = (struct relocation_info*) (image + sect->reloff);
3967 #ifdef x86_64_HOST_ARCH
3968 struct relocation_info *reloc = &relocs[i];
3970 char *thingPtr = image + sect->offset + reloc->r_address;
3974 int type = reloc->r_type;
3976 checkProddableBlock(oc,thingPtr);
3977 switch(reloc->r_length)
3980 thing = *(uint8_t*)thingPtr;
3981 baseValue = (uint64_t)thingPtr + 1;
3984 thing = *(uint16_t*)thingPtr;
3985 baseValue = (uint64_t)thingPtr + 2;
3988 thing = *(uint32_t*)thingPtr;
3989 baseValue = (uint64_t)thingPtr + 4;
3992 thing = *(uint64_t*)thingPtr;
3993 baseValue = (uint64_t)thingPtr + 8;
3996 barf("Unknown size.");
3999 if(type == X86_64_RELOC_GOT
4000 || type == X86_64_RELOC_GOT_LOAD)
4002 ASSERT(reloc->r_extern);
4003 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)->addr;
4005 type = X86_64_RELOC_SIGNED;
4007 else if(reloc->r_extern)
4009 struct nlist *symbol = &nlist[reloc->r_symbolnum];
4010 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4011 if(symbol->n_value == 0)
4012 value = (uint64_t) lookupSymbol(nm);
4014 value = relocateAddress(oc, nSections, sections,
4019 value = sections[reloc->r_symbolnum-1].offset
4020 - sections[reloc->r_symbolnum-1].addr
4024 if(type == X86_64_RELOC_BRANCH)
4026 if((int32_t)(value - baseValue) != (int64_t)(value - baseValue))
4028 ASSERT(reloc->r_extern);
4029 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)
4032 ASSERT((int32_t)(value - baseValue) == (int64_t)(value - baseValue));
4033 type = X86_64_RELOC_SIGNED;
4038 case X86_64_RELOC_UNSIGNED:
4039 ASSERT(!reloc->r_pcrel);
4042 case X86_64_RELOC_SIGNED:
4043 ASSERT(reloc->r_pcrel);
4044 thing += value - baseValue;
4046 case X86_64_RELOC_SUBTRACTOR:
4047 ASSERT(!reloc->r_pcrel);
4051 barf("unkown relocation");
4054 switch(reloc->r_length)
4057 *(uint8_t*)thingPtr = thing;
4060 *(uint16_t*)thingPtr = thing;
4063 *(uint32_t*)thingPtr = thing;
4066 *(uint64_t*)thingPtr = thing;
4070 if(relocs[i].r_address & R_SCATTERED)
4072 struct scattered_relocation_info *scat =
4073 (struct scattered_relocation_info*) &relocs[i];
4077 if(scat->r_length == 2)
4079 unsigned long word = 0;
4080 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
4081 checkProddableBlock(oc,wordPtr);
4083 // Note on relocation types:
4084 // i386 uses the GENERIC_RELOC_* types,
4085 // while ppc uses special PPC_RELOC_* types.
4086 // *_RELOC_VANILLA and *_RELOC_PAIR have the same value
4087 // in both cases, all others are different.
4088 // Therefore, we use GENERIC_RELOC_VANILLA
4089 // and GENERIC_RELOC_PAIR instead of the PPC variants,
4090 // and use #ifdefs for the other types.
4092 // Step 1: Figure out what the relocated value should be
4093 if(scat->r_type == GENERIC_RELOC_VANILLA)
4095 word = *wordPtr + (unsigned long) relocateAddress(
4102 #ifdef powerpc_HOST_ARCH
4103 else if(scat->r_type == PPC_RELOC_SECTDIFF
4104 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
4105 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
4106 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
4108 else if(scat->r_type == GENERIC_RELOC_SECTDIFF)
4111 struct scattered_relocation_info *pair =
4112 (struct scattered_relocation_info*) &relocs[i+1];
4114 if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR)
4115 barf("Invalid Mach-O file: "
4116 "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
4118 word = (unsigned long)
4119 (relocateAddress(oc, nSections, sections, scat->r_value)
4120 - relocateAddress(oc, nSections, sections, pair->r_value));
4123 #ifdef powerpc_HOST_ARCH
4124 else if(scat->r_type == PPC_RELOC_HI16
4125 || scat->r_type == PPC_RELOC_LO16
4126 || scat->r_type == PPC_RELOC_HA16
4127 || scat->r_type == PPC_RELOC_LO14)
4128 { // these are generated by label+offset things
4129 struct relocation_info *pair = &relocs[i+1];
4130 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
4131 barf("Invalid Mach-O file: "
4132 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
4134 if(scat->r_type == PPC_RELOC_LO16)
4136 word = ((unsigned short*) wordPtr)[1];
4137 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4139 else if(scat->r_type == PPC_RELOC_LO14)
4141 barf("Unsupported Relocation: PPC_RELOC_LO14");
4142 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
4143 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4145 else if(scat->r_type == PPC_RELOC_HI16)
4147 word = ((unsigned short*) wordPtr)[1] << 16;
4148 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4150 else if(scat->r_type == PPC_RELOC_HA16)
4152 word = ((unsigned short*) wordPtr)[1] << 16;
4153 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4157 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
4164 continue; // ignore the others
4166 #ifdef powerpc_HOST_ARCH
4167 if(scat->r_type == GENERIC_RELOC_VANILLA
4168 || scat->r_type == PPC_RELOC_SECTDIFF)
4170 if(scat->r_type == GENERIC_RELOC_VANILLA
4171 || scat->r_type == GENERIC_RELOC_SECTDIFF)
4176 #ifdef powerpc_HOST_ARCH
4177 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
4179 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4181 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
4183 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4185 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
4187 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4188 + ((word & (1<<15)) ? 1 : 0);
4194 continue; // FIXME: I hope it's OK to ignore all the others.
4198 struct relocation_info *reloc = &relocs[i];
4199 if(reloc->r_pcrel && !reloc->r_extern)
4202 if(reloc->r_length == 2)
4204 unsigned long word = 0;
4205 #ifdef powerpc_HOST_ARCH
4206 unsigned long jumpIsland = 0;
4207 long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
4208 // to avoid warning and to catch
4212 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
4213 checkProddableBlock(oc,wordPtr);
4215 if(reloc->r_type == GENERIC_RELOC_VANILLA)
4219 #ifdef powerpc_HOST_ARCH
4220 else if(reloc->r_type == PPC_RELOC_LO16)
4222 word = ((unsigned short*) wordPtr)[1];
4223 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4225 else if(reloc->r_type == PPC_RELOC_HI16)
4227 word = ((unsigned short*) wordPtr)[1] << 16;
4228 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4230 else if(reloc->r_type == PPC_RELOC_HA16)
4232 word = ((unsigned short*) wordPtr)[1] << 16;
4233 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4235 else if(reloc->r_type == PPC_RELOC_BR24)
4238 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
4242 if(!reloc->r_extern)
4245 sections[reloc->r_symbolnum-1].offset
4246 - sections[reloc->r_symbolnum-1].addr
4253 struct nlist *symbol = &nlist[reloc->r_symbolnum];
4254 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4255 void *symbolAddress = lookupSymbol(nm);
4258 errorBelch("\nunknown symbol `%s'", nm);
4264 #ifdef powerpc_HOST_ARCH
4265 // In the .o file, this should be a relative jump to NULL
4266 // and we'll change it to a relative jump to the symbol
4267 ASSERT(word + reloc->r_address == 0);
4268 jumpIsland = (unsigned long)
4269 &makeSymbolExtra(oc,
4271 (unsigned long) symbolAddress)
4275 offsetToJumpIsland = word + jumpIsland
4276 - (((long)image) + sect->offset - sect->addr);
4279 word += (unsigned long) symbolAddress
4280 - (((long)image) + sect->offset - sect->addr);
4284 word += (unsigned long) symbolAddress;
4288 if(reloc->r_type == GENERIC_RELOC_VANILLA)
4293 #ifdef powerpc_HOST_ARCH
4294 else if(reloc->r_type == PPC_RELOC_LO16)
4296 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4299 else if(reloc->r_type == PPC_RELOC_HI16)
4301 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4304 else if(reloc->r_type == PPC_RELOC_HA16)
4306 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4307 + ((word & (1<<15)) ? 1 : 0);
4310 else if(reloc->r_type == PPC_RELOC_BR24)
4312 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4314 // The branch offset is too large.
4315 // Therefore, we try to use a jump island.
4318 barf("unconditional relative branch out of range: "
4319 "no jump island available");
4322 word = offsetToJumpIsland;
4323 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4324 barf("unconditional relative branch out of range: "
4325 "jump island out of range");
4327 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
4332 barf("\nunknown relocation %d",reloc->r_type);
4340 static int ocGetNames_MachO(ObjectCode* oc)
4342 char *image = (char*) oc->image;
4343 struct mach_header *header = (struct mach_header*) image;
4344 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4345 unsigned i,curSymbol = 0;
4346 struct segment_command *segLC = NULL;
4347 struct section *sections;
4348 struct symtab_command *symLC = NULL;
4349 struct nlist *nlist;
4350 unsigned long commonSize = 0;
4351 char *commonStorage = NULL;
4352 unsigned long commonCounter;
4354 for(i=0;i<header->ncmds;i++)
4356 if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
4357 segLC = (struct segment_command*) lc;
4358 else if(lc->cmd == LC_SYMTAB)
4359 symLC = (struct symtab_command*) lc;
4360 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4363 sections = (struct section*) (segLC+1);
4364 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4368 barf("ocGetNames_MachO: no segment load command");
4370 for(i=0;i<segLC->nsects;i++)
4372 if(sections[i].size == 0)
4375 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
4377 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
4378 "ocGetNames_MachO(common symbols)");
4379 sections[i].offset = zeroFillArea - image;
4382 if(!strcmp(sections[i].sectname,"__text"))
4383 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
4384 (void*) (image + sections[i].offset),
4385 (void*) (image + sections[i].offset + sections[i].size));
4386 else if(!strcmp(sections[i].sectname,"__const"))
4387 addSection(oc, SECTIONKIND_RWDATA,
4388 (void*) (image + sections[i].offset),
4389 (void*) (image + sections[i].offset + sections[i].size));
4390 else if(!strcmp(sections[i].sectname,"__data"))
4391 addSection(oc, SECTIONKIND_RWDATA,
4392 (void*) (image + sections[i].offset),
4393 (void*) (image + sections[i].offset + sections[i].size));
4394 else if(!strcmp(sections[i].sectname,"__bss")
4395 || !strcmp(sections[i].sectname,"__common"))
4396 addSection(oc, SECTIONKIND_RWDATA,
4397 (void*) (image + sections[i].offset),
4398 (void*) (image + sections[i].offset + sections[i].size));
4400 addProddableBlock(oc, (void*) (image + sections[i].offset),
4404 // count external symbols defined here
4408 for(i=0;i<symLC->nsyms;i++)
4410 if(nlist[i].n_type & N_STAB)
4412 else if(nlist[i].n_type & N_EXT)
4414 if((nlist[i].n_type & N_TYPE) == N_UNDF
4415 && (nlist[i].n_value != 0))
4417 commonSize += nlist[i].n_value;
4420 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4425 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
4426 "ocGetNames_MachO(oc->symbols)");
4430 for(i=0;i<symLC->nsyms;i++)
4432 if(nlist[i].n_type & N_STAB)
4434 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4436 if(nlist[i].n_type & N_EXT)
4438 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4439 if((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm))
4440 ; // weak definition, and we already have a definition
4443 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4445 + sections[nlist[i].n_sect-1].offset
4446 - sections[nlist[i].n_sect-1].addr
4447 + nlist[i].n_value);
4448 oc->symbols[curSymbol++] = nm;
4455 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
4456 commonCounter = (unsigned long)commonStorage;
4459 for(i=0;i<symLC->nsyms;i++)
4461 if((nlist[i].n_type & N_TYPE) == N_UNDF
4462 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
4464 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4465 unsigned long sz = nlist[i].n_value;
4467 nlist[i].n_value = commonCounter;
4469 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4470 (void*)commonCounter);
4471 oc->symbols[curSymbol++] = nm;
4473 commonCounter += sz;
4480 static int ocResolve_MachO(ObjectCode* oc)
4482 char *image = (char*) oc->image;
4483 struct mach_header *header = (struct mach_header*) image;
4484 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4486 struct segment_command *segLC = NULL;
4487 struct section *sections;
4488 struct symtab_command *symLC = NULL;
4489 struct dysymtab_command *dsymLC = NULL;
4490 struct nlist *nlist;
4492 for(i=0;i<header->ncmds;i++)
4494 if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
4495 segLC = (struct segment_command*) lc;
4496 else if(lc->cmd == LC_SYMTAB)
4497 symLC = (struct symtab_command*) lc;
4498 else if(lc->cmd == LC_DYSYMTAB)
4499 dsymLC = (struct dysymtab_command*) lc;
4500 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4503 sections = (struct section*) (segLC+1);
4504 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4509 unsigned long *indirectSyms
4510 = (unsigned long*) (image + dsymLC->indirectsymoff);
4512 for(i=0;i<segLC->nsects;i++)
4514 if( !strcmp(sections[i].sectname,"__la_symbol_ptr")
4515 || !strcmp(sections[i].sectname,"__la_sym_ptr2")
4516 || !strcmp(sections[i].sectname,"__la_sym_ptr3"))
4518 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
4521 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr")
4522 || !strcmp(sections[i].sectname,"__pointers"))
4524 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
4527 else if(!strcmp(sections[i].sectname,"__jump_table"))
4529 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
4535 for(i=0;i<segLC->nsects;i++)
4537 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
4541 #if defined (powerpc_HOST_ARCH)
4542 ocFlushInstructionCache( oc );
4548 #ifdef powerpc_HOST_ARCH
4550 * The Mach-O object format uses leading underscores. But not everywhere.
4551 * There is a small number of runtime support functions defined in
4552 * libcc_dynamic.a whose name does not have a leading underscore.
4553 * As a consequence, we can't get their address from C code.
4554 * We have to use inline assembler just to take the address of a function.
4558 static void machoInitSymbolsWithoutUnderscore()
4560 extern void* symbolsWithoutUnderscore[];
4561 void **p = symbolsWithoutUnderscore;
4562 __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
4566 __asm__ volatile(".long " # x);
4568 RTS_MACHO_NOUNDERLINE_SYMBOLS
4570 __asm__ volatile(".text");
4574 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
4576 RTS_MACHO_NOUNDERLINE_SYMBOLS
4583 * Figure out by how much to shift the entire Mach-O file in memory
4584 * when loading so that its single segment ends up 16-byte-aligned
4586 static int machoGetMisalignment( FILE * f )
4588 struct mach_header header;
4591 fread(&header, sizeof(header), 1, f);
4594 #if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
4595 if(header.magic != MH_MAGIC_64)
4598 if(header.magic != MH_MAGIC)
4602 misalignment = (header.sizeofcmds + sizeof(header))
4605 return misalignment ? (16 - misalignment) : 0;