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"
31 #ifdef HAVE_SYS_TYPES_H
32 #include <sys/types.h>
38 #ifdef HAVE_SYS_STAT_H
42 #if defined(HAVE_DLFCN_H)
46 #if defined(cygwin32_HOST_OS)
51 #ifdef HAVE_SYS_TIME_H
55 #include <sys/fcntl.h>
56 #include <sys/termios.h>
57 #include <sys/utime.h>
58 #include <sys/utsname.h>
62 #if defined(ia64_HOST_ARCH) || defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
67 #if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
75 #if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
76 # define OBJFORMAT_ELF
77 #elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
78 # define OBJFORMAT_PEi386
81 #elif defined(darwin_HOST_OS)
82 # define OBJFORMAT_MACHO
83 # include <mach-o/loader.h>
84 # include <mach-o/nlist.h>
85 # include <mach-o/reloc.h>
86 # include <mach-o/dyld.h>
87 #if defined(powerpc_HOST_ARCH)
88 # include <mach-o/ppc/reloc.h>
92 /* Hash table mapping symbol names to Symbol */
93 static /*Str*/HashTable *symhash;
95 /* List of currently loaded objects */
96 ObjectCode *objects = NULL; /* initially empty */
98 #if defined(OBJFORMAT_ELF)
99 static int ocVerifyImage_ELF ( ObjectCode* oc );
100 static int ocGetNames_ELF ( ObjectCode* oc );
101 static int ocResolve_ELF ( ObjectCode* oc );
102 #if defined(powerpc_HOST_ARCH)
103 static int ocAllocateJumpIslands_ELF ( ObjectCode* oc );
105 #elif defined(OBJFORMAT_PEi386)
106 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
107 static int ocGetNames_PEi386 ( ObjectCode* oc );
108 static int ocResolve_PEi386 ( ObjectCode* oc );
109 #elif defined(OBJFORMAT_MACHO)
110 static int ocVerifyImage_MachO ( ObjectCode* oc );
111 static int ocGetNames_MachO ( ObjectCode* oc );
112 static int ocResolve_MachO ( ObjectCode* oc );
114 static int machoGetMisalignment( FILE * );
115 #ifdef powerpc_HOST_ARCH
116 static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
117 static void machoInitSymbolsWithoutUnderscore( void );
121 #if defined(x86_64_HOST_ARCH)
122 static void*x86_64_high_symbol( char *lbl, void *addr );
125 /* -----------------------------------------------------------------------------
126 * Built-in symbols from the RTS
129 typedef struct _RtsSymbolVal {
136 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
137 SymX(makeStableNamezh_fast) \
138 SymX(finalizzeWeakzh_fast)
140 /* These are not available in GUM!!! -- HWL */
141 #define Maybe_Stable_Names
144 #if !defined (mingw32_HOST_OS)
145 #define RTS_POSIX_ONLY_SYMBOLS \
146 SymX(signal_handlers) \
147 SymX(stg_sig_install) \
151 #if defined (cygwin32_HOST_OS)
152 #define RTS_MINGW_ONLY_SYMBOLS /**/
153 /* Don't have the ability to read import libs / archives, so
154 * we have to stupidly list a lot of what libcygwin.a
157 #define RTS_CYGWIN_ONLY_SYMBOLS \
235 #elif !defined(mingw32_HOST_OS)
236 #define RTS_MINGW_ONLY_SYMBOLS /**/
237 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
238 #else /* defined(mingw32_HOST_OS) */
239 #define RTS_POSIX_ONLY_SYMBOLS /**/
240 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
242 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
244 #define RTS_MINGW_EXTRA_SYMS \
245 Sym(_imp____mb_cur_max) \
248 #define RTS_MINGW_EXTRA_SYMS
251 /* These are statically linked from the mingw libraries into the ghc
252 executable, so we have to employ this hack. */
253 #define RTS_MINGW_ONLY_SYMBOLS \
254 SymX(asyncReadzh_fast) \
255 SymX(asyncWritezh_fast) \
256 SymX(asyncDoProczh_fast) \
268 SymX(getservbyname) \
269 SymX(getservbyport) \
270 SymX(getprotobynumber) \
271 SymX(getprotobyname) \
272 SymX(gethostbyname) \
273 SymX(gethostbyaddr) \
320 SymX(rts_InstallConsoleEvent) \
321 SymX(rts_ConsoleHandlerDone) \
323 Sym(_imp___timezone) \
332 RTS_MINGW_EXTRA_SYMS \
336 #if defined(darwin_TARGET_OS) && HAVE_PRINTF_LDBLSTUB
337 #define RTS_DARWIN_ONLY_SYMBOLS \
338 Sym(asprintf$LDBLStub) \
342 Sym(fprintf$LDBLStub) \
343 Sym(fscanf$LDBLStub) \
344 Sym(fwprintf$LDBLStub) \
345 Sym(fwscanf$LDBLStub) \
346 Sym(printf$LDBLStub) \
347 Sym(scanf$LDBLStub) \
348 Sym(snprintf$LDBLStub) \
349 Sym(sprintf$LDBLStub) \
350 Sym(sscanf$LDBLStub) \
351 Sym(strtold$LDBLStub) \
352 Sym(swprintf$LDBLStub) \
353 Sym(swscanf$LDBLStub) \
354 Sym(syslog$LDBLStub) \
355 Sym(vasprintf$LDBLStub) \
357 Sym(verrc$LDBLStub) \
358 Sym(verrx$LDBLStub) \
359 Sym(vfprintf$LDBLStub) \
360 Sym(vfscanf$LDBLStub) \
361 Sym(vfwprintf$LDBLStub) \
362 Sym(vfwscanf$LDBLStub) \
363 Sym(vprintf$LDBLStub) \
364 Sym(vscanf$LDBLStub) \
365 Sym(vsnprintf$LDBLStub) \
366 Sym(vsprintf$LDBLStub) \
367 Sym(vsscanf$LDBLStub) \
368 Sym(vswprintf$LDBLStub) \
369 Sym(vswscanf$LDBLStub) \
370 Sym(vsyslog$LDBLStub) \
371 Sym(vwarn$LDBLStub) \
372 Sym(vwarnc$LDBLStub) \
373 Sym(vwarnx$LDBLStub) \
374 Sym(vwprintf$LDBLStub) \
375 Sym(vwscanf$LDBLStub) \
377 Sym(warnc$LDBLStub) \
378 Sym(warnx$LDBLStub) \
379 Sym(wcstold$LDBLStub) \
380 Sym(wprintf$LDBLStub) \
383 #define RTS_DARWIN_ONLY_SYMBOLS
387 # define MAIN_CAP_SYM SymX(MainCapability)
389 # define MAIN_CAP_SYM
392 #if !defined(mingw32_HOST_OS)
393 #define RTS_USER_SIGNALS_SYMBOLS \
394 SymX(setIOManagerPipe)
396 #define RTS_USER_SIGNALS_SYMBOLS /* nothing */
399 #ifdef TABLES_NEXT_TO_CODE
400 #define RTS_RET_SYMBOLS /* nothing */
402 #define RTS_RET_SYMBOLS \
403 SymX(stg_enter_ret) \
404 SymX(stg_gc_fun_ret) \
411 SymX(stg_ap_pv_ret) \
412 SymX(stg_ap_pp_ret) \
413 SymX(stg_ap_ppv_ret) \
414 SymX(stg_ap_ppp_ret) \
415 SymX(stg_ap_pppv_ret) \
416 SymX(stg_ap_pppp_ret) \
417 SymX(stg_ap_ppppp_ret) \
418 SymX(stg_ap_pppppp_ret)
421 #define RTS_SYMBOLS \
424 SymX(stg_enter_info) \
425 SymX(stg_gc_void_info) \
426 SymX(__stg_gc_enter_1) \
427 SymX(stg_gc_noregs) \
428 SymX(stg_gc_unpt_r1_info) \
429 SymX(stg_gc_unpt_r1) \
430 SymX(stg_gc_unbx_r1_info) \
431 SymX(stg_gc_unbx_r1) \
432 SymX(stg_gc_f1_info) \
434 SymX(stg_gc_d1_info) \
436 SymX(stg_gc_l1_info) \
439 SymX(stg_gc_fun_info) \
441 SymX(stg_gc_gen_info) \
442 SymX(stg_gc_gen_hp) \
444 SymX(stg_gen_yield) \
445 SymX(stg_yield_noregs) \
446 SymX(stg_yield_to_interpreter) \
447 SymX(stg_gen_block) \
448 SymX(stg_block_noregs) \
450 SymX(stg_block_takemvar) \
451 SymX(stg_block_putmvar) \
452 SymX(stg_seq_frame_info) \
454 SymX(MallocFailHook) \
456 SymX(OutOfHeapHook) \
457 SymX(StackOverflowHook) \
458 SymX(__encodeDouble) \
459 SymX(__encodeFloat) \
463 SymX(__gmpz_cmp_si) \
464 SymX(__gmpz_cmp_ui) \
465 SymX(__gmpz_get_si) \
466 SymX(__gmpz_get_ui) \
467 SymX(__int_encodeDouble) \
468 SymX(__int_encodeFloat) \
469 SymX(andIntegerzh_fast) \
470 SymX(atomicallyzh_fast) \
474 SymX(blockAsyncExceptionszh_fast) \
476 SymX(catchRetryzh_fast) \
477 SymX(catchSTMzh_fast) \
478 SymX(closure_flags) \
480 SymX(cmpIntegerzh_fast) \
481 SymX(cmpIntegerIntzh_fast) \
482 SymX(complementIntegerzh_fast) \
483 SymX(createAdjustor) \
484 SymX(decodeDoublezh_fast) \
485 SymX(decodeFloatzh_fast) \
488 SymX(deRefWeakzh_fast) \
489 SymX(deRefStablePtrzh_fast) \
490 SymX(dirty_MUT_VAR) \
491 SymX(divExactIntegerzh_fast) \
492 SymX(divModIntegerzh_fast) \
494 SymX(forkOnzh_fast) \
496 SymX(forkOS_createThread) \
497 SymX(freeHaskellFunctionPtr) \
498 SymX(freeStablePtr) \
499 SymX(gcdIntegerzh_fast) \
500 SymX(gcdIntegerIntzh_fast) \
501 SymX(gcdIntzh_fast) \
510 SymX(hs_perform_gc) \
511 SymX(hs_free_stable_ptr) \
512 SymX(hs_free_fun_ptr) \
514 SymX(int2Integerzh_fast) \
515 SymX(integer2Intzh_fast) \
516 SymX(integer2Wordzh_fast) \
517 SymX(isCurrentThreadBoundzh_fast) \
518 SymX(isDoubleDenormalized) \
519 SymX(isDoubleInfinite) \
521 SymX(isDoubleNegativeZero) \
522 SymX(isEmptyMVarzh_fast) \
523 SymX(isFloatDenormalized) \
524 SymX(isFloatInfinite) \
526 SymX(isFloatNegativeZero) \
527 SymX(killThreadzh_fast) \
530 SymX(makeStablePtrzh_fast) \
531 SymX(minusIntegerzh_fast) \
532 SymX(mkApUpd0zh_fast) \
533 SymX(myThreadIdzh_fast) \
534 SymX(labelThreadzh_fast) \
535 SymX(newArrayzh_fast) \
536 SymX(newBCOzh_fast) \
537 SymX(newByteArrayzh_fast) \
538 SymX_redirect(newCAF, newDynCAF) \
539 SymX(newMVarzh_fast) \
540 SymX(newMutVarzh_fast) \
541 SymX(newTVarzh_fast) \
542 SymX(atomicModifyMutVarzh_fast) \
543 SymX(newPinnedByteArrayzh_fast) \
545 SymX(orIntegerzh_fast) \
547 SymX(performMajorGC) \
548 SymX(plusIntegerzh_fast) \
551 SymX(putMVarzh_fast) \
552 SymX(quotIntegerzh_fast) \
553 SymX(quotRemIntegerzh_fast) \
555 SymX(raiseIOzh_fast) \
556 SymX(readTVarzh_fast) \
557 SymX(remIntegerzh_fast) \
558 SymX(resetNonBlockingFd) \
563 SymX(rts_checkSchedStatus) \
566 SymX(rts_evalLazyIO) \
567 SymX(rts_evalStableIO) \
571 SymX(rts_getDouble) \
576 SymX(rts_getFunPtr) \
577 SymX(rts_getStablePtr) \
578 SymX(rts_getThreadId) \
580 SymX(rts_getWord32) \
593 SymX(rts_mkStablePtr) \
601 SymX(rtsSupportsBoundThreads) \
602 SymX(__hscore_get_saved_termios) \
603 SymX(__hscore_set_saved_termios) \
605 SymX(startupHaskell) \
606 SymX(shutdownHaskell) \
607 SymX(shutdownHaskellAndExit) \
608 SymX(stable_ptr_table) \
609 SymX(stackOverflow) \
610 SymX(stg_CAF_BLACKHOLE_info) \
611 SymX(awakenBlockedQueue) \
612 SymX(stg_CHARLIKE_closure) \
613 SymX(stg_EMPTY_MVAR_info) \
614 SymX(stg_IND_STATIC_info) \
615 SymX(stg_INTLIKE_closure) \
616 SymX(stg_MUT_ARR_PTRS_DIRTY_info) \
617 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
618 SymX(stg_MUT_ARR_PTRS_FROZEN0_info) \
619 SymX(stg_WEAK_info) \
620 SymX(stg_ap_v_info) \
621 SymX(stg_ap_f_info) \
622 SymX(stg_ap_d_info) \
623 SymX(stg_ap_l_info) \
624 SymX(stg_ap_n_info) \
625 SymX(stg_ap_p_info) \
626 SymX(stg_ap_pv_info) \
627 SymX(stg_ap_pp_info) \
628 SymX(stg_ap_ppv_info) \
629 SymX(stg_ap_ppp_info) \
630 SymX(stg_ap_pppv_info) \
631 SymX(stg_ap_pppp_info) \
632 SymX(stg_ap_ppppp_info) \
633 SymX(stg_ap_pppppp_info) \
634 SymX(stg_ap_0_fast) \
635 SymX(stg_ap_v_fast) \
636 SymX(stg_ap_f_fast) \
637 SymX(stg_ap_d_fast) \
638 SymX(stg_ap_l_fast) \
639 SymX(stg_ap_n_fast) \
640 SymX(stg_ap_p_fast) \
641 SymX(stg_ap_pv_fast) \
642 SymX(stg_ap_pp_fast) \
643 SymX(stg_ap_ppv_fast) \
644 SymX(stg_ap_ppp_fast) \
645 SymX(stg_ap_pppv_fast) \
646 SymX(stg_ap_pppp_fast) \
647 SymX(stg_ap_ppppp_fast) \
648 SymX(stg_ap_pppppp_fast) \
649 SymX(stg_ap_1_upd_info) \
650 SymX(stg_ap_2_upd_info) \
651 SymX(stg_ap_3_upd_info) \
652 SymX(stg_ap_4_upd_info) \
653 SymX(stg_ap_5_upd_info) \
654 SymX(stg_ap_6_upd_info) \
655 SymX(stg_ap_7_upd_info) \
657 SymX(stg_sel_0_upd_info) \
658 SymX(stg_sel_10_upd_info) \
659 SymX(stg_sel_11_upd_info) \
660 SymX(stg_sel_12_upd_info) \
661 SymX(stg_sel_13_upd_info) \
662 SymX(stg_sel_14_upd_info) \
663 SymX(stg_sel_15_upd_info) \
664 SymX(stg_sel_1_upd_info) \
665 SymX(stg_sel_2_upd_info) \
666 SymX(stg_sel_3_upd_info) \
667 SymX(stg_sel_4_upd_info) \
668 SymX(stg_sel_5_upd_info) \
669 SymX(stg_sel_6_upd_info) \
670 SymX(stg_sel_7_upd_info) \
671 SymX(stg_sel_8_upd_info) \
672 SymX(stg_sel_9_upd_info) \
673 SymX(stg_upd_frame_info) \
674 SymX(suspendThread) \
675 SymX(takeMVarzh_fast) \
676 SymX(timesIntegerzh_fast) \
677 SymX(tryPutMVarzh_fast) \
678 SymX(tryTakeMVarzh_fast) \
679 SymX(unblockAsyncExceptionszh_fast) \
681 SymX(unsafeThawArrayzh_fast) \
682 SymX(waitReadzh_fast) \
683 SymX(waitWritezh_fast) \
684 SymX(word2Integerzh_fast) \
685 SymX(writeTVarzh_fast) \
686 SymX(xorIntegerzh_fast) \
688 SymX(stg_interp_constr_entry) \
689 SymX(stg_interp_constr1_entry) \
690 SymX(stg_interp_constr2_entry) \
691 SymX(stg_interp_constr3_entry) \
692 SymX(stg_interp_constr4_entry) \
693 SymX(stg_interp_constr5_entry) \
694 SymX(stg_interp_constr6_entry) \
695 SymX(stg_interp_constr7_entry) \
696 SymX(stg_interp_constr8_entry) \
697 SymX(stgMallocBytesRWX) \
698 SymX(getAllocations) \
701 RTS_USER_SIGNALS_SYMBOLS
703 #ifdef SUPPORT_LONG_LONGS
704 #define RTS_LONG_LONG_SYMS \
705 SymX(int64ToIntegerzh_fast) \
706 SymX(word64ToIntegerzh_fast)
708 #define RTS_LONG_LONG_SYMS /* nothing */
711 // 64-bit support functions in libgcc.a
712 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
713 #define RTS_LIBGCC_SYMBOLS \
723 #elif defined(ia64_HOST_ARCH)
724 #define RTS_LIBGCC_SYMBOLS \
732 #define RTS_LIBGCC_SYMBOLS
735 #if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
736 // Symbols that don't have a leading underscore
737 // on Mac OS X. They have to receive special treatment,
738 // see machoInitSymbolsWithoutUnderscore()
739 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
744 /* entirely bogus claims about types of these symbols */
745 #define Sym(vvv) extern void vvv(void);
746 #define SymX(vvv) /**/
747 #define SymX_redirect(vvv,xxx) /**/
751 RTS_POSIX_ONLY_SYMBOLS
752 RTS_MINGW_ONLY_SYMBOLS
753 RTS_CYGWIN_ONLY_SYMBOLS
754 RTS_DARWIN_ONLY_SYMBOLS
760 #ifdef LEADING_UNDERSCORE
761 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
763 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
766 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
768 #define SymX(vvv) Sym(vvv)
770 // SymX_redirect allows us to redirect references to one symbol to
771 // another symbol. See newCAF/newDynCAF for an example.
772 #define SymX_redirect(vvv,xxx) \
773 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
776 static RtsSymbolVal rtsSyms[] = {
780 RTS_POSIX_ONLY_SYMBOLS
781 RTS_MINGW_ONLY_SYMBOLS
782 RTS_CYGWIN_ONLY_SYMBOLS
784 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
785 // dyld stub code contains references to this,
786 // but it should never be called because we treat
787 // lazy pointers as nonlazy.
788 { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
790 { 0, 0 } /* sentinel */
793 /* -----------------------------------------------------------------------------
794 * Insert symbols into hash tables, checking for duplicates.
796 static void ghciInsertStrHashTable ( char* obj_name,
802 if (lookupHashTable(table, (StgWord)key) == NULL)
804 insertStrHashTable(table, (StgWord)key, data);
809 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
811 "whilst processing object file\n"
813 "This could be caused by:\n"
814 " * Loading two different object files which export the same symbol\n"
815 " * Specifying the same object file twice on the GHCi command line\n"
816 " * An incorrect `package.conf' entry, causing some object to be\n"
818 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
827 /* -----------------------------------------------------------------------------
828 * initialize the object linker
832 static int linker_init_done = 0 ;
834 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
835 static void *dl_prog_handle;
838 /* dlopen(NULL,..) doesn't work so we grab libc explicitly */
839 #if defined(openbsd_HOST_OS)
840 static void *dl_libc_handle;
848 /* Make initLinker idempotent, so we can call it
849 before evey relevant operation; that means we
850 don't need to initialise the linker separately */
851 if (linker_init_done == 1) { return; } else {
852 linker_init_done = 1;
855 symhash = allocStrHashTable();
857 /* populate the symbol table with stuff from the RTS */
858 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
859 ghciInsertStrHashTable("(GHCi built-in symbols)",
860 symhash, sym->lbl, sym->addr);
862 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
863 machoInitSymbolsWithoutUnderscore();
866 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
867 # if defined(RTLD_DEFAULT)
868 dl_prog_handle = RTLD_DEFAULT;
870 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
871 # if defined(openbsd_HOST_OS)
872 dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
874 # endif /* RTLD_DEFAULT */
878 /* -----------------------------------------------------------------------------
879 * Loading DLL or .so dynamic libraries
880 * -----------------------------------------------------------------------------
882 * Add a DLL from which symbols may be found. In the ELF case, just
883 * do RTLD_GLOBAL-style add, so no further messing around needs to
884 * happen in order that symbols in the loaded .so are findable --
885 * lookupSymbol() will subsequently see them by dlsym on the program's
886 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
888 * In the PEi386 case, open the DLLs and put handles to them in a
889 * linked list. When looking for a symbol, try all handles in the
890 * list. This means that we need to load even DLLs that are guaranteed
891 * to be in the ghc.exe image already, just so we can get a handle
892 * to give to loadSymbol, so that we can find the symbols. For such
893 * libraries, the LoadLibrary call should be a no-op except for returning
898 #if defined(OBJFORMAT_PEi386)
899 /* A record for storing handles into DLLs. */
904 struct _OpenedDLL* next;
909 /* A list thereof. */
910 static OpenedDLL* opened_dlls = NULL;
914 addDLL( char *dll_name )
916 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
917 /* ------------------- ELF DLL loader ------------------- */
923 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
926 /* dlopen failed; return a ptr to the error msg. */
928 if (errmsg == NULL) errmsg = "addDLL: unknown error";
935 # elif defined(OBJFORMAT_PEi386)
936 /* ------------------- Win32 DLL loader ------------------- */
944 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
946 /* See if we've already got it, and ignore if so. */
947 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
948 if (0 == strcmp(o_dll->name, dll_name))
952 /* The file name has no suffix (yet) so that we can try
953 both foo.dll and foo.drv
955 The documentation for LoadLibrary says:
956 If no file name extension is specified in the lpFileName
957 parameter, the default library extension .dll is
958 appended. However, the file name string can include a trailing
959 point character (.) to indicate that the module name has no
962 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
963 sprintf(buf, "%s.DLL", dll_name);
964 instance = LoadLibrary(buf);
965 if (instance == NULL) {
966 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
967 instance = LoadLibrary(buf);
968 if (instance == NULL) {
971 /* LoadLibrary failed; return a ptr to the error msg. */
972 return "addDLL: unknown error";
977 /* Add this DLL to the list of DLLs in which to search for symbols. */
978 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
979 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
980 strcpy(o_dll->name, dll_name);
981 o_dll->instance = instance;
982 o_dll->next = opened_dlls;
987 barf("addDLL: not implemented on this platform");
991 /* -----------------------------------------------------------------------------
992 * lookup a symbol in the hash table
995 lookupSymbol( char *lbl )
999 ASSERT(symhash != NULL);
1000 val = lookupStrHashTable(symhash, lbl);
1003 # if defined(OBJFORMAT_ELF)
1004 # if defined(openbsd_HOST_OS)
1005 val = dlsym(dl_prog_handle, lbl);
1006 return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
1007 # elif defined(x86_64_HOST_ARCH)
1008 val = dlsym(dl_prog_handle, lbl);
1009 if (val >= (void *)0x80000000) {
1011 new_val = x86_64_high_symbol(lbl, val);
1012 IF_DEBUG(linker,debugBelch("lookupSymbol: relocating out of range symbol: %s = %p, now %p\n", lbl, val, new_val));
1017 # else /* not openbsd */
1018 return dlsym(dl_prog_handle, lbl);
1020 # elif defined(OBJFORMAT_MACHO)
1021 if(NSIsSymbolNameDefined(lbl)) {
1022 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
1023 return NSAddressOfSymbol(symbol);
1027 # elif defined(OBJFORMAT_PEi386)
1030 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1031 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
1032 if (lbl[0] == '_') {
1033 /* HACK: if the name has an initial underscore, try stripping
1034 it off & look that up first. I've yet to verify whether there's
1035 a Rule that governs whether an initial '_' *should always* be
1036 stripped off when mapping from import lib name to the DLL name.
1038 sym = GetProcAddress(o_dll->instance, (lbl+1));
1040 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
1044 sym = GetProcAddress(o_dll->instance, lbl);
1046 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
1061 __attribute((unused))
1063 lookupLocalSymbol( ObjectCode* oc, char *lbl )
1067 val = lookupStrHashTable(oc->lochash, lbl);
1077 /* -----------------------------------------------------------------------------
1078 * Debugging aid: look in GHCi's object symbol tables for symbols
1079 * within DELTA bytes of the specified address, and show their names.
1082 void ghci_enquire ( char* addr );
1084 void ghci_enquire ( char* addr )
1089 const int DELTA = 64;
1094 for (oc = objects; oc; oc = oc->next) {
1095 for (i = 0; i < oc->n_symbols; i++) {
1096 sym = oc->symbols[i];
1097 if (sym == NULL) continue;
1098 // debugBelch("enquire %p %p\n", sym, oc->lochash);
1100 if (oc->lochash != NULL) {
1101 a = lookupStrHashTable(oc->lochash, sym);
1104 a = lookupStrHashTable(symhash, sym);
1107 // debugBelch("ghci_enquire: can't find %s\n", sym);
1109 else if (addr-DELTA <= a && a <= addr+DELTA) {
1110 debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym);
1117 #ifdef ia64_HOST_ARCH
1118 static unsigned int PLTSize(void);
1121 /* -----------------------------------------------------------------------------
1122 * Load an obj (populate the global symbol table, but don't resolve yet)
1124 * Returns: 1 if ok, 0 on error.
1127 loadObj( char *path )
1134 void *map_addr = NULL;
1141 /* debugBelch("loadObj %s\n", path ); */
1143 /* Check that we haven't already loaded this object.
1144 Ignore requests to load multiple times */
1148 for (o = objects; o; o = o->next) {
1149 if (0 == strcmp(o->fileName, path)) {
1151 break; /* don't need to search further */
1155 IF_DEBUG(linker, debugBelch(
1156 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1157 "same object file twice:\n"
1159 "GHCi will ignore this, but be warned.\n"
1161 return 1; /* success */
1165 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1167 # if defined(OBJFORMAT_ELF)
1168 oc->formatName = "ELF";
1169 # elif defined(OBJFORMAT_PEi386)
1170 oc->formatName = "PEi386";
1171 # elif defined(OBJFORMAT_MACHO)
1172 oc->formatName = "Mach-O";
1175 barf("loadObj: not implemented on this platform");
1178 r = stat(path, &st);
1179 if (r == -1) { return 0; }
1181 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1182 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1183 strcpy(oc->fileName, path);
1185 oc->fileSize = st.st_size;
1187 oc->sections = NULL;
1188 oc->lochash = allocStrHashTable();
1189 oc->proddables = NULL;
1191 /* chain it onto the list of objects */
1196 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1198 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1200 #if defined(openbsd_HOST_OS)
1201 fd = open(path, O_RDONLY, S_IRUSR);
1203 fd = open(path, O_RDONLY);
1206 barf("loadObj: can't open `%s'", path);
1208 pagesize = getpagesize();
1210 #ifdef ia64_HOST_ARCH
1211 /* The PLT needs to be right before the object */
1212 n = ROUND_UP(PLTSize(), pagesize);
1213 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1214 if (oc->plt == MAP_FAILED)
1215 barf("loadObj: can't allocate PLT");
1218 map_addr = oc->plt + n;
1221 n = ROUND_UP(oc->fileSize, pagesize);
1223 /* Link objects into the lower 2Gb on x86_64. GHC assumes the
1224 * small memory model on this architecture (see gcc docs,
1227 #ifdef x86_64_HOST_ARCH
1228 #define EXTRA_MAP_FLAGS MAP_32BIT
1230 #define EXTRA_MAP_FLAGS 0
1233 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE,
1234 MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
1235 if (oc->image == MAP_FAILED)
1236 barf("loadObj: can't map `%s'", path);
1240 #else /* !USE_MMAP */
1242 /* load the image into memory */
1243 f = fopen(path, "rb");
1245 barf("loadObj: can't read `%s'", path);
1247 #ifdef darwin_HOST_OS
1248 // In a Mach-O .o file, all sections can and will be misaligned
1249 // if the total size of the headers is not a multiple of the
1250 // desired alignment. This is fine for .o files that only serve
1251 // as input for the static linker, but it's not fine for us,
1252 // as SSE (used by gcc for floating point) and Altivec require
1253 // 16-byte alignment.
1254 // We calculate the correct alignment from the header before
1255 // reading the file, and then we misalign oc->image on purpose so
1256 // that the actual sections end up aligned again.
1257 misalignment = machoGetMisalignment(f);
1258 oc->misalignment = misalignment;
1263 oc->image = stgMallocBytes(oc->fileSize + misalignment, "loadObj(image)");
1264 oc->image += misalignment;
1266 n = fread ( oc->image, 1, oc->fileSize, f );
1267 if (n != oc->fileSize)
1268 barf("loadObj: error whilst reading `%s'", path);
1272 #endif /* USE_MMAP */
1274 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
1275 r = ocAllocateJumpIslands_MachO ( oc );
1276 if (!r) { return r; }
1277 # elif defined(OBJFORMAT_ELF) && defined(powerpc_HOST_ARCH)
1278 r = ocAllocateJumpIslands_ELF ( oc );
1279 if (!r) { return r; }
1282 /* verify the in-memory image */
1283 # if defined(OBJFORMAT_ELF)
1284 r = ocVerifyImage_ELF ( oc );
1285 # elif defined(OBJFORMAT_PEi386)
1286 r = ocVerifyImage_PEi386 ( oc );
1287 # elif defined(OBJFORMAT_MACHO)
1288 r = ocVerifyImage_MachO ( oc );
1290 barf("loadObj: no verify method");
1292 if (!r) { return r; }
1294 /* build the symbol list for this image */
1295 # if defined(OBJFORMAT_ELF)
1296 r = ocGetNames_ELF ( oc );
1297 # elif defined(OBJFORMAT_PEi386)
1298 r = ocGetNames_PEi386 ( oc );
1299 # elif defined(OBJFORMAT_MACHO)
1300 r = ocGetNames_MachO ( oc );
1302 barf("loadObj: no getNames method");
1304 if (!r) { return r; }
1306 /* loaded, but not resolved yet */
1307 oc->status = OBJECT_LOADED;
1312 /* -----------------------------------------------------------------------------
1313 * resolve all the currently unlinked objects in memory
1315 * Returns: 1 if ok, 0 on error.
1325 for (oc = objects; oc; oc = oc->next) {
1326 if (oc->status != OBJECT_RESOLVED) {
1327 # if defined(OBJFORMAT_ELF)
1328 r = ocResolve_ELF ( oc );
1329 # elif defined(OBJFORMAT_PEi386)
1330 r = ocResolve_PEi386 ( oc );
1331 # elif defined(OBJFORMAT_MACHO)
1332 r = ocResolve_MachO ( oc );
1334 barf("resolveObjs: not implemented on this platform");
1336 if (!r) { return r; }
1337 oc->status = OBJECT_RESOLVED;
1343 /* -----------------------------------------------------------------------------
1344 * delete an object from the pool
1347 unloadObj( char *path )
1349 ObjectCode *oc, *prev;
1351 ASSERT(symhash != NULL);
1352 ASSERT(objects != NULL);
1357 for (oc = objects; oc; prev = oc, oc = oc->next) {
1358 if (!strcmp(oc->fileName,path)) {
1360 /* Remove all the mappings for the symbols within this
1365 for (i = 0; i < oc->n_symbols; i++) {
1366 if (oc->symbols[i] != NULL) {
1367 removeStrHashTable(symhash, oc->symbols[i], NULL);
1375 prev->next = oc->next;
1378 /* We're going to leave this in place, in case there are
1379 any pointers from the heap into it: */
1380 /* stgFree(oc->image); */
1381 stgFree(oc->fileName);
1382 stgFree(oc->symbols);
1383 stgFree(oc->sections);
1384 /* The local hash table should have been freed at the end
1385 of the ocResolve_ call on it. */
1386 ASSERT(oc->lochash == NULL);
1392 errorBelch("unloadObj: can't find `%s' to unload", path);
1396 /* -----------------------------------------------------------------------------
1397 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1398 * which may be prodded during relocation, and abort if we try and write
1399 * outside any of these.
1401 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1404 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1405 /* debugBelch("aPB %p %p %d\n", oc, start, size); */
1409 pb->next = oc->proddables;
1410 oc->proddables = pb;
1413 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1416 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1417 char* s = (char*)(pb->start);
1418 char* e = s + pb->size - 1;
1419 char* a = (char*)addr;
1420 /* Assumes that the biggest fixup involves a 4-byte write. This
1421 probably needs to be changed to 8 (ie, +7) on 64-bit
1423 if (a >= s && (a+3) <= e) return;
1425 barf("checkProddableBlock: invalid fixup in runtime linker");
1428 /* -----------------------------------------------------------------------------
1429 * Section management.
1431 static void addSection ( ObjectCode* oc, SectionKind kind,
1432 void* start, void* end )
1434 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1438 s->next = oc->sections;
1441 debugBelch("addSection: %p-%p (size %d), kind %d\n",
1442 start, ((char*)end)-1, end - start + 1, kind );
1447 /* --------------------------------------------------------------------------
1448 * PowerPC specifics (jump islands)
1449 * ------------------------------------------------------------------------*/
1451 #if defined(powerpc_HOST_ARCH)
1454 ocAllocateJumpIslands
1456 Allocate additional space at the end of the object file image to make room
1459 PowerPC relative branch instructions have a 24 bit displacement field.
1460 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
1461 If a particular imported symbol is outside this range, we have to redirect
1462 the jump to a short piece of new code that just loads the 32bit absolute
1463 address and jumps there.
1464 This function just allocates space for one 16 byte ppcJumpIsland for every
1465 undefined symbol in the object file. The code for the islands is filled in by
1466 makeJumpIsland below.
1469 static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first )
1475 int misalignment = 0;
1477 misalignment = oc->misalignment;
1482 // round up to the nearest 4
1483 aligned = (oc->fileSize + 3) & ~3;
1486 #ifndef linux_HOST_OS /* mremap is a linux extension */
1487 #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined
1490 pagesize = getpagesize();
1491 n = ROUND_UP( oc->fileSize, pagesize );
1492 m = ROUND_UP( aligned + sizeof (ppcJumpIsland) * count, pagesize );
1494 /* If we have a half-page-size file and map one page of it then
1495 * the part of the page after the size of the file remains accessible.
1496 * If, however, we map in 2 pages, the 2nd page is not accessible
1497 * and will give a "Bus Error" on access. To get around this, we check
1498 * if we need any extra pages for the jump islands and map them in
1499 * anonymously. We must check that we actually require extra pages
1500 * otherwise the attempt to mmap 0 pages of anonymous memory will
1506 /* The effect of this mremap() call is only the ensure that we have
1507 * a sufficient number of virtually contiguous pages. As returned from
1508 * mremap, the pages past the end of the file are not backed. We give
1509 * them a backing by using MAP_FIXED to map in anonymous pages.
1511 oc->image = mremap( oc->image, n, m, MREMAP_MAYMOVE );
1513 if( oc->image == MAP_FAILED )
1515 errorBelch( "Unable to mremap for Jump Islands\n" );
1519 if( mmap( oc->image + n, m - n, PROT_READ | PROT_WRITE | PROT_EXEC,
1520 MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, 0, 0 ) == MAP_FAILED )
1522 errorBelch( "Unable to mmap( MAP_FIXED ) for Jump Islands\n" );
1528 oc->image -= misalignment;
1529 oc->image = stgReallocBytes( oc->image,
1531 aligned + sizeof (ppcJumpIsland) * count,
1532 "ocAllocateJumpIslands" );
1533 oc->image += misalignment;
1534 #endif /* USE_MMAP */
1536 oc->jump_islands = (ppcJumpIsland *) (oc->image + aligned);
1537 memset( oc->jump_islands, 0, sizeof (ppcJumpIsland) * count );
1540 oc->jump_islands = NULL;
1542 oc->island_start_symbol = first;
1543 oc->n_islands = count;
1548 static unsigned long makeJumpIsland( ObjectCode* oc,
1549 unsigned long symbolNumber,
1550 unsigned long target )
1552 ppcJumpIsland *island;
1554 if( symbolNumber < oc->island_start_symbol ||
1555 symbolNumber - oc->island_start_symbol > oc->n_islands)
1558 island = &oc->jump_islands[symbolNumber - oc->island_start_symbol];
1560 // lis r12, hi16(target)
1561 island->lis_r12 = 0x3d80;
1562 island->hi_addr = target >> 16;
1564 // ori r12, r12, lo16(target)
1565 island->ori_r12_r12 = 0x618c;
1566 island->lo_addr = target & 0xffff;
1569 island->mtctr_r12 = 0x7d8903a6;
1572 island->bctr = 0x4e800420;
1574 return (unsigned long) island;
1578 ocFlushInstructionCache
1580 Flush the data & instruction caches.
1581 Because the PPC has split data/instruction caches, we have to
1582 do that whenever we modify code at runtime.
1585 static void ocFlushInstructionCache( ObjectCode *oc )
1587 int n = (oc->fileSize + sizeof( ppcJumpIsland ) * oc->n_islands + 3) / 4;
1588 unsigned long *p = (unsigned long *) oc->image;
1592 __asm__ volatile ( "dcbf 0,%0\n\t"
1600 __asm__ volatile ( "sync\n\t"
1606 /* --------------------------------------------------------------------------
1607 * PEi386 specifics (Win32 targets)
1608 * ------------------------------------------------------------------------*/
1610 /* The information for this linker comes from
1611 Microsoft Portable Executable
1612 and Common Object File Format Specification
1613 revision 5.1 January 1998
1614 which SimonM says comes from the MS Developer Network CDs.
1616 It can be found there (on older CDs), but can also be found
1619 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1621 (this is Rev 6.0 from February 1999).
1623 Things move, so if that fails, try searching for it via
1625 http://www.google.com/search?q=PE+COFF+specification
1627 The ultimate reference for the PE format is the Winnt.h
1628 header file that comes with the Platform SDKs; as always,
1629 implementations will drift wrt their documentation.
1631 A good background article on the PE format is Matt Pietrek's
1632 March 1994 article in Microsoft System Journal (MSJ)
1633 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1634 Win32 Portable Executable File Format." The info in there
1635 has recently been updated in a two part article in
1636 MSDN magazine, issues Feb and March 2002,
1637 "Inside Windows: An In-Depth Look into the Win32 Portable
1638 Executable File Format"
1640 John Levine's book "Linkers and Loaders" contains useful
1645 #if defined(OBJFORMAT_PEi386)
1649 typedef unsigned char UChar;
1650 typedef unsigned short UInt16;
1651 typedef unsigned int UInt32;
1658 UInt16 NumberOfSections;
1659 UInt32 TimeDateStamp;
1660 UInt32 PointerToSymbolTable;
1661 UInt32 NumberOfSymbols;
1662 UInt16 SizeOfOptionalHeader;
1663 UInt16 Characteristics;
1667 #define sizeof_COFF_header 20
1674 UInt32 VirtualAddress;
1675 UInt32 SizeOfRawData;
1676 UInt32 PointerToRawData;
1677 UInt32 PointerToRelocations;
1678 UInt32 PointerToLinenumbers;
1679 UInt16 NumberOfRelocations;
1680 UInt16 NumberOfLineNumbers;
1681 UInt32 Characteristics;
1685 #define sizeof_COFF_section 40
1692 UInt16 SectionNumber;
1695 UChar NumberOfAuxSymbols;
1699 #define sizeof_COFF_symbol 18
1704 UInt32 VirtualAddress;
1705 UInt32 SymbolTableIndex;
1710 #define sizeof_COFF_reloc 10
1713 /* From PE spec doc, section 3.3.2 */
1714 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1715 windows.h -- for the same purpose, but I want to know what I'm
1717 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1718 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1719 #define MYIMAGE_FILE_DLL 0x2000
1720 #define MYIMAGE_FILE_SYSTEM 0x1000
1721 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1722 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1723 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1725 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1726 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1727 #define MYIMAGE_SYM_CLASS_STATIC 3
1728 #define MYIMAGE_SYM_UNDEFINED 0
1730 /* From PE spec doc, section 4.1 */
1731 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1732 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1733 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1735 /* From PE spec doc, section 5.2.1 */
1736 #define MYIMAGE_REL_I386_DIR32 0x0006
1737 #define MYIMAGE_REL_I386_REL32 0x0014
1740 /* We use myindex to calculate array addresses, rather than
1741 simply doing the normal subscript thing. That's because
1742 some of the above structs have sizes which are not
1743 a whole number of words. GCC rounds their sizes up to a
1744 whole number of words, which means that the address calcs
1745 arising from using normal C indexing or pointer arithmetic
1746 are just plain wrong. Sigh.
1749 myindex ( int scale, void* base, int index )
1752 ((UChar*)base) + scale * index;
1757 printName ( UChar* name, UChar* strtab )
1759 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1760 UInt32 strtab_offset = * (UInt32*)(name+4);
1761 debugBelch("%s", strtab + strtab_offset );
1764 for (i = 0; i < 8; i++) {
1765 if (name[i] == 0) break;
1766 debugBelch("%c", name[i] );
1773 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1775 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1776 UInt32 strtab_offset = * (UInt32*)(name+4);
1777 strncpy ( dst, strtab+strtab_offset, dstSize );
1783 if (name[i] == 0) break;
1793 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1796 /* If the string is longer than 8 bytes, look in the
1797 string table for it -- this will be correctly zero terminated.
1799 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1800 UInt32 strtab_offset = * (UInt32*)(name+4);
1801 return ((UChar*)strtab) + strtab_offset;
1803 /* Otherwise, if shorter than 8 bytes, return the original,
1804 which by defn is correctly terminated.
1806 if (name[7]==0) return name;
1807 /* The annoying case: 8 bytes. Copy into a temporary
1808 (which is never freed ...)
1810 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1812 strncpy(newstr,name,8);
1818 /* Just compares the short names (first 8 chars) */
1819 static COFF_section *
1820 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1824 = (COFF_header*)(oc->image);
1825 COFF_section* sectab
1827 ((UChar*)(oc->image))
1828 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1830 for (i = 0; i < hdr->NumberOfSections; i++) {
1833 COFF_section* section_i
1835 myindex ( sizeof_COFF_section, sectab, i );
1836 n1 = (UChar*) &(section_i->Name);
1838 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1839 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1840 n1[6]==n2[6] && n1[7]==n2[7])
1849 zapTrailingAtSign ( UChar* sym )
1851 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1853 if (sym[0] == 0) return;
1855 while (sym[i] != 0) i++;
1858 while (j > 0 && my_isdigit(sym[j])) j--;
1859 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1865 ocVerifyImage_PEi386 ( ObjectCode* oc )
1870 COFF_section* sectab;
1871 COFF_symbol* symtab;
1873 /* debugBelch("\nLOADING %s\n", oc->fileName); */
1874 hdr = (COFF_header*)(oc->image);
1875 sectab = (COFF_section*) (
1876 ((UChar*)(oc->image))
1877 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1879 symtab = (COFF_symbol*) (
1880 ((UChar*)(oc->image))
1881 + hdr->PointerToSymbolTable
1883 strtab = ((UChar*)symtab)
1884 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1886 if (hdr->Machine != 0x14c) {
1887 errorBelch("%s: Not x86 PEi386", oc->fileName);
1890 if (hdr->SizeOfOptionalHeader != 0) {
1891 errorBelch("%s: PEi386 with nonempty optional header", oc->fileName);
1894 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1895 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1896 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1897 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1898 errorBelch("%s: Not a PEi386 object file", oc->fileName);
1901 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1902 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1903 errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
1905 (int)(hdr->Characteristics));
1908 /* If the string table size is way crazy, this might indicate that
1909 there are more than 64k relocations, despite claims to the
1910 contrary. Hence this test. */
1911 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
1913 if ( (*(UInt32*)strtab) > 600000 ) {
1914 /* Note that 600k has no special significance other than being
1915 big enough to handle the almost-2MB-sized lumps that
1916 constitute HSwin32*.o. */
1917 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
1922 /* No further verification after this point; only debug printing. */
1924 IF_DEBUG(linker, i=1);
1925 if (i == 0) return 1;
1927 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1928 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1929 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1932 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1933 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1934 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1935 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1936 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1937 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1938 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1940 /* Print the section table. */
1942 for (i = 0; i < hdr->NumberOfSections; i++) {
1944 COFF_section* sectab_i
1946 myindex ( sizeof_COFF_section, sectab, i );
1953 printName ( sectab_i->Name, strtab );
1963 sectab_i->VirtualSize,
1964 sectab_i->VirtualAddress,
1965 sectab_i->SizeOfRawData,
1966 sectab_i->PointerToRawData,
1967 sectab_i->NumberOfRelocations,
1968 sectab_i->PointerToRelocations,
1969 sectab_i->PointerToRawData
1971 reltab = (COFF_reloc*) (
1972 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1975 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1976 /* If the relocation field (a short) has overflowed, the
1977 * real count can be found in the first reloc entry.
1979 * See Section 4.1 (last para) of the PE spec (rev6.0).
1981 COFF_reloc* rel = (COFF_reloc*)
1982 myindex ( sizeof_COFF_reloc, reltab, 0 );
1983 noRelocs = rel->VirtualAddress;
1986 noRelocs = sectab_i->NumberOfRelocations;
1990 for (; j < noRelocs; j++) {
1992 COFF_reloc* rel = (COFF_reloc*)
1993 myindex ( sizeof_COFF_reloc, reltab, j );
1995 " type 0x%-4x vaddr 0x%-8x name `",
1997 rel->VirtualAddress );
1998 sym = (COFF_symbol*)
1999 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
2000 /* Hmm..mysterious looking offset - what's it for? SOF */
2001 printName ( sym->Name, strtab -10 );
2008 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
2009 debugBelch("---START of string table---\n");
2010 for (i = 4; i < *(Int32*)strtab; i++) {
2012 debugBelch("\n"); else
2013 debugBelch("%c", strtab[i] );
2015 debugBelch("--- END of string table---\n");
2020 COFF_symbol* symtab_i;
2021 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2022 symtab_i = (COFF_symbol*)
2023 myindex ( sizeof_COFF_symbol, symtab, i );
2029 printName ( symtab_i->Name, strtab );
2038 (Int32)(symtab_i->SectionNumber),
2039 (UInt32)symtab_i->Type,
2040 (UInt32)symtab_i->StorageClass,
2041 (UInt32)symtab_i->NumberOfAuxSymbols
2043 i += symtab_i->NumberOfAuxSymbols;
2053 ocGetNames_PEi386 ( ObjectCode* oc )
2056 COFF_section* sectab;
2057 COFF_symbol* symtab;
2064 hdr = (COFF_header*)(oc->image);
2065 sectab = (COFF_section*) (
2066 ((UChar*)(oc->image))
2067 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2069 symtab = (COFF_symbol*) (
2070 ((UChar*)(oc->image))
2071 + hdr->PointerToSymbolTable
2073 strtab = ((UChar*)(oc->image))
2074 + hdr->PointerToSymbolTable
2075 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2077 /* Allocate space for any (local, anonymous) .bss sections. */
2079 for (i = 0; i < hdr->NumberOfSections; i++) {
2082 COFF_section* sectab_i
2084 myindex ( sizeof_COFF_section, sectab, i );
2085 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
2086 /* sof 10/05: the PE spec text isn't too clear regarding what
2087 * the SizeOfRawData field is supposed to hold for object
2088 * file sections containing just uninitialized data -- for executables,
2089 * it is supposed to be zero; unclear what it's supposed to be
2090 * for object files. However, VirtualSize is guaranteed to be
2091 * zero for object files, which definitely suggests that SizeOfRawData
2092 * will be non-zero (where else would the size of this .bss section be
2093 * stored?) Looking at the COFF_section info for incoming object files,
2094 * this certainly appears to be the case.
2096 * => I suspect we've been incorrectly handling .bss sections in (relocatable)
2097 * object files up until now. This turned out to bite us with ghc-6.4.1's use
2098 * of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
2099 * variable decls into to the .bss section. (The specific function in Q which
2100 * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
2102 if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
2103 /* This is a non-empty .bss section. Allocate zeroed space for
2104 it, and set its PointerToRawData field such that oc->image +
2105 PointerToRawData == addr_of_zeroed_space. */
2106 bss_sz = sectab_i->VirtualSize;
2107 if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
2108 zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
2109 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
2110 addProddableBlock(oc, zspace, bss_sz);
2111 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
2114 /* Copy section information into the ObjectCode. */
2116 for (i = 0; i < hdr->NumberOfSections; i++) {
2122 = SECTIONKIND_OTHER;
2123 COFF_section* sectab_i
2125 myindex ( sizeof_COFF_section, sectab, i );
2126 IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
2129 /* I'm sure this is the Right Way to do it. However, the
2130 alternative of testing the sectab_i->Name field seems to
2131 work ok with Cygwin.
2133 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
2134 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
2135 kind = SECTIONKIND_CODE_OR_RODATA;
2138 if (0==strcmp(".text",sectab_i->Name) ||
2139 0==strcmp(".rdata",sectab_i->Name)||
2140 0==strcmp(".rodata",sectab_i->Name))
2141 kind = SECTIONKIND_CODE_OR_RODATA;
2142 if (0==strcmp(".data",sectab_i->Name) ||
2143 0==strcmp(".bss",sectab_i->Name))
2144 kind = SECTIONKIND_RWDATA;
2146 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
2147 sz = sectab_i->SizeOfRawData;
2148 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
2150 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
2151 end = start + sz - 1;
2153 if (kind == SECTIONKIND_OTHER
2154 /* Ignore sections called which contain stabs debugging
2156 && 0 != strcmp(".stab", sectab_i->Name)
2157 && 0 != strcmp(".stabstr", sectab_i->Name)
2158 /* ignore constructor section for now */
2159 && 0 != strcmp(".ctors", sectab_i->Name)
2161 errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
2165 if (kind != SECTIONKIND_OTHER && end >= start) {
2166 addSection(oc, kind, start, end);
2167 addProddableBlock(oc, start, end - start + 1);
2171 /* Copy exported symbols into the ObjectCode. */
2173 oc->n_symbols = hdr->NumberOfSymbols;
2174 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2175 "ocGetNames_PEi386(oc->symbols)");
2176 /* Call me paranoid; I don't care. */
2177 for (i = 0; i < oc->n_symbols; i++)
2178 oc->symbols[i] = NULL;
2182 COFF_symbol* symtab_i;
2183 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2184 symtab_i = (COFF_symbol*)
2185 myindex ( sizeof_COFF_symbol, symtab, i );
2189 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
2190 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
2191 /* This symbol is global and defined, viz, exported */
2192 /* for MYIMAGE_SYMCLASS_EXTERNAL
2193 && !MYIMAGE_SYM_UNDEFINED,
2194 the address of the symbol is:
2195 address of relevant section + offset in section
2197 COFF_section* sectabent
2198 = (COFF_section*) myindex ( sizeof_COFF_section,
2200 symtab_i->SectionNumber-1 );
2201 addr = ((UChar*)(oc->image))
2202 + (sectabent->PointerToRawData
2206 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
2207 && symtab_i->Value > 0) {
2208 /* This symbol isn't in any section at all, ie, global bss.
2209 Allocate zeroed space for it. */
2210 addr = stgCallocBytes(1, symtab_i->Value,
2211 "ocGetNames_PEi386(non-anonymous bss)");
2212 addSection(oc, SECTIONKIND_RWDATA, addr,
2213 ((UChar*)addr) + symtab_i->Value - 1);
2214 addProddableBlock(oc, addr, symtab_i->Value);
2215 /* debugBelch("BSS section at 0x%x\n", addr); */
2218 if (addr != NULL ) {
2219 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
2220 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
2221 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
2222 ASSERT(i >= 0 && i < oc->n_symbols);
2223 /* cstring_from_COFF_symbol_name always succeeds. */
2224 oc->symbols[i] = sname;
2225 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
2229 "IGNORING symbol %d\n"
2233 printName ( symtab_i->Name, strtab );
2242 (Int32)(symtab_i->SectionNumber),
2243 (UInt32)symtab_i->Type,
2244 (UInt32)symtab_i->StorageClass,
2245 (UInt32)symtab_i->NumberOfAuxSymbols
2250 i += symtab_i->NumberOfAuxSymbols;
2259 ocResolve_PEi386 ( ObjectCode* oc )
2262 COFF_section* sectab;
2263 COFF_symbol* symtab;
2273 /* ToDo: should be variable-sized? But is at least safe in the
2274 sense of buffer-overrun-proof. */
2276 /* debugBelch("resolving for %s\n", oc->fileName); */
2278 hdr = (COFF_header*)(oc->image);
2279 sectab = (COFF_section*) (
2280 ((UChar*)(oc->image))
2281 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2283 symtab = (COFF_symbol*) (
2284 ((UChar*)(oc->image))
2285 + hdr->PointerToSymbolTable
2287 strtab = ((UChar*)(oc->image))
2288 + hdr->PointerToSymbolTable
2289 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2291 for (i = 0; i < hdr->NumberOfSections; i++) {
2292 COFF_section* sectab_i
2294 myindex ( sizeof_COFF_section, sectab, i );
2297 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2300 /* Ignore sections called which contain stabs debugging
2302 if (0 == strcmp(".stab", sectab_i->Name)
2303 || 0 == strcmp(".stabstr", sectab_i->Name)
2304 || 0 == strcmp(".ctors", sectab_i->Name))
2307 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2308 /* If the relocation field (a short) has overflowed, the
2309 * real count can be found in the first reloc entry.
2311 * See Section 4.1 (last para) of the PE spec (rev6.0).
2313 * Nov2003 update: the GNU linker still doesn't correctly
2314 * handle the generation of relocatable object files with
2315 * overflown relocations. Hence the output to warn of potential
2318 COFF_reloc* rel = (COFF_reloc*)
2319 myindex ( sizeof_COFF_reloc, reltab, 0 );
2320 noRelocs = rel->VirtualAddress;
2322 /* 10/05: we now assume (and check for) a GNU ld that is capable
2323 * of handling object files with (>2^16) of relocs.
2326 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
2331 noRelocs = sectab_i->NumberOfRelocations;
2336 for (; j < noRelocs; j++) {
2338 COFF_reloc* reltab_j
2340 myindex ( sizeof_COFF_reloc, reltab, j );
2342 /* the location to patch */
2344 ((UChar*)(oc->image))
2345 + (sectab_i->PointerToRawData
2346 + reltab_j->VirtualAddress
2347 - sectab_i->VirtualAddress )
2349 /* the existing contents of pP */
2351 /* the symbol to connect to */
2352 sym = (COFF_symbol*)
2353 myindex ( sizeof_COFF_symbol,
2354 symtab, reltab_j->SymbolTableIndex );
2357 "reloc sec %2d num %3d: type 0x%-4x "
2358 "vaddr 0x%-8x name `",
2360 (UInt32)reltab_j->Type,
2361 reltab_j->VirtualAddress );
2362 printName ( sym->Name, strtab );
2363 debugBelch("'\n" ));
2365 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2366 COFF_section* section_sym
2367 = findPEi386SectionCalled ( oc, sym->Name );
2369 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
2372 S = ((UInt32)(oc->image))
2373 + (section_sym->PointerToRawData
2376 copyName ( sym->Name, strtab, symbol, 1000-1 );
2377 (void*)S = lookupLocalSymbol( oc, symbol );
2378 if ((void*)S != NULL) goto foundit;
2379 (void*)S = lookupSymbol( symbol );
2380 if ((void*)S != NULL) goto foundit;
2381 zapTrailingAtSign ( symbol );
2382 (void*)S = lookupLocalSymbol( oc, symbol );
2383 if ((void*)S != NULL) goto foundit;
2384 (void*)S = lookupSymbol( symbol );
2385 if ((void*)S != NULL) goto foundit;
2386 /* Newline first because the interactive linker has printed "linking..." */
2387 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2391 checkProddableBlock(oc, pP);
2392 switch (reltab_j->Type) {
2393 case MYIMAGE_REL_I386_DIR32:
2396 case MYIMAGE_REL_I386_REL32:
2397 /* Tricky. We have to insert a displacement at
2398 pP which, when added to the PC for the _next_
2399 insn, gives the address of the target (S).
2400 Problem is to know the address of the next insn
2401 when we only know pP. We assume that this
2402 literal field is always the last in the insn,
2403 so that the address of the next insn is pP+4
2404 -- hence the constant 4.
2405 Also I don't know if A should be added, but so
2406 far it has always been zero.
2408 SOF 05/2005: 'A' (old contents of *pP) have been observed
2409 to contain values other than zero (the 'wx' object file
2410 that came with wxhaskell-0.9.4; dunno how it was compiled..).
2411 So, add displacement to old value instead of asserting
2412 A to be zero. Fixes wxhaskell-related crashes, and no other
2413 ill effects have been observed.
2415 Update: the reason why we're seeing these more elaborate
2416 relocations is due to a switch in how the NCG compiles SRTs
2417 and offsets to them from info tables. SRTs live in .(ro)data,
2418 while info tables live in .text, causing GAS to emit REL32/DISP32
2419 relocations with non-zero values. Adding the displacement is
2420 the right thing to do.
2422 *pP = S - ((UInt32)pP) - 4 + A;
2425 debugBelch("%s: unhandled PEi386 relocation type %d",
2426 oc->fileName, reltab_j->Type);
2433 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
2437 #endif /* defined(OBJFORMAT_PEi386) */
2440 /* --------------------------------------------------------------------------
2442 * ------------------------------------------------------------------------*/
2444 #if defined(OBJFORMAT_ELF)
2449 #if defined(sparc_HOST_ARCH)
2450 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2451 #elif defined(i386_HOST_ARCH)
2452 # define ELF_TARGET_386 /* Used inside <elf.h> */
2453 #elif defined(x86_64_HOST_ARCH)
2454 # define ELF_TARGET_X64_64
2456 #elif defined (ia64_HOST_ARCH)
2457 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2459 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2460 # define ELF_NEED_GOT /* needs Global Offset Table */
2461 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2464 #if !defined(openbsd_HOST_OS)
2467 /* openbsd elf has things in different places, with diff names */
2468 #include <elf_abi.h>
2469 #include <machine/reloc.h>
2470 #define R_386_32 RELOC_32
2471 #define R_386_PC32 RELOC_PC32
2475 * Define a set of types which can be used for both ELF32 and ELF64
2479 #define ELFCLASS ELFCLASS64
2480 #define Elf_Addr Elf64_Addr
2481 #define Elf_Word Elf64_Word
2482 #define Elf_Sword Elf64_Sword
2483 #define Elf_Ehdr Elf64_Ehdr
2484 #define Elf_Phdr Elf64_Phdr
2485 #define Elf_Shdr Elf64_Shdr
2486 #define Elf_Sym Elf64_Sym
2487 #define Elf_Rel Elf64_Rel
2488 #define Elf_Rela Elf64_Rela
2489 #define ELF_ST_TYPE ELF64_ST_TYPE
2490 #define ELF_ST_BIND ELF64_ST_BIND
2491 #define ELF_R_TYPE ELF64_R_TYPE
2492 #define ELF_R_SYM ELF64_R_SYM
2494 #define ELFCLASS ELFCLASS32
2495 #define Elf_Addr Elf32_Addr
2496 #define Elf_Word Elf32_Word
2497 #define Elf_Sword Elf32_Sword
2498 #define Elf_Ehdr Elf32_Ehdr
2499 #define Elf_Phdr Elf32_Phdr
2500 #define Elf_Shdr Elf32_Shdr
2501 #define Elf_Sym Elf32_Sym
2502 #define Elf_Rel Elf32_Rel
2503 #define Elf_Rela Elf32_Rela
2505 #define ELF_ST_TYPE ELF32_ST_TYPE
2508 #define ELF_ST_BIND ELF32_ST_BIND
2511 #define ELF_R_TYPE ELF32_R_TYPE
2514 #define ELF_R_SYM ELF32_R_SYM
2520 * Functions to allocate entries in dynamic sections. Currently we simply
2521 * preallocate a large number, and we don't check if a entry for the given
2522 * target already exists (a linear search is too slow). Ideally these
2523 * entries would be associated with symbols.
2526 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2527 #define GOT_SIZE 0x20000
2528 #define FUNCTION_TABLE_SIZE 0x10000
2529 #define PLT_SIZE 0x08000
2532 static Elf_Addr got[GOT_SIZE];
2533 static unsigned int gotIndex;
2534 static Elf_Addr gp_val = (Elf_Addr)got;
2537 allocateGOTEntry(Elf_Addr target)
2541 if (gotIndex >= GOT_SIZE)
2542 barf("Global offset table overflow");
2544 entry = &got[gotIndex++];
2546 return (Elf_Addr)entry;
2550 #ifdef ELF_FUNCTION_DESC
2556 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2557 static unsigned int functionTableIndex;
2560 allocateFunctionDesc(Elf_Addr target)
2562 FunctionDesc *entry;
2564 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2565 barf("Function table overflow");
2567 entry = &functionTable[functionTableIndex++];
2569 entry->gp = (Elf_Addr)gp_val;
2570 return (Elf_Addr)entry;
2574 copyFunctionDesc(Elf_Addr target)
2576 FunctionDesc *olddesc = (FunctionDesc *)target;
2577 FunctionDesc *newdesc;
2579 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2580 newdesc->gp = olddesc->gp;
2581 return (Elf_Addr)newdesc;
2586 #ifdef ia64_HOST_ARCH
2587 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2588 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2590 static unsigned char plt_code[] =
2592 /* taken from binutils bfd/elfxx-ia64.c */
2593 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2594 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2595 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2596 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2597 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2598 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2601 /* If we can't get to the function descriptor via gp, take a local copy of it */
2602 #define PLT_RELOC(code, target) { \
2603 Elf64_Sxword rel_value = target - gp_val; \
2604 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2605 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2607 ia64_reloc_gprel22((Elf_Addr)code, target); \
2612 unsigned char code[sizeof(plt_code)];
2616 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2618 PLTEntry *plt = (PLTEntry *)oc->plt;
2621 if (oc->pltIndex >= PLT_SIZE)
2622 barf("Procedure table overflow");
2624 entry = &plt[oc->pltIndex++];
2625 memcpy(entry->code, plt_code, sizeof(entry->code));
2626 PLT_RELOC(entry->code, target);
2627 return (Elf_Addr)entry;
2633 return (PLT_SIZE * sizeof(PLTEntry));
2638 #if x86_64_HOST_ARCH
2639 // On x86_64, 32-bit relocations are often used, which requires that
2640 // we can resolve a symbol to a 32-bit offset. However, shared
2641 // libraries are placed outside the 2Gb area, which leaves us with a
2642 // problem when we need to give a 32-bit offset to a symbol in a
2645 // For a function symbol, we can allocate a bounce sequence inside the
2646 // 2Gb area and resolve the symbol to this. The bounce sequence is
2647 // simply a long jump instruction to the real location of the symbol.
2649 // For data references, we're screwed.
2652 unsigned char jmp[8]; /* 6 byte instruction: jmpq *0x00000002(%rip) */
2656 #define X86_64_BB_SIZE 1024
2658 static x86_64_bounce *x86_64_bounce_buffer = NULL;
2659 static nat x86_64_bb_next_off;
2662 x86_64_high_symbol( char *lbl, void *addr )
2664 x86_64_bounce *bounce;
2666 if ( x86_64_bounce_buffer == NULL ||
2667 x86_64_bb_next_off >= X86_64_BB_SIZE ) {
2668 x86_64_bounce_buffer =
2669 mmap(NULL, X86_64_BB_SIZE * sizeof(x86_64_bounce),
2670 PROT_EXEC|PROT_READ|PROT_WRITE,
2671 MAP_PRIVATE|MAP_32BIT|MAP_ANONYMOUS, -1, 0);
2672 if (x86_64_bounce_buffer == MAP_FAILED) {
2673 barf("x86_64_high_symbol: mmap failed");
2675 x86_64_bb_next_off = 0;
2677 bounce = &x86_64_bounce_buffer[x86_64_bb_next_off];
2678 bounce->jmp[0] = 0xff;
2679 bounce->jmp[1] = 0x25;
2680 bounce->jmp[2] = 0x02;
2681 bounce->jmp[3] = 0x00;
2682 bounce->jmp[4] = 0x00;
2683 bounce->jmp[5] = 0x00;
2684 bounce->addr = addr;
2685 x86_64_bb_next_off++;
2687 IF_DEBUG(linker, debugBelch("x86_64: allocated bounce entry for %s->%p at %p\n",
2688 lbl, addr, bounce));
2690 insertStrHashTable(symhash, lbl, bounce);
2697 * Generic ELF functions
2701 findElfSection ( void* objImage, Elf_Word sh_type )
2703 char* ehdrC = (char*)objImage;
2704 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2705 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2706 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2710 for (i = 0; i < ehdr->e_shnum; i++) {
2711 if (shdr[i].sh_type == sh_type
2712 /* Ignore the section header's string table. */
2713 && i != ehdr->e_shstrndx
2714 /* Ignore string tables named .stabstr, as they contain
2716 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2718 ptr = ehdrC + shdr[i].sh_offset;
2725 #if defined(ia64_HOST_ARCH)
2727 findElfSegment ( void* objImage, Elf_Addr vaddr )
2729 char* ehdrC = (char*)objImage;
2730 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2731 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2732 Elf_Addr segaddr = 0;
2735 for (i = 0; i < ehdr->e_phnum; i++) {
2736 segaddr = phdr[i].p_vaddr;
2737 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2745 ocVerifyImage_ELF ( ObjectCode* oc )
2749 int i, j, nent, nstrtab, nsymtabs;
2753 char* ehdrC = (char*)(oc->image);
2754 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2756 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2757 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2758 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2759 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2760 errorBelch("%s: not an ELF object", oc->fileName);
2764 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2765 errorBelch("%s: unsupported ELF format", oc->fileName);
2769 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2770 IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
2772 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2773 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
2775 errorBelch("%s: unknown endiannness", oc->fileName);
2779 if (ehdr->e_type != ET_REL) {
2780 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
2783 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
2785 IF_DEBUG(linker,debugBelch( "Architecture is " ));
2786 switch (ehdr->e_machine) {
2787 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
2788 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
2790 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
2792 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
2794 case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
2796 default: IF_DEBUG(linker,debugBelch( "unknown" ));
2797 errorBelch("%s: unknown architecture", oc->fileName);
2801 IF_DEBUG(linker,debugBelch(
2802 "\nSection header table: start %ld, n_entries %d, ent_size %d\n",
2803 (long)ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2805 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2807 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2809 if (ehdr->e_shstrndx == SHN_UNDEF) {
2810 errorBelch("%s: no section header string table", oc->fileName);
2813 IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
2815 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2818 for (i = 0; i < ehdr->e_shnum; i++) {
2819 IF_DEBUG(linker,debugBelch("%2d: ", i ));
2820 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
2821 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
2822 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
2823 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
2824 ehdrC + shdr[i].sh_offset,
2825 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2827 if (shdr[i].sh_type == SHT_REL) {
2828 IF_DEBUG(linker,debugBelch("Rel " ));
2829 } else if (shdr[i].sh_type == SHT_RELA) {
2830 IF_DEBUG(linker,debugBelch("RelA " ));
2832 IF_DEBUG(linker,debugBelch(" "));
2835 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
2839 IF_DEBUG(linker,debugBelch( "\nString tables" ));
2842 for (i = 0; i < ehdr->e_shnum; i++) {
2843 if (shdr[i].sh_type == SHT_STRTAB
2844 /* Ignore the section header's string table. */
2845 && i != ehdr->e_shstrndx
2846 /* Ignore string tables named .stabstr, as they contain
2848 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2850 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
2851 strtab = ehdrC + shdr[i].sh_offset;
2856 errorBelch("%s: no string tables, or too many", oc->fileName);
2861 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
2862 for (i = 0; i < ehdr->e_shnum; i++) {
2863 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2864 IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
2866 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2867 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2868 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%ld rem)\n",
2870 (long)shdr[i].sh_size % sizeof(Elf_Sym)
2872 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2873 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
2876 for (j = 0; j < nent; j++) {
2877 IF_DEBUG(linker,debugBelch(" %2d ", j ));
2878 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
2879 (int)stab[j].st_shndx,
2880 (int)stab[j].st_size,
2881 (char*)stab[j].st_value ));
2883 IF_DEBUG(linker,debugBelch("type=" ));
2884 switch (ELF_ST_TYPE(stab[j].st_info)) {
2885 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
2886 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
2887 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
2888 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
2889 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
2890 default: IF_DEBUG(linker,debugBelch("? " )); break;
2892 IF_DEBUG(linker,debugBelch(" " ));
2894 IF_DEBUG(linker,debugBelch("bind=" ));
2895 switch (ELF_ST_BIND(stab[j].st_info)) {
2896 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
2897 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
2898 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
2899 default: IF_DEBUG(linker,debugBelch("? " )); break;
2901 IF_DEBUG(linker,debugBelch(" " ));
2903 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
2907 if (nsymtabs == 0) {
2908 errorBelch("%s: didn't find any symbol tables", oc->fileName);
2915 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
2919 if (hdr->sh_type == SHT_PROGBITS
2920 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
2921 /* .text-style section */
2922 return SECTIONKIND_CODE_OR_RODATA;
2925 if (hdr->sh_type == SHT_PROGBITS
2926 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2927 /* .data-style section */
2928 return SECTIONKIND_RWDATA;
2931 if (hdr->sh_type == SHT_PROGBITS
2932 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
2933 /* .rodata-style section */
2934 return SECTIONKIND_CODE_OR_RODATA;
2937 if (hdr->sh_type == SHT_NOBITS
2938 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2939 /* .bss-style section */
2941 return SECTIONKIND_RWDATA;
2944 return SECTIONKIND_OTHER;
2949 ocGetNames_ELF ( ObjectCode* oc )
2954 char* ehdrC = (char*)(oc->image);
2955 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2956 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2957 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2959 ASSERT(symhash != NULL);
2962 errorBelch("%s: no strtab", oc->fileName);
2967 for (i = 0; i < ehdr->e_shnum; i++) {
2968 /* Figure out what kind of section it is. Logic derived from
2969 Figure 1.14 ("Special Sections") of the ELF document
2970 ("Portable Formats Specification, Version 1.1"). */
2972 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
2974 if (is_bss && shdr[i].sh_size > 0) {
2975 /* This is a non-empty .bss section. Allocate zeroed space for
2976 it, and set its .sh_offset field such that
2977 ehdrC + .sh_offset == addr_of_zeroed_space. */
2978 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2979 "ocGetNames_ELF(BSS)");
2980 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2982 debugBelch("BSS section at 0x%x, size %d\n",
2983 zspace, shdr[i].sh_size);
2987 /* fill in the section info */
2988 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2989 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2990 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2991 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2994 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2996 /* copy stuff into this module's object symbol table */
2997 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2998 nent = shdr[i].sh_size / sizeof(Elf_Sym);
3000 oc->n_symbols = nent;
3001 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3002 "ocGetNames_ELF(oc->symbols)");
3004 for (j = 0; j < nent; j++) {
3006 char isLocal = FALSE; /* avoids uninit-var warning */
3008 char* nm = strtab + stab[j].st_name;
3009 int secno = stab[j].st_shndx;
3011 /* Figure out if we want to add it; if so, set ad to its
3012 address. Otherwise leave ad == NULL. */
3014 if (secno == SHN_COMMON) {
3016 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
3018 debugBelch("COMMON symbol, size %d name %s\n",
3019 stab[j].st_size, nm);
3021 /* Pointless to do addProddableBlock() for this area,
3022 since the linker should never poke around in it. */
3025 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
3026 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
3028 /* and not an undefined symbol */
3029 && stab[j].st_shndx != SHN_UNDEF
3030 /* and not in a "special section" */
3031 && stab[j].st_shndx < SHN_LORESERVE
3033 /* and it's a not a section or string table or anything silly */
3034 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
3035 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
3036 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
3039 /* Section 0 is the undefined section, hence > and not >=. */
3040 ASSERT(secno > 0 && secno < ehdr->e_shnum);
3042 if (shdr[secno].sh_type == SHT_NOBITS) {
3043 debugBelch(" BSS symbol, size %d off %d name %s\n",
3044 stab[j].st_size, stab[j].st_value, nm);
3047 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
3048 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
3051 #ifdef ELF_FUNCTION_DESC
3052 /* dlsym() and the initialisation table both give us function
3053 * descriptors, so to be consistent we store function descriptors
3054 * in the symbol table */
3055 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
3056 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
3058 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s",
3059 ad, oc->fileName, nm ));
3064 /* And the decision is ... */
3068 oc->symbols[j] = nm;
3071 /* Ignore entirely. */
3073 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
3077 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
3078 strtab + stab[j].st_name ));
3081 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
3082 (int)ELF_ST_BIND(stab[j].st_info),
3083 (int)ELF_ST_TYPE(stab[j].st_info),
3084 (int)stab[j].st_shndx,
3085 strtab + stab[j].st_name
3088 oc->symbols[j] = NULL;
3097 /* Do ELF relocations which lack an explicit addend. All x86-linux
3098 relocations appear to be of this form. */
3100 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
3101 Elf_Shdr* shdr, int shnum,
3102 Elf_Sym* stab, char* strtab )
3107 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
3108 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
3109 int target_shndx = shdr[shnum].sh_info;
3110 int symtab_shndx = shdr[shnum].sh_link;
3112 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3113 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
3114 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3115 target_shndx, symtab_shndx ));
3117 /* Skip sections that we're not interested in. */
3120 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
3121 if (kind == SECTIONKIND_OTHER) {
3122 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
3127 for (j = 0; j < nent; j++) {
3128 Elf_Addr offset = rtab[j].r_offset;
3129 Elf_Addr info = rtab[j].r_info;
3131 Elf_Addr P = ((Elf_Addr)targ) + offset;
3132 Elf_Word* pP = (Elf_Word*)P;
3138 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
3139 j, (void*)offset, (void*)info ));
3141 IF_DEBUG(linker,debugBelch( " ZERO" ));
3144 Elf_Sym sym = stab[ELF_R_SYM(info)];
3145 /* First see if it is a local symbol. */
3146 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3147 /* Yes, so we can get the address directly from the ELF symbol
3149 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3151 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3152 + stab[ELF_R_SYM(info)].st_value);
3155 /* No, so look up the name in our global table. */
3156 symbol = strtab + sym.st_name;
3157 S_tmp = lookupSymbol( symbol );
3158 S = (Elf_Addr)S_tmp;
3161 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3164 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
3167 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
3168 (void*)P, (void*)S, (void*)A ));
3169 checkProddableBlock ( oc, pP );
3173 switch (ELF_R_TYPE(info)) {
3174 # ifdef i386_HOST_ARCH
3175 case R_386_32: *pP = value; break;
3176 case R_386_PC32: *pP = value - P; break;
3179 errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n",
3180 oc->fileName, (lnat)ELF_R_TYPE(info));
3188 /* Do ELF relocations for which explicit addends are supplied.
3189 sparc-solaris relocations appear to be of this form. */
3191 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
3192 Elf_Shdr* shdr, int shnum,
3193 Elf_Sym* stab, char* strtab )
3196 char *symbol = NULL;
3198 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
3199 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
3200 int target_shndx = shdr[shnum].sh_info;
3201 int symtab_shndx = shdr[shnum].sh_link;
3203 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3204 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
3205 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3206 target_shndx, symtab_shndx ));
3208 for (j = 0; j < nent; j++) {
3209 #if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3210 /* This #ifdef only serves to avoid unused-var warnings. */
3211 Elf_Addr offset = rtab[j].r_offset;
3212 Elf_Addr P = targ + offset;
3214 Elf_Addr info = rtab[j].r_info;
3215 Elf_Addr A = rtab[j].r_addend;
3219 # if defined(sparc_HOST_ARCH)
3220 Elf_Word* pP = (Elf_Word*)P;
3222 # elif defined(ia64_HOST_ARCH)
3223 Elf64_Xword *pP = (Elf64_Xword *)P;
3225 # elif defined(powerpc_HOST_ARCH)
3229 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
3230 j, (void*)offset, (void*)info,
3233 IF_DEBUG(linker,debugBelch( " ZERO" ));
3236 Elf_Sym sym = stab[ELF_R_SYM(info)];
3237 /* First see if it is a local symbol. */
3238 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3239 /* Yes, so we can get the address directly from the ELF symbol
3241 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3243 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3244 + stab[ELF_R_SYM(info)].st_value);
3245 #ifdef ELF_FUNCTION_DESC
3246 /* Make a function descriptor for this function */
3247 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
3248 S = allocateFunctionDesc(S + A);
3253 /* No, so look up the name in our global table. */
3254 symbol = strtab + sym.st_name;
3255 S_tmp = lookupSymbol( symbol );
3256 S = (Elf_Addr)S_tmp;
3258 #ifdef ELF_FUNCTION_DESC
3259 /* If a function, already a function descriptor - we would
3260 have to copy it to add an offset. */
3261 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
3262 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
3266 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3269 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
3272 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
3273 (void*)P, (void*)S, (void*)A ));
3274 /* checkProddableBlock ( oc, (void*)P ); */
3278 switch (ELF_R_TYPE(info)) {
3279 # if defined(sparc_HOST_ARCH)
3280 case R_SPARC_WDISP30:
3281 w1 = *pP & 0xC0000000;
3282 w2 = (Elf_Word)((value - P) >> 2);
3283 ASSERT((w2 & 0xC0000000) == 0);
3288 w1 = *pP & 0xFFC00000;
3289 w2 = (Elf_Word)(value >> 10);
3290 ASSERT((w2 & 0xFFC00000) == 0);
3296 w2 = (Elf_Word)(value & 0x3FF);
3297 ASSERT((w2 & ~0x3FF) == 0);
3301 /* According to the Sun documentation:
3303 This relocation type resembles R_SPARC_32, except it refers to an
3304 unaligned word. That is, the word to be relocated must be treated
3305 as four separate bytes with arbitrary alignment, not as a word
3306 aligned according to the architecture requirements.
3308 (JRS: which means that freeloading on the R_SPARC_32 case
3309 is probably wrong, but hey ...)
3313 w2 = (Elf_Word)value;
3316 # elif defined(ia64_HOST_ARCH)
3317 case R_IA64_DIR64LSB:
3318 case R_IA64_FPTR64LSB:
3321 case R_IA64_PCREL64LSB:
3324 case R_IA64_SEGREL64LSB:
3325 addr = findElfSegment(ehdrC, value);
3328 case R_IA64_GPREL22:
3329 ia64_reloc_gprel22(P, value);
3331 case R_IA64_LTOFF22:
3332 case R_IA64_LTOFF22X:
3333 case R_IA64_LTOFF_FPTR22:
3334 addr = allocateGOTEntry(value);
3335 ia64_reloc_gprel22(P, addr);
3337 case R_IA64_PCREL21B:
3338 ia64_reloc_pcrel21(P, S, oc);
3341 /* This goes with R_IA64_LTOFF22X and points to the load to
3342 * convert into a move. We don't implement relaxation. */
3344 # elif defined(powerpc_HOST_ARCH)
3345 case R_PPC_ADDR16_LO:
3346 *(Elf32_Half*) P = value;
3349 case R_PPC_ADDR16_HI:
3350 *(Elf32_Half*) P = value >> 16;
3353 case R_PPC_ADDR16_HA:
3354 *(Elf32_Half*) P = (value + 0x8000) >> 16;
3358 *(Elf32_Word *) P = value;
3362 *(Elf32_Word *) P = value - P;
3368 if( delta << 6 >> 6 != delta )
3370 value = makeJumpIsland( oc, ELF_R_SYM(info), value );
3373 if( value == 0 || delta << 6 >> 6 != delta )
3375 barf( "Unable to make ppcJumpIsland for #%d",
3381 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3382 | (delta & 0x3fffffc);
3386 #if x86_64_HOST_ARCH
3388 *(Elf64_Xword *)P = value;
3393 StgInt64 off = value - P;
3394 if (off >= 0x7fffffffL || off < -0x80000000L) {
3395 barf("R_X86_64_PC32 relocation out of range: %s = %p",
3398 *(Elf64_Word *)P = (Elf64_Word)off;
3403 if (value >= 0x7fffffffL) {
3404 barf("R_X86_64_32 relocation out of range: %s = %p\n",
3407 *(Elf64_Word *)P = (Elf64_Word)value;
3411 if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
3412 barf("R_X86_64_32S relocation out of range: %s = %p\n",
3415 *(Elf64_Sword *)P = (Elf64_Sword)value;
3420 errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n",
3421 oc->fileName, (lnat)ELF_R_TYPE(info));
3430 ocResolve_ELF ( ObjectCode* oc )
3434 Elf_Sym* stab = NULL;
3435 char* ehdrC = (char*)(oc->image);
3436 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
3437 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3439 /* first find "the" symbol table */
3440 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
3442 /* also go find the string table */
3443 strtab = findElfSection ( ehdrC, SHT_STRTAB );
3445 if (stab == NULL || strtab == NULL) {
3446 errorBelch("%s: can't find string or symbol table", oc->fileName);
3450 /* Process the relocation sections. */
3451 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
3452 if (shdr[shnum].sh_type == SHT_REL) {
3453 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
3454 shnum, stab, strtab );
3458 if (shdr[shnum].sh_type == SHT_RELA) {
3459 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
3460 shnum, stab, strtab );
3465 /* Free the local symbol table; we won't need it again. */
3466 freeHashTable(oc->lochash, NULL);
3469 #if defined(powerpc_HOST_ARCH)
3470 ocFlushInstructionCache( oc );
3478 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
3479 * at the front. The following utility functions pack and unpack instructions, and
3480 * take care of the most common relocations.
3483 #ifdef ia64_HOST_ARCH
3486 ia64_extract_instruction(Elf64_Xword *target)
3489 int slot = (Elf_Addr)target & 3;
3490 target = (Elf_Addr)target & ~3;
3498 return ((w1 >> 5) & 0x1ffffffffff);
3500 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
3504 barf("ia64_extract_instruction: invalid slot %p", target);
3509 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
3511 int slot = (Elf_Addr)target & 3;
3512 target = (Elf_Addr)target & ~3;
3517 *target |= value << 5;
3520 *target |= value << 46;
3521 *(target+1) |= value >> 18;
3524 *(target+1) |= value << 23;
3530 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3532 Elf64_Xword instruction;
3533 Elf64_Sxword rel_value;
3535 rel_value = value - gp_val;
3536 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3537 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3539 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3540 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3541 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3542 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3543 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3544 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3548 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3550 Elf64_Xword instruction;
3551 Elf64_Sxword rel_value;
3554 entry = allocatePLTEntry(value, oc);
3556 rel_value = (entry >> 4) - (target >> 4);
3557 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3558 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3560 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3561 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3562 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3563 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3569 * PowerPC ELF specifics
3572 #ifdef powerpc_HOST_ARCH
3574 static int ocAllocateJumpIslands_ELF( ObjectCode *oc )
3580 ehdr = (Elf_Ehdr *) oc->image;
3581 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
3583 for( i = 0; i < ehdr->e_shnum; i++ )
3584 if( shdr[i].sh_type == SHT_SYMTAB )
3587 if( i == ehdr->e_shnum )
3589 errorBelch( "This ELF file contains no symtab" );
3593 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
3595 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
3596 shdr[i].sh_entsize, sizeof( Elf_Sym ) );
3601 return ocAllocateJumpIslands( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
3604 #endif /* powerpc */
3608 /* --------------------------------------------------------------------------
3610 * ------------------------------------------------------------------------*/
3612 #if defined(OBJFORMAT_MACHO)
3615 Support for MachO linking on Darwin/MacOS X
3616 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3618 I hereby formally apologize for the hackish nature of this code.
3619 Things that need to be done:
3620 *) implement ocVerifyImage_MachO
3621 *) add still more sanity checks.
3624 #ifdef powerpc_HOST_ARCH
3625 static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
3627 struct mach_header *header = (struct mach_header *) oc->image;
3628 struct load_command *lc = (struct load_command *) (header + 1);
3631 for( i = 0; i < header->ncmds; i++ )
3633 if( lc->cmd == LC_SYMTAB )
3635 // Find out the first and last undefined external
3636 // symbol, so we don't have to allocate too many
3638 struct symtab_command *symLC = (struct symtab_command *) lc;
3639 unsigned min = symLC->nsyms, max = 0;
3640 struct nlist *nlist =
3641 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
3643 for(i=0;i<symLC->nsyms;i++)
3645 if(nlist[i].n_type & N_STAB)
3647 else if(nlist[i].n_type & N_EXT)
3649 if((nlist[i].n_type & N_TYPE) == N_UNDF
3650 && (nlist[i].n_value == 0))
3660 return ocAllocateJumpIslands(oc, max - min + 1, min);
3665 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3667 return ocAllocateJumpIslands(oc,0,0);
3671 static int ocVerifyImage_MachO(ObjectCode* oc STG_UNUSED)
3673 // FIXME: do some verifying here
3677 static int resolveImports(
3680 struct symtab_command *symLC,
3681 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3682 unsigned long *indirectSyms,
3683 struct nlist *nlist)
3686 size_t itemSize = 4;
3689 int isJumpTable = 0;
3690 if(!strcmp(sect->sectname,"__jump_table"))
3694 ASSERT(sect->reserved2 == itemSize);
3698 for(i=0; i*itemSize < sect->size;i++)
3700 // according to otool, reserved1 contains the first index into the indirect symbol table
3701 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3702 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3705 if((symbol->n_type & N_TYPE) == N_UNDF
3706 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3707 addr = (void*) (symbol->n_value);
3708 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3711 addr = lookupSymbol(nm);
3714 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3722 checkProddableBlock(oc,image + sect->offset + i*itemSize);
3723 *(image + sect->offset + i*itemSize) = 0xe9; // jmp
3724 *(unsigned*)(image + sect->offset + i*itemSize + 1)
3725 = (char*)addr - (image + sect->offset + i*itemSize + 5);
3730 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3731 ((void**)(image + sect->offset))[i] = addr;
3738 static unsigned long relocateAddress(
3741 struct section* sections,
3742 unsigned long address)
3745 for(i = 0; i < nSections; i++)
3747 if(sections[i].addr <= address
3748 && address < sections[i].addr + sections[i].size)
3750 return (unsigned long)oc->image
3751 + sections[i].offset + address - sections[i].addr;
3754 barf("Invalid Mach-O file:"
3755 "Address out of bounds while relocating object file");
3759 static int relocateSection(
3762 struct symtab_command *symLC, struct nlist *nlist,
3763 int nSections, struct section* sections, struct section *sect)
3765 struct relocation_info *relocs;
3768 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3770 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3772 else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
3774 else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
3778 relocs = (struct relocation_info*) (image + sect->reloff);
3782 if(relocs[i].r_address & R_SCATTERED)
3784 struct scattered_relocation_info *scat =
3785 (struct scattered_relocation_info*) &relocs[i];
3789 if(scat->r_length == 2)
3791 unsigned long word = 0;
3792 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
3793 checkProddableBlock(oc,wordPtr);
3795 // Note on relocation types:
3796 // i386 uses the GENERIC_RELOC_* types,
3797 // while ppc uses special PPC_RELOC_* types.
3798 // *_RELOC_VANILLA and *_RELOC_PAIR have the same value
3799 // in both cases, all others are different.
3800 // Therefore, we use GENERIC_RELOC_VANILLA
3801 // and GENERIC_RELOC_PAIR instead of the PPC variants,
3802 // and use #ifdefs for the other types.
3804 // Step 1: Figure out what the relocated value should be
3805 if(scat->r_type == GENERIC_RELOC_VANILLA)
3807 word = *wordPtr + (unsigned long) relocateAddress(
3814 #ifdef powerpc_HOST_ARCH
3815 else if(scat->r_type == PPC_RELOC_SECTDIFF
3816 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
3817 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
3818 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3820 else if(scat->r_type == GENERIC_RELOC_SECTDIFF)
3823 struct scattered_relocation_info *pair =
3824 (struct scattered_relocation_info*) &relocs[i+1];
3826 if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR)
3827 barf("Invalid Mach-O file: "
3828 "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
3830 word = (unsigned long)
3831 (relocateAddress(oc, nSections, sections, scat->r_value)
3832 - relocateAddress(oc, nSections, sections, pair->r_value));
3835 #ifdef powerpc_HOST_ARCH
3836 else if(scat->r_type == PPC_RELOC_HI16
3837 || scat->r_type == PPC_RELOC_LO16
3838 || scat->r_type == PPC_RELOC_HA16
3839 || scat->r_type == PPC_RELOC_LO14)
3840 { // these are generated by label+offset things
3841 struct relocation_info *pair = &relocs[i+1];
3842 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
3843 barf("Invalid Mach-O file: "
3844 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
3846 if(scat->r_type == PPC_RELOC_LO16)
3848 word = ((unsigned short*) wordPtr)[1];
3849 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3851 else if(scat->r_type == PPC_RELOC_LO14)
3853 barf("Unsupported Relocation: PPC_RELOC_LO14");
3854 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
3855 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3857 else if(scat->r_type == PPC_RELOC_HI16)
3859 word = ((unsigned short*) wordPtr)[1] << 16;
3860 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3862 else if(scat->r_type == PPC_RELOC_HA16)
3864 word = ((unsigned short*) wordPtr)[1] << 16;
3865 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3869 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
3876 continue; // ignore the others
3878 #ifdef powerpc_HOST_ARCH
3879 if(scat->r_type == GENERIC_RELOC_VANILLA
3880 || scat->r_type == PPC_RELOC_SECTDIFF)
3882 if(scat->r_type == GENERIC_RELOC_VANILLA
3883 || scat->r_type == GENERIC_RELOC_SECTDIFF)
3888 #ifdef powerpc_HOST_ARCH
3889 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
3891 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3893 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
3895 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3897 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
3899 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3900 + ((word & (1<<15)) ? 1 : 0);
3906 continue; // FIXME: I hope it's OK to ignore all the others.
3910 struct relocation_info *reloc = &relocs[i];
3911 if(reloc->r_pcrel && !reloc->r_extern)
3914 if(reloc->r_length == 2)
3916 unsigned long word = 0;
3917 #ifdef powerpc_HOST_ARCH
3918 unsigned long jumpIsland = 0;
3919 long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
3920 // to avoid warning and to catch
3924 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3925 checkProddableBlock(oc,wordPtr);
3927 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3931 #ifdef powerpc_HOST_ARCH
3932 else if(reloc->r_type == PPC_RELOC_LO16)
3934 word = ((unsigned short*) wordPtr)[1];
3935 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3937 else if(reloc->r_type == PPC_RELOC_HI16)
3939 word = ((unsigned short*) wordPtr)[1] << 16;
3940 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3942 else if(reloc->r_type == PPC_RELOC_HA16)
3944 word = ((unsigned short*) wordPtr)[1] << 16;
3945 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3947 else if(reloc->r_type == PPC_RELOC_BR24)
3950 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
3954 if(!reloc->r_extern)
3957 sections[reloc->r_symbolnum-1].offset
3958 - sections[reloc->r_symbolnum-1].addr
3965 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3966 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3967 void *symbolAddress = lookupSymbol(nm);
3970 errorBelch("\nunknown symbol `%s'", nm);
3976 #ifdef powerpc_HOST_ARCH
3977 // In the .o file, this should be a relative jump to NULL
3978 // and we'll change it to a relative jump to the symbol
3979 ASSERT(-word == reloc->r_address);
3980 jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,(unsigned long) symbolAddress);
3983 offsetToJumpIsland = word + jumpIsland
3984 - (((long)image) + sect->offset - sect->addr);
3987 word += (unsigned long) symbolAddress
3988 - (((long)image) + sect->offset - sect->addr);
3992 word += (unsigned long) symbolAddress;
3996 if(reloc->r_type == GENERIC_RELOC_VANILLA)
4001 #ifdef powerpc_HOST_ARCH
4002 else if(reloc->r_type == PPC_RELOC_LO16)
4004 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4007 else if(reloc->r_type == PPC_RELOC_HI16)
4009 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4012 else if(reloc->r_type == PPC_RELOC_HA16)
4014 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4015 + ((word & (1<<15)) ? 1 : 0);
4018 else if(reloc->r_type == PPC_RELOC_BR24)
4020 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4022 // The branch offset is too large.
4023 // Therefore, we try to use a jump island.
4026 barf("unconditional relative branch out of range: "
4027 "no jump island available");
4030 word = offsetToJumpIsland;
4031 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4032 barf("unconditional relative branch out of range: "
4033 "jump island out of range");
4035 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
4040 barf("\nunknown relocation %d",reloc->r_type);
4047 static int ocGetNames_MachO(ObjectCode* oc)
4049 char *image = (char*) oc->image;
4050 struct mach_header *header = (struct mach_header*) image;
4051 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4052 unsigned i,curSymbol = 0;
4053 struct segment_command *segLC = NULL;
4054 struct section *sections;
4055 struct symtab_command *symLC = NULL;
4056 struct nlist *nlist;
4057 unsigned long commonSize = 0;
4058 char *commonStorage = NULL;
4059 unsigned long commonCounter;
4061 for(i=0;i<header->ncmds;i++)
4063 if(lc->cmd == LC_SEGMENT)
4064 segLC = (struct segment_command*) lc;
4065 else if(lc->cmd == LC_SYMTAB)
4066 symLC = (struct symtab_command*) lc;
4067 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4070 sections = (struct section*) (segLC+1);
4071 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4074 for(i=0;i<segLC->nsects;i++)
4076 if(sections[i].size == 0)
4079 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
4081 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
4082 "ocGetNames_MachO(common symbols)");
4083 sections[i].offset = zeroFillArea - image;
4086 if(!strcmp(sections[i].sectname,"__text"))
4087 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
4088 (void*) (image + sections[i].offset),
4089 (void*) (image + sections[i].offset + sections[i].size));
4090 else if(!strcmp(sections[i].sectname,"__const"))
4091 addSection(oc, SECTIONKIND_RWDATA,
4092 (void*) (image + sections[i].offset),
4093 (void*) (image + sections[i].offset + sections[i].size));
4094 else if(!strcmp(sections[i].sectname,"__data"))
4095 addSection(oc, SECTIONKIND_RWDATA,
4096 (void*) (image + sections[i].offset),
4097 (void*) (image + sections[i].offset + sections[i].size));
4098 else if(!strcmp(sections[i].sectname,"__bss")
4099 || !strcmp(sections[i].sectname,"__common"))
4100 addSection(oc, SECTIONKIND_RWDATA,
4101 (void*) (image + sections[i].offset),
4102 (void*) (image + sections[i].offset + sections[i].size));
4104 addProddableBlock(oc, (void*) (image + sections[i].offset),
4108 // count external symbols defined here
4112 for(i=0;i<symLC->nsyms;i++)
4114 if(nlist[i].n_type & N_STAB)
4116 else if(nlist[i].n_type & N_EXT)
4118 if((nlist[i].n_type & N_TYPE) == N_UNDF
4119 && (nlist[i].n_value != 0))
4121 commonSize += nlist[i].n_value;
4124 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4129 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
4130 "ocGetNames_MachO(oc->symbols)");
4134 for(i=0;i<symLC->nsyms;i++)
4136 if(nlist[i].n_type & N_STAB)
4138 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4140 if(nlist[i].n_type & N_EXT)
4142 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4143 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4145 + sections[nlist[i].n_sect-1].offset
4146 - sections[nlist[i].n_sect-1].addr
4147 + nlist[i].n_value);
4148 oc->symbols[curSymbol++] = nm;
4152 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4153 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm,
4155 + sections[nlist[i].n_sect-1].offset
4156 - sections[nlist[i].n_sect-1].addr
4157 + nlist[i].n_value);
4163 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
4164 commonCounter = (unsigned long)commonStorage;
4167 for(i=0;i<symLC->nsyms;i++)
4169 if((nlist[i].n_type & N_TYPE) == N_UNDF
4170 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
4172 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4173 unsigned long sz = nlist[i].n_value;
4175 nlist[i].n_value = commonCounter;
4177 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4178 (void*)commonCounter);
4179 oc->symbols[curSymbol++] = nm;
4181 commonCounter += sz;
4188 static int ocResolve_MachO(ObjectCode* oc)
4190 char *image = (char*) oc->image;
4191 struct mach_header *header = (struct mach_header*) image;
4192 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4194 struct segment_command *segLC = NULL;
4195 struct section *sections;
4196 struct symtab_command *symLC = NULL;
4197 struct dysymtab_command *dsymLC = NULL;
4198 struct nlist *nlist;
4200 for(i=0;i<header->ncmds;i++)
4202 if(lc->cmd == LC_SEGMENT)
4203 segLC = (struct segment_command*) lc;
4204 else if(lc->cmd == LC_SYMTAB)
4205 symLC = (struct symtab_command*) lc;
4206 else if(lc->cmd == LC_DYSYMTAB)
4207 dsymLC = (struct dysymtab_command*) lc;
4208 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4211 sections = (struct section*) (segLC+1);
4212 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4217 unsigned long *indirectSyms
4218 = (unsigned long*) (image + dsymLC->indirectsymoff);
4220 for(i=0;i<segLC->nsects;i++)
4222 if( !strcmp(sections[i].sectname,"__la_symbol_ptr")
4223 || !strcmp(sections[i].sectname,"__la_sym_ptr2")
4224 || !strcmp(sections[i].sectname,"__la_sym_ptr3"))
4226 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
4229 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr")
4230 || !strcmp(sections[i].sectname,"__pointers"))
4232 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
4235 else if(!strcmp(sections[i].sectname,"__jump_table"))
4237 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
4243 for(i=0;i<segLC->nsects;i++)
4245 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
4249 /* Free the local symbol table; we won't need it again. */
4250 freeHashTable(oc->lochash, NULL);
4253 #if defined (powerpc_HOST_ARCH)
4254 ocFlushInstructionCache( oc );
4260 #ifdef powerpc_HOST_ARCH
4262 * The Mach-O object format uses leading underscores. But not everywhere.
4263 * There is a small number of runtime support functions defined in
4264 * libcc_dynamic.a whose name does not have a leading underscore.
4265 * As a consequence, we can't get their address from C code.
4266 * We have to use inline assembler just to take the address of a function.
4270 static void machoInitSymbolsWithoutUnderscore()
4272 extern void* symbolsWithoutUnderscore[];
4273 void **p = symbolsWithoutUnderscore;
4274 __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
4278 __asm__ volatile(".long " # x);
4280 RTS_MACHO_NOUNDERLINE_SYMBOLS
4282 __asm__ volatile(".text");
4286 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
4288 RTS_MACHO_NOUNDERLINE_SYMBOLS
4295 * Figure out by how much to shift the entire Mach-O file in memory
4296 * when loading so that its single segment ends up 16-byte-aligned
4298 static int machoGetMisalignment( FILE * f )
4300 struct mach_header header;
4303 fread(&header, sizeof(header), 1, f);
4306 if(header.magic != MH_MAGIC)
4309 misalignment = (header.sizeofcmds + sizeof(header))
4312 return misalignment ? (16 - misalignment) : 0;