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) \
495 SymX(forkOS_createThread) \
496 SymX(freeHaskellFunctionPtr) \
497 SymX(freeStablePtr) \
498 SymX(gcdIntegerzh_fast) \
499 SymX(gcdIntegerIntzh_fast) \
500 SymX(gcdIntzh_fast) \
509 SymX(hs_perform_gc) \
510 SymX(hs_free_stable_ptr) \
511 SymX(hs_free_fun_ptr) \
513 SymX(int2Integerzh_fast) \
514 SymX(integer2Intzh_fast) \
515 SymX(integer2Wordzh_fast) \
516 SymX(isCurrentThreadBoundzh_fast) \
517 SymX(isDoubleDenormalized) \
518 SymX(isDoubleInfinite) \
520 SymX(isDoubleNegativeZero) \
521 SymX(isEmptyMVarzh_fast) \
522 SymX(isFloatDenormalized) \
523 SymX(isFloatInfinite) \
525 SymX(isFloatNegativeZero) \
526 SymX(killThreadzh_fast) \
529 SymX(makeStablePtrzh_fast) \
530 SymX(minusIntegerzh_fast) \
531 SymX(mkApUpd0zh_fast) \
532 SymX(myThreadIdzh_fast) \
533 SymX(labelThreadzh_fast) \
534 SymX(newArrayzh_fast) \
535 SymX(newBCOzh_fast) \
536 SymX(newByteArrayzh_fast) \
537 SymX_redirect(newCAF, newDynCAF) \
538 SymX(newMVarzh_fast) \
539 SymX(newMutVarzh_fast) \
540 SymX(newTVarzh_fast) \
541 SymX(atomicModifyMutVarzh_fast) \
542 SymX(newPinnedByteArrayzh_fast) \
544 SymX(orIntegerzh_fast) \
546 SymX(performMajorGC) \
547 SymX(plusIntegerzh_fast) \
550 SymX(putMVarzh_fast) \
551 SymX(quotIntegerzh_fast) \
552 SymX(quotRemIntegerzh_fast) \
554 SymX(raiseIOzh_fast) \
555 SymX(readTVarzh_fast) \
556 SymX(remIntegerzh_fast) \
557 SymX(resetNonBlockingFd) \
562 SymX(rts_checkSchedStatus) \
565 SymX(rts_evalLazyIO) \
566 SymX(rts_evalStableIO) \
570 SymX(rts_getDouble) \
575 SymX(rts_getFunPtr) \
576 SymX(rts_getStablePtr) \
577 SymX(rts_getThreadId) \
579 SymX(rts_getWord32) \
592 SymX(rts_mkStablePtr) \
600 SymX(rtsSupportsBoundThreads) \
601 SymX(__hscore_get_saved_termios) \
602 SymX(__hscore_set_saved_termios) \
604 SymX(startupHaskell) \
605 SymX(shutdownHaskell) \
606 SymX(shutdownHaskellAndExit) \
607 SymX(stable_ptr_table) \
608 SymX(stackOverflow) \
609 SymX(stg_CAF_BLACKHOLE_info) \
610 SymX(awakenBlockedQueue) \
611 SymX(stg_CHARLIKE_closure) \
612 SymX(stg_EMPTY_MVAR_info) \
613 SymX(stg_IND_STATIC_info) \
614 SymX(stg_INTLIKE_closure) \
615 SymX(stg_MUT_ARR_PTRS_DIRTY_info) \
616 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
617 SymX(stg_MUT_ARR_PTRS_FROZEN0_info) \
618 SymX(stg_WEAK_info) \
619 SymX(stg_ap_v_info) \
620 SymX(stg_ap_f_info) \
621 SymX(stg_ap_d_info) \
622 SymX(stg_ap_l_info) \
623 SymX(stg_ap_n_info) \
624 SymX(stg_ap_p_info) \
625 SymX(stg_ap_pv_info) \
626 SymX(stg_ap_pp_info) \
627 SymX(stg_ap_ppv_info) \
628 SymX(stg_ap_ppp_info) \
629 SymX(stg_ap_pppv_info) \
630 SymX(stg_ap_pppp_info) \
631 SymX(stg_ap_ppppp_info) \
632 SymX(stg_ap_pppppp_info) \
633 SymX(stg_ap_0_fast) \
634 SymX(stg_ap_v_fast) \
635 SymX(stg_ap_f_fast) \
636 SymX(stg_ap_d_fast) \
637 SymX(stg_ap_l_fast) \
638 SymX(stg_ap_n_fast) \
639 SymX(stg_ap_p_fast) \
640 SymX(stg_ap_pv_fast) \
641 SymX(stg_ap_pp_fast) \
642 SymX(stg_ap_ppv_fast) \
643 SymX(stg_ap_ppp_fast) \
644 SymX(stg_ap_pppv_fast) \
645 SymX(stg_ap_pppp_fast) \
646 SymX(stg_ap_ppppp_fast) \
647 SymX(stg_ap_pppppp_fast) \
648 SymX(stg_ap_1_upd_info) \
649 SymX(stg_ap_2_upd_info) \
650 SymX(stg_ap_3_upd_info) \
651 SymX(stg_ap_4_upd_info) \
652 SymX(stg_ap_5_upd_info) \
653 SymX(stg_ap_6_upd_info) \
654 SymX(stg_ap_7_upd_info) \
656 SymX(stg_sel_0_upd_info) \
657 SymX(stg_sel_10_upd_info) \
658 SymX(stg_sel_11_upd_info) \
659 SymX(stg_sel_12_upd_info) \
660 SymX(stg_sel_13_upd_info) \
661 SymX(stg_sel_14_upd_info) \
662 SymX(stg_sel_15_upd_info) \
663 SymX(stg_sel_1_upd_info) \
664 SymX(stg_sel_2_upd_info) \
665 SymX(stg_sel_3_upd_info) \
666 SymX(stg_sel_4_upd_info) \
667 SymX(stg_sel_5_upd_info) \
668 SymX(stg_sel_6_upd_info) \
669 SymX(stg_sel_7_upd_info) \
670 SymX(stg_sel_8_upd_info) \
671 SymX(stg_sel_9_upd_info) \
672 SymX(stg_upd_frame_info) \
673 SymX(suspendThread) \
674 SymX(takeMVarzh_fast) \
675 SymX(timesIntegerzh_fast) \
676 SymX(tryPutMVarzh_fast) \
677 SymX(tryTakeMVarzh_fast) \
678 SymX(unblockAsyncExceptionszh_fast) \
680 SymX(unsafeThawArrayzh_fast) \
681 SymX(waitReadzh_fast) \
682 SymX(waitWritezh_fast) \
683 SymX(word2Integerzh_fast) \
684 SymX(writeTVarzh_fast) \
685 SymX(xorIntegerzh_fast) \
687 SymX(stg_interp_constr_entry) \
688 SymX(stg_interp_constr1_entry) \
689 SymX(stg_interp_constr2_entry) \
690 SymX(stg_interp_constr3_entry) \
691 SymX(stg_interp_constr4_entry) \
692 SymX(stg_interp_constr5_entry) \
693 SymX(stg_interp_constr6_entry) \
694 SymX(stg_interp_constr7_entry) \
695 SymX(stg_interp_constr8_entry) \
696 SymX(stgMallocBytesRWX) \
697 SymX(getAllocations) \
700 RTS_USER_SIGNALS_SYMBOLS
702 #ifdef SUPPORT_LONG_LONGS
703 #define RTS_LONG_LONG_SYMS \
704 SymX(int64ToIntegerzh_fast) \
705 SymX(word64ToIntegerzh_fast)
707 #define RTS_LONG_LONG_SYMS /* nothing */
710 // 64-bit support functions in libgcc.a
711 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
712 #define RTS_LIBGCC_SYMBOLS \
722 #elif defined(ia64_HOST_ARCH)
723 #define RTS_LIBGCC_SYMBOLS \
731 #define RTS_LIBGCC_SYMBOLS
734 #if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
735 // Symbols that don't have a leading underscore
736 // on Mac OS X. They have to receive special treatment,
737 // see machoInitSymbolsWithoutUnderscore()
738 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
743 /* entirely bogus claims about types of these symbols */
744 #define Sym(vvv) extern void vvv(void);
745 #define SymX(vvv) /**/
746 #define SymX_redirect(vvv,xxx) /**/
750 RTS_POSIX_ONLY_SYMBOLS
751 RTS_MINGW_ONLY_SYMBOLS
752 RTS_CYGWIN_ONLY_SYMBOLS
753 RTS_DARWIN_ONLY_SYMBOLS
759 #ifdef LEADING_UNDERSCORE
760 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
762 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
765 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
767 #define SymX(vvv) Sym(vvv)
769 // SymX_redirect allows us to redirect references to one symbol to
770 // another symbol. See newCAF/newDynCAF for an example.
771 #define SymX_redirect(vvv,xxx) \
772 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
775 static RtsSymbolVal rtsSyms[] = {
779 RTS_POSIX_ONLY_SYMBOLS
780 RTS_MINGW_ONLY_SYMBOLS
781 RTS_CYGWIN_ONLY_SYMBOLS
783 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
784 // dyld stub code contains references to this,
785 // but it should never be called because we treat
786 // lazy pointers as nonlazy.
787 { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
789 { 0, 0 } /* sentinel */
792 /* -----------------------------------------------------------------------------
793 * Insert symbols into hash tables, checking for duplicates.
795 static void ghciInsertStrHashTable ( char* obj_name,
801 if (lookupHashTable(table, (StgWord)key) == NULL)
803 insertStrHashTable(table, (StgWord)key, data);
808 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
810 "whilst processing object file\n"
812 "This could be caused by:\n"
813 " * Loading two different object files which export the same symbol\n"
814 " * Specifying the same object file twice on the GHCi command line\n"
815 " * An incorrect `package.conf' entry, causing some object to be\n"
817 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
826 /* -----------------------------------------------------------------------------
827 * initialize the object linker
831 static int linker_init_done = 0 ;
833 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
834 static void *dl_prog_handle;
837 /* dlopen(NULL,..) doesn't work so we grab libc explicitly */
838 #if defined(openbsd_HOST_OS)
839 static void *dl_libc_handle;
847 /* Make initLinker idempotent, so we can call it
848 before evey relevant operation; that means we
849 don't need to initialise the linker separately */
850 if (linker_init_done == 1) { return; } else {
851 linker_init_done = 1;
854 symhash = allocStrHashTable();
856 /* populate the symbol table with stuff from the RTS */
857 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
858 ghciInsertStrHashTable("(GHCi built-in symbols)",
859 symhash, sym->lbl, sym->addr);
861 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
862 machoInitSymbolsWithoutUnderscore();
865 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
866 # if defined(RTLD_DEFAULT)
867 dl_prog_handle = RTLD_DEFAULT;
869 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
870 # if defined(openbsd_HOST_OS)
871 dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
873 # endif /* RTLD_DEFAULT */
877 /* -----------------------------------------------------------------------------
878 * Loading DLL or .so dynamic libraries
879 * -----------------------------------------------------------------------------
881 * Add a DLL from which symbols may be found. In the ELF case, just
882 * do RTLD_GLOBAL-style add, so no further messing around needs to
883 * happen in order that symbols in the loaded .so are findable --
884 * lookupSymbol() will subsequently see them by dlsym on the program's
885 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
887 * In the PEi386 case, open the DLLs and put handles to them in a
888 * linked list. When looking for a symbol, try all handles in the
889 * list. This means that we need to load even DLLs that are guaranteed
890 * to be in the ghc.exe image already, just so we can get a handle
891 * to give to loadSymbol, so that we can find the symbols. For such
892 * libraries, the LoadLibrary call should be a no-op except for returning
897 #if defined(OBJFORMAT_PEi386)
898 /* A record for storing handles into DLLs. */
903 struct _OpenedDLL* next;
908 /* A list thereof. */
909 static OpenedDLL* opened_dlls = NULL;
913 addDLL( char *dll_name )
915 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
916 /* ------------------- ELF DLL loader ------------------- */
922 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
925 /* dlopen failed; return a ptr to the error msg. */
927 if (errmsg == NULL) errmsg = "addDLL: unknown error";
934 # elif defined(OBJFORMAT_PEi386)
935 /* ------------------- Win32 DLL loader ------------------- */
943 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
945 /* See if we've already got it, and ignore if so. */
946 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
947 if (0 == strcmp(o_dll->name, dll_name))
951 /* The file name has no suffix (yet) so that we can try
952 both foo.dll and foo.drv
954 The documentation for LoadLibrary says:
955 If no file name extension is specified in the lpFileName
956 parameter, the default library extension .dll is
957 appended. However, the file name string can include a trailing
958 point character (.) to indicate that the module name has no
961 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
962 sprintf(buf, "%s.DLL", dll_name);
963 instance = LoadLibrary(buf);
964 if (instance == NULL) {
965 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
966 instance = LoadLibrary(buf);
967 if (instance == NULL) {
970 /* LoadLibrary failed; return a ptr to the error msg. */
971 return "addDLL: unknown error";
976 /* Add this DLL to the list of DLLs in which to search for symbols. */
977 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
978 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
979 strcpy(o_dll->name, dll_name);
980 o_dll->instance = instance;
981 o_dll->next = opened_dlls;
986 barf("addDLL: not implemented on this platform");
990 /* -----------------------------------------------------------------------------
991 * lookup a symbol in the hash table
994 lookupSymbol( char *lbl )
998 ASSERT(symhash != NULL);
999 val = lookupStrHashTable(symhash, lbl);
1002 # if defined(OBJFORMAT_ELF)
1003 # if defined(openbsd_HOST_OS)
1004 val = dlsym(dl_prog_handle, lbl);
1005 return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
1006 # elif defined(x86_64_HOST_ARCH)
1007 val = dlsym(dl_prog_handle, lbl);
1008 if (val >= (void *)0x80000000) {
1010 new_val = x86_64_high_symbol(lbl, val);
1011 IF_DEBUG(linker,debugBelch("lookupSymbol: relocating out of range symbol: %s = %p, now %p\n", lbl, val, new_val));
1016 # else /* not openbsd */
1017 return dlsym(dl_prog_handle, lbl);
1019 # elif defined(OBJFORMAT_MACHO)
1020 if(NSIsSymbolNameDefined(lbl)) {
1021 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
1022 return NSAddressOfSymbol(symbol);
1026 # elif defined(OBJFORMAT_PEi386)
1029 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1030 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
1031 if (lbl[0] == '_') {
1032 /* HACK: if the name has an initial underscore, try stripping
1033 it off & look that up first. I've yet to verify whether there's
1034 a Rule that governs whether an initial '_' *should always* be
1035 stripped off when mapping from import lib name to the DLL name.
1037 sym = GetProcAddress(o_dll->instance, (lbl+1));
1039 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
1043 sym = GetProcAddress(o_dll->instance, lbl);
1045 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
1060 __attribute((unused))
1062 lookupLocalSymbol( ObjectCode* oc, char *lbl )
1066 val = lookupStrHashTable(oc->lochash, lbl);
1076 /* -----------------------------------------------------------------------------
1077 * Debugging aid: look in GHCi's object symbol tables for symbols
1078 * within DELTA bytes of the specified address, and show their names.
1081 void ghci_enquire ( char* addr );
1083 void ghci_enquire ( char* addr )
1088 const int DELTA = 64;
1093 for (oc = objects; oc; oc = oc->next) {
1094 for (i = 0; i < oc->n_symbols; i++) {
1095 sym = oc->symbols[i];
1096 if (sym == NULL) continue;
1097 // debugBelch("enquire %p %p\n", sym, oc->lochash);
1099 if (oc->lochash != NULL) {
1100 a = lookupStrHashTable(oc->lochash, sym);
1103 a = lookupStrHashTable(symhash, sym);
1106 // debugBelch("ghci_enquire: can't find %s\n", sym);
1108 else if (addr-DELTA <= a && a <= addr+DELTA) {
1109 debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym);
1116 #ifdef ia64_HOST_ARCH
1117 static unsigned int PLTSize(void);
1120 /* -----------------------------------------------------------------------------
1121 * Load an obj (populate the global symbol table, but don't resolve yet)
1123 * Returns: 1 if ok, 0 on error.
1126 loadObj( char *path )
1133 void *map_addr = NULL;
1140 /* debugBelch("loadObj %s\n", path ); */
1142 /* Check that we haven't already loaded this object.
1143 Ignore requests to load multiple times */
1147 for (o = objects; o; o = o->next) {
1148 if (0 == strcmp(o->fileName, path)) {
1150 break; /* don't need to search further */
1154 IF_DEBUG(linker, debugBelch(
1155 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1156 "same object file twice:\n"
1158 "GHCi will ignore this, but be warned.\n"
1160 return 1; /* success */
1164 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1166 # if defined(OBJFORMAT_ELF)
1167 oc->formatName = "ELF";
1168 # elif defined(OBJFORMAT_PEi386)
1169 oc->formatName = "PEi386";
1170 # elif defined(OBJFORMAT_MACHO)
1171 oc->formatName = "Mach-O";
1174 barf("loadObj: not implemented on this platform");
1177 r = stat(path, &st);
1178 if (r == -1) { return 0; }
1180 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1181 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1182 strcpy(oc->fileName, path);
1184 oc->fileSize = st.st_size;
1186 oc->sections = NULL;
1187 oc->lochash = allocStrHashTable();
1188 oc->proddables = NULL;
1190 /* chain it onto the list of objects */
1195 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1197 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1199 #if defined(openbsd_HOST_OS)
1200 fd = open(path, O_RDONLY, S_IRUSR);
1202 fd = open(path, O_RDONLY);
1205 barf("loadObj: can't open `%s'", path);
1207 pagesize = getpagesize();
1209 #ifdef ia64_HOST_ARCH
1210 /* The PLT needs to be right before the object */
1211 n = ROUND_UP(PLTSize(), pagesize);
1212 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1213 if (oc->plt == MAP_FAILED)
1214 barf("loadObj: can't allocate PLT");
1217 map_addr = oc->plt + n;
1220 n = ROUND_UP(oc->fileSize, pagesize);
1222 /* Link objects into the lower 2Gb on x86_64. GHC assumes the
1223 * small memory model on this architecture (see gcc docs,
1226 #ifdef x86_64_HOST_ARCH
1227 #define EXTRA_MAP_FLAGS MAP_32BIT
1229 #define EXTRA_MAP_FLAGS 0
1232 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE,
1233 MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
1234 if (oc->image == MAP_FAILED)
1235 barf("loadObj: can't map `%s'", path);
1239 #else /* !USE_MMAP */
1241 /* load the image into memory */
1242 f = fopen(path, "rb");
1244 barf("loadObj: can't read `%s'", path);
1246 #ifdef darwin_HOST_OS
1247 // In a Mach-O .o file, all sections can and will be misaligned
1248 // if the total size of the headers is not a multiple of the
1249 // desired alignment. This is fine for .o files that only serve
1250 // as input for the static linker, but it's not fine for us,
1251 // as SSE (used by gcc for floating point) and Altivec require
1252 // 16-byte alignment.
1253 // We calculate the correct alignment from the header before
1254 // reading the file, and then we misalign oc->image on purpose so
1255 // that the actual sections end up aligned again.
1256 misalignment = machoGetMisalignment(f);
1257 oc->misalignment = misalignment;
1262 oc->image = stgMallocBytes(oc->fileSize + misalignment, "loadObj(image)");
1263 oc->image += misalignment;
1265 n = fread ( oc->image, 1, oc->fileSize, f );
1266 if (n != oc->fileSize)
1267 barf("loadObj: error whilst reading `%s'", path);
1271 #endif /* USE_MMAP */
1273 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
1274 r = ocAllocateJumpIslands_MachO ( oc );
1275 if (!r) { return r; }
1276 # elif defined(OBJFORMAT_ELF) && defined(powerpc_HOST_ARCH)
1277 r = ocAllocateJumpIslands_ELF ( oc );
1278 if (!r) { return r; }
1281 /* verify the in-memory image */
1282 # if defined(OBJFORMAT_ELF)
1283 r = ocVerifyImage_ELF ( oc );
1284 # elif defined(OBJFORMAT_PEi386)
1285 r = ocVerifyImage_PEi386 ( oc );
1286 # elif defined(OBJFORMAT_MACHO)
1287 r = ocVerifyImage_MachO ( oc );
1289 barf("loadObj: no verify method");
1291 if (!r) { return r; }
1293 /* build the symbol list for this image */
1294 # if defined(OBJFORMAT_ELF)
1295 r = ocGetNames_ELF ( oc );
1296 # elif defined(OBJFORMAT_PEi386)
1297 r = ocGetNames_PEi386 ( oc );
1298 # elif defined(OBJFORMAT_MACHO)
1299 r = ocGetNames_MachO ( oc );
1301 barf("loadObj: no getNames method");
1303 if (!r) { return r; }
1305 /* loaded, but not resolved yet */
1306 oc->status = OBJECT_LOADED;
1311 /* -----------------------------------------------------------------------------
1312 * resolve all the currently unlinked objects in memory
1314 * Returns: 1 if ok, 0 on error.
1324 for (oc = objects; oc; oc = oc->next) {
1325 if (oc->status != OBJECT_RESOLVED) {
1326 # if defined(OBJFORMAT_ELF)
1327 r = ocResolve_ELF ( oc );
1328 # elif defined(OBJFORMAT_PEi386)
1329 r = ocResolve_PEi386 ( oc );
1330 # elif defined(OBJFORMAT_MACHO)
1331 r = ocResolve_MachO ( oc );
1333 barf("resolveObjs: not implemented on this platform");
1335 if (!r) { return r; }
1336 oc->status = OBJECT_RESOLVED;
1342 /* -----------------------------------------------------------------------------
1343 * delete an object from the pool
1346 unloadObj( char *path )
1348 ObjectCode *oc, *prev;
1350 ASSERT(symhash != NULL);
1351 ASSERT(objects != NULL);
1356 for (oc = objects; oc; prev = oc, oc = oc->next) {
1357 if (!strcmp(oc->fileName,path)) {
1359 /* Remove all the mappings for the symbols within this
1364 for (i = 0; i < oc->n_symbols; i++) {
1365 if (oc->symbols[i] != NULL) {
1366 removeStrHashTable(symhash, oc->symbols[i], NULL);
1374 prev->next = oc->next;
1377 /* We're going to leave this in place, in case there are
1378 any pointers from the heap into it: */
1379 /* stgFree(oc->image); */
1380 stgFree(oc->fileName);
1381 stgFree(oc->symbols);
1382 stgFree(oc->sections);
1383 /* The local hash table should have been freed at the end
1384 of the ocResolve_ call on it. */
1385 ASSERT(oc->lochash == NULL);
1391 errorBelch("unloadObj: can't find `%s' to unload", path);
1395 /* -----------------------------------------------------------------------------
1396 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1397 * which may be prodded during relocation, and abort if we try and write
1398 * outside any of these.
1400 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1403 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1404 /* debugBelch("aPB %p %p %d\n", oc, start, size); */
1408 pb->next = oc->proddables;
1409 oc->proddables = pb;
1412 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1415 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1416 char* s = (char*)(pb->start);
1417 char* e = s + pb->size - 1;
1418 char* a = (char*)addr;
1419 /* Assumes that the biggest fixup involves a 4-byte write. This
1420 probably needs to be changed to 8 (ie, +7) on 64-bit
1422 if (a >= s && (a+3) <= e) return;
1424 barf("checkProddableBlock: invalid fixup in runtime linker");
1427 /* -----------------------------------------------------------------------------
1428 * Section management.
1430 static void addSection ( ObjectCode* oc, SectionKind kind,
1431 void* start, void* end )
1433 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1437 s->next = oc->sections;
1440 debugBelch("addSection: %p-%p (size %d), kind %d\n",
1441 start, ((char*)end)-1, end - start + 1, kind );
1446 /* --------------------------------------------------------------------------
1447 * PowerPC specifics (jump islands)
1448 * ------------------------------------------------------------------------*/
1450 #if defined(powerpc_HOST_ARCH)
1453 ocAllocateJumpIslands
1455 Allocate additional space at the end of the object file image to make room
1458 PowerPC relative branch instructions have a 24 bit displacement field.
1459 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
1460 If a particular imported symbol is outside this range, we have to redirect
1461 the jump to a short piece of new code that just loads the 32bit absolute
1462 address and jumps there.
1463 This function just allocates space for one 16 byte ppcJumpIsland for every
1464 undefined symbol in the object file. The code for the islands is filled in by
1465 makeJumpIsland below.
1468 static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first )
1474 int misalignment = 0;
1476 misalignment = oc->misalignment;
1481 // round up to the nearest 4
1482 aligned = (oc->fileSize + 3) & ~3;
1485 #ifndef linux_HOST_OS /* mremap is a linux extension */
1486 #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined
1489 pagesize = getpagesize();
1490 n = ROUND_UP( oc->fileSize, pagesize );
1491 m = ROUND_UP( aligned + sizeof (ppcJumpIsland) * count, pagesize );
1493 /* If we have a half-page-size file and map one page of it then
1494 * the part of the page after the size of the file remains accessible.
1495 * If, however, we map in 2 pages, the 2nd page is not accessible
1496 * and will give a "Bus Error" on access. To get around this, we check
1497 * if we need any extra pages for the jump islands and map them in
1498 * anonymously. We must check that we actually require extra pages
1499 * otherwise the attempt to mmap 0 pages of anonymous memory will
1505 /* The effect of this mremap() call is only the ensure that we have
1506 * a sufficient number of virtually contiguous pages. As returned from
1507 * mremap, the pages past the end of the file are not backed. We give
1508 * them a backing by using MAP_FIXED to map in anonymous pages.
1510 oc->image = mremap( oc->image, n, m, MREMAP_MAYMOVE );
1512 if( oc->image == MAP_FAILED )
1514 errorBelch( "Unable to mremap for Jump Islands\n" );
1518 if( mmap( oc->image + n, m - n, PROT_READ | PROT_WRITE | PROT_EXEC,
1519 MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, 0, 0 ) == MAP_FAILED )
1521 errorBelch( "Unable to mmap( MAP_FIXED ) for Jump Islands\n" );
1527 oc->image -= misalignment;
1528 oc->image = stgReallocBytes( oc->image,
1530 aligned + sizeof (ppcJumpIsland) * count,
1531 "ocAllocateJumpIslands" );
1532 oc->image += misalignment;
1533 #endif /* USE_MMAP */
1535 oc->jump_islands = (ppcJumpIsland *) (oc->image + aligned);
1536 memset( oc->jump_islands, 0, sizeof (ppcJumpIsland) * count );
1539 oc->jump_islands = NULL;
1541 oc->island_start_symbol = first;
1542 oc->n_islands = count;
1547 static unsigned long makeJumpIsland( ObjectCode* oc,
1548 unsigned long symbolNumber,
1549 unsigned long target )
1551 ppcJumpIsland *island;
1553 if( symbolNumber < oc->island_start_symbol ||
1554 symbolNumber - oc->island_start_symbol > oc->n_islands)
1557 island = &oc->jump_islands[symbolNumber - oc->island_start_symbol];
1559 // lis r12, hi16(target)
1560 island->lis_r12 = 0x3d80;
1561 island->hi_addr = target >> 16;
1563 // ori r12, r12, lo16(target)
1564 island->ori_r12_r12 = 0x618c;
1565 island->lo_addr = target & 0xffff;
1568 island->mtctr_r12 = 0x7d8903a6;
1571 island->bctr = 0x4e800420;
1573 return (unsigned long) island;
1577 ocFlushInstructionCache
1579 Flush the data & instruction caches.
1580 Because the PPC has split data/instruction caches, we have to
1581 do that whenever we modify code at runtime.
1584 static void ocFlushInstructionCache( ObjectCode *oc )
1586 int n = (oc->fileSize + sizeof( ppcJumpIsland ) * oc->n_islands + 3) / 4;
1587 unsigned long *p = (unsigned long *) oc->image;
1591 __asm__ volatile ( "dcbf 0,%0\n\t"
1599 __asm__ volatile ( "sync\n\t"
1605 /* --------------------------------------------------------------------------
1606 * PEi386 specifics (Win32 targets)
1607 * ------------------------------------------------------------------------*/
1609 /* The information for this linker comes from
1610 Microsoft Portable Executable
1611 and Common Object File Format Specification
1612 revision 5.1 January 1998
1613 which SimonM says comes from the MS Developer Network CDs.
1615 It can be found there (on older CDs), but can also be found
1618 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1620 (this is Rev 6.0 from February 1999).
1622 Things move, so if that fails, try searching for it via
1624 http://www.google.com/search?q=PE+COFF+specification
1626 The ultimate reference for the PE format is the Winnt.h
1627 header file that comes with the Platform SDKs; as always,
1628 implementations will drift wrt their documentation.
1630 A good background article on the PE format is Matt Pietrek's
1631 March 1994 article in Microsoft System Journal (MSJ)
1632 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1633 Win32 Portable Executable File Format." The info in there
1634 has recently been updated in a two part article in
1635 MSDN magazine, issues Feb and March 2002,
1636 "Inside Windows: An In-Depth Look into the Win32 Portable
1637 Executable File Format"
1639 John Levine's book "Linkers and Loaders" contains useful
1644 #if defined(OBJFORMAT_PEi386)
1648 typedef unsigned char UChar;
1649 typedef unsigned short UInt16;
1650 typedef unsigned int UInt32;
1657 UInt16 NumberOfSections;
1658 UInt32 TimeDateStamp;
1659 UInt32 PointerToSymbolTable;
1660 UInt32 NumberOfSymbols;
1661 UInt16 SizeOfOptionalHeader;
1662 UInt16 Characteristics;
1666 #define sizeof_COFF_header 20
1673 UInt32 VirtualAddress;
1674 UInt32 SizeOfRawData;
1675 UInt32 PointerToRawData;
1676 UInt32 PointerToRelocations;
1677 UInt32 PointerToLinenumbers;
1678 UInt16 NumberOfRelocations;
1679 UInt16 NumberOfLineNumbers;
1680 UInt32 Characteristics;
1684 #define sizeof_COFF_section 40
1691 UInt16 SectionNumber;
1694 UChar NumberOfAuxSymbols;
1698 #define sizeof_COFF_symbol 18
1703 UInt32 VirtualAddress;
1704 UInt32 SymbolTableIndex;
1709 #define sizeof_COFF_reloc 10
1712 /* From PE spec doc, section 3.3.2 */
1713 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1714 windows.h -- for the same purpose, but I want to know what I'm
1716 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1717 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1718 #define MYIMAGE_FILE_DLL 0x2000
1719 #define MYIMAGE_FILE_SYSTEM 0x1000
1720 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1721 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1722 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1724 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1725 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1726 #define MYIMAGE_SYM_CLASS_STATIC 3
1727 #define MYIMAGE_SYM_UNDEFINED 0
1729 /* From PE spec doc, section 4.1 */
1730 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1731 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1732 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1734 /* From PE spec doc, section 5.2.1 */
1735 #define MYIMAGE_REL_I386_DIR32 0x0006
1736 #define MYIMAGE_REL_I386_REL32 0x0014
1739 /* We use myindex to calculate array addresses, rather than
1740 simply doing the normal subscript thing. That's because
1741 some of the above structs have sizes which are not
1742 a whole number of words. GCC rounds their sizes up to a
1743 whole number of words, which means that the address calcs
1744 arising from using normal C indexing or pointer arithmetic
1745 are just plain wrong. Sigh.
1748 myindex ( int scale, void* base, int index )
1751 ((UChar*)base) + scale * index;
1756 printName ( UChar* name, UChar* strtab )
1758 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1759 UInt32 strtab_offset = * (UInt32*)(name+4);
1760 debugBelch("%s", strtab + strtab_offset );
1763 for (i = 0; i < 8; i++) {
1764 if (name[i] == 0) break;
1765 debugBelch("%c", name[i] );
1772 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1774 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1775 UInt32 strtab_offset = * (UInt32*)(name+4);
1776 strncpy ( dst, strtab+strtab_offset, dstSize );
1782 if (name[i] == 0) break;
1792 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1795 /* If the string is longer than 8 bytes, look in the
1796 string table for it -- this will be correctly zero terminated.
1798 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1799 UInt32 strtab_offset = * (UInt32*)(name+4);
1800 return ((UChar*)strtab) + strtab_offset;
1802 /* Otherwise, if shorter than 8 bytes, return the original,
1803 which by defn is correctly terminated.
1805 if (name[7]==0) return name;
1806 /* The annoying case: 8 bytes. Copy into a temporary
1807 (which is never freed ...)
1809 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1811 strncpy(newstr,name,8);
1817 /* Just compares the short names (first 8 chars) */
1818 static COFF_section *
1819 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1823 = (COFF_header*)(oc->image);
1824 COFF_section* sectab
1826 ((UChar*)(oc->image))
1827 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1829 for (i = 0; i < hdr->NumberOfSections; i++) {
1832 COFF_section* section_i
1834 myindex ( sizeof_COFF_section, sectab, i );
1835 n1 = (UChar*) &(section_i->Name);
1837 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1838 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1839 n1[6]==n2[6] && n1[7]==n2[7])
1848 zapTrailingAtSign ( UChar* sym )
1850 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1852 if (sym[0] == 0) return;
1854 while (sym[i] != 0) i++;
1857 while (j > 0 && my_isdigit(sym[j])) j--;
1858 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1864 ocVerifyImage_PEi386 ( ObjectCode* oc )
1869 COFF_section* sectab;
1870 COFF_symbol* symtab;
1872 /* debugBelch("\nLOADING %s\n", oc->fileName); */
1873 hdr = (COFF_header*)(oc->image);
1874 sectab = (COFF_section*) (
1875 ((UChar*)(oc->image))
1876 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1878 symtab = (COFF_symbol*) (
1879 ((UChar*)(oc->image))
1880 + hdr->PointerToSymbolTable
1882 strtab = ((UChar*)symtab)
1883 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1885 if (hdr->Machine != 0x14c) {
1886 errorBelch("%s: Not x86 PEi386", oc->fileName);
1889 if (hdr->SizeOfOptionalHeader != 0) {
1890 errorBelch("%s: PEi386 with nonempty optional header", oc->fileName);
1893 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1894 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1895 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1896 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1897 errorBelch("%s: Not a PEi386 object file", oc->fileName);
1900 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1901 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1902 errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
1904 (int)(hdr->Characteristics));
1907 /* If the string table size is way crazy, this might indicate that
1908 there are more than 64k relocations, despite claims to the
1909 contrary. Hence this test. */
1910 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
1912 if ( (*(UInt32*)strtab) > 600000 ) {
1913 /* Note that 600k has no special significance other than being
1914 big enough to handle the almost-2MB-sized lumps that
1915 constitute HSwin32*.o. */
1916 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
1921 /* No further verification after this point; only debug printing. */
1923 IF_DEBUG(linker, i=1);
1924 if (i == 0) return 1;
1926 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1927 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1928 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1931 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1932 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1933 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1934 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1935 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1936 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1937 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1939 /* Print the section table. */
1941 for (i = 0; i < hdr->NumberOfSections; i++) {
1943 COFF_section* sectab_i
1945 myindex ( sizeof_COFF_section, sectab, i );
1952 printName ( sectab_i->Name, strtab );
1962 sectab_i->VirtualSize,
1963 sectab_i->VirtualAddress,
1964 sectab_i->SizeOfRawData,
1965 sectab_i->PointerToRawData,
1966 sectab_i->NumberOfRelocations,
1967 sectab_i->PointerToRelocations,
1968 sectab_i->PointerToRawData
1970 reltab = (COFF_reloc*) (
1971 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1974 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1975 /* If the relocation field (a short) has overflowed, the
1976 * real count can be found in the first reloc entry.
1978 * See Section 4.1 (last para) of the PE spec (rev6.0).
1980 COFF_reloc* rel = (COFF_reloc*)
1981 myindex ( sizeof_COFF_reloc, reltab, 0 );
1982 noRelocs = rel->VirtualAddress;
1985 noRelocs = sectab_i->NumberOfRelocations;
1989 for (; j < noRelocs; j++) {
1991 COFF_reloc* rel = (COFF_reloc*)
1992 myindex ( sizeof_COFF_reloc, reltab, j );
1994 " type 0x%-4x vaddr 0x%-8x name `",
1996 rel->VirtualAddress );
1997 sym = (COFF_symbol*)
1998 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1999 /* Hmm..mysterious looking offset - what's it for? SOF */
2000 printName ( sym->Name, strtab -10 );
2007 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
2008 debugBelch("---START of string table---\n");
2009 for (i = 4; i < *(Int32*)strtab; i++) {
2011 debugBelch("\n"); else
2012 debugBelch("%c", strtab[i] );
2014 debugBelch("--- END of string table---\n");
2019 COFF_symbol* symtab_i;
2020 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2021 symtab_i = (COFF_symbol*)
2022 myindex ( sizeof_COFF_symbol, symtab, i );
2028 printName ( symtab_i->Name, strtab );
2037 (Int32)(symtab_i->SectionNumber),
2038 (UInt32)symtab_i->Type,
2039 (UInt32)symtab_i->StorageClass,
2040 (UInt32)symtab_i->NumberOfAuxSymbols
2042 i += symtab_i->NumberOfAuxSymbols;
2052 ocGetNames_PEi386 ( ObjectCode* oc )
2055 COFF_section* sectab;
2056 COFF_symbol* symtab;
2063 hdr = (COFF_header*)(oc->image);
2064 sectab = (COFF_section*) (
2065 ((UChar*)(oc->image))
2066 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2068 symtab = (COFF_symbol*) (
2069 ((UChar*)(oc->image))
2070 + hdr->PointerToSymbolTable
2072 strtab = ((UChar*)(oc->image))
2073 + hdr->PointerToSymbolTable
2074 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2076 /* Allocate space for any (local, anonymous) .bss sections. */
2078 for (i = 0; i < hdr->NumberOfSections; i++) {
2081 COFF_section* sectab_i
2083 myindex ( sizeof_COFF_section, sectab, i );
2084 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
2085 /* sof 10/05: the PE spec text isn't too clear regarding what
2086 * the SizeOfRawData field is supposed to hold for object
2087 * file sections containing just uninitialized data -- for executables,
2088 * it is supposed to be zero; unclear what it's supposed to be
2089 * for object files. However, VirtualSize is guaranteed to be
2090 * zero for object files, which definitely suggests that SizeOfRawData
2091 * will be non-zero (where else would the size of this .bss section be
2092 * stored?) Looking at the COFF_section info for incoming object files,
2093 * this certainly appears to be the case.
2095 * => I suspect we've been incorrectly handling .bss sections in (relocatable)
2096 * object files up until now. This turned out to bite us with ghc-6.4.1's use
2097 * of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
2098 * variable decls into to the .bss section. (The specific function in Q which
2099 * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
2101 if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
2102 /* This is a non-empty .bss section. Allocate zeroed space for
2103 it, and set its PointerToRawData field such that oc->image +
2104 PointerToRawData == addr_of_zeroed_space. */
2105 bss_sz = sectab_i->VirtualSize;
2106 if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
2107 zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
2108 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
2109 addProddableBlock(oc, zspace, bss_sz);
2110 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
2113 /* Copy section information into the ObjectCode. */
2115 for (i = 0; i < hdr->NumberOfSections; i++) {
2121 = SECTIONKIND_OTHER;
2122 COFF_section* sectab_i
2124 myindex ( sizeof_COFF_section, sectab, i );
2125 IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
2128 /* I'm sure this is the Right Way to do it. However, the
2129 alternative of testing the sectab_i->Name field seems to
2130 work ok with Cygwin.
2132 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
2133 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
2134 kind = SECTIONKIND_CODE_OR_RODATA;
2137 if (0==strcmp(".text",sectab_i->Name) ||
2138 0==strcmp(".rdata",sectab_i->Name)||
2139 0==strcmp(".rodata",sectab_i->Name))
2140 kind = SECTIONKIND_CODE_OR_RODATA;
2141 if (0==strcmp(".data",sectab_i->Name) ||
2142 0==strcmp(".bss",sectab_i->Name))
2143 kind = SECTIONKIND_RWDATA;
2145 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
2146 sz = sectab_i->SizeOfRawData;
2147 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
2149 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
2150 end = start + sz - 1;
2152 if (kind == SECTIONKIND_OTHER
2153 /* Ignore sections called which contain stabs debugging
2155 && 0 != strcmp(".stab", sectab_i->Name)
2156 && 0 != strcmp(".stabstr", sectab_i->Name)
2157 /* ignore constructor section for now */
2158 && 0 != strcmp(".ctors", sectab_i->Name)
2160 errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
2164 if (kind != SECTIONKIND_OTHER && end >= start) {
2165 addSection(oc, kind, start, end);
2166 addProddableBlock(oc, start, end - start + 1);
2170 /* Copy exported symbols into the ObjectCode. */
2172 oc->n_symbols = hdr->NumberOfSymbols;
2173 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2174 "ocGetNames_PEi386(oc->symbols)");
2175 /* Call me paranoid; I don't care. */
2176 for (i = 0; i < oc->n_symbols; i++)
2177 oc->symbols[i] = NULL;
2181 COFF_symbol* symtab_i;
2182 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2183 symtab_i = (COFF_symbol*)
2184 myindex ( sizeof_COFF_symbol, symtab, i );
2188 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
2189 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
2190 /* This symbol is global and defined, viz, exported */
2191 /* for MYIMAGE_SYMCLASS_EXTERNAL
2192 && !MYIMAGE_SYM_UNDEFINED,
2193 the address of the symbol is:
2194 address of relevant section + offset in section
2196 COFF_section* sectabent
2197 = (COFF_section*) myindex ( sizeof_COFF_section,
2199 symtab_i->SectionNumber-1 );
2200 addr = ((UChar*)(oc->image))
2201 + (sectabent->PointerToRawData
2205 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
2206 && symtab_i->Value > 0) {
2207 /* This symbol isn't in any section at all, ie, global bss.
2208 Allocate zeroed space for it. */
2209 addr = stgCallocBytes(1, symtab_i->Value,
2210 "ocGetNames_PEi386(non-anonymous bss)");
2211 addSection(oc, SECTIONKIND_RWDATA, addr,
2212 ((UChar*)addr) + symtab_i->Value - 1);
2213 addProddableBlock(oc, addr, symtab_i->Value);
2214 /* debugBelch("BSS section at 0x%x\n", addr); */
2217 if (addr != NULL ) {
2218 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
2219 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
2220 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
2221 ASSERT(i >= 0 && i < oc->n_symbols);
2222 /* cstring_from_COFF_symbol_name always succeeds. */
2223 oc->symbols[i] = sname;
2224 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
2228 "IGNORING symbol %d\n"
2232 printName ( symtab_i->Name, strtab );
2241 (Int32)(symtab_i->SectionNumber),
2242 (UInt32)symtab_i->Type,
2243 (UInt32)symtab_i->StorageClass,
2244 (UInt32)symtab_i->NumberOfAuxSymbols
2249 i += symtab_i->NumberOfAuxSymbols;
2258 ocResolve_PEi386 ( ObjectCode* oc )
2261 COFF_section* sectab;
2262 COFF_symbol* symtab;
2272 /* ToDo: should be variable-sized? But is at least safe in the
2273 sense of buffer-overrun-proof. */
2275 /* debugBelch("resolving for %s\n", oc->fileName); */
2277 hdr = (COFF_header*)(oc->image);
2278 sectab = (COFF_section*) (
2279 ((UChar*)(oc->image))
2280 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2282 symtab = (COFF_symbol*) (
2283 ((UChar*)(oc->image))
2284 + hdr->PointerToSymbolTable
2286 strtab = ((UChar*)(oc->image))
2287 + hdr->PointerToSymbolTable
2288 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2290 for (i = 0; i < hdr->NumberOfSections; i++) {
2291 COFF_section* sectab_i
2293 myindex ( sizeof_COFF_section, sectab, i );
2296 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2299 /* Ignore sections called which contain stabs debugging
2301 if (0 == strcmp(".stab", sectab_i->Name)
2302 || 0 == strcmp(".stabstr", sectab_i->Name)
2303 || 0 == strcmp(".ctors", sectab_i->Name))
2306 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2307 /* If the relocation field (a short) has overflowed, the
2308 * real count can be found in the first reloc entry.
2310 * See Section 4.1 (last para) of the PE spec (rev6.0).
2312 * Nov2003 update: the GNU linker still doesn't correctly
2313 * handle the generation of relocatable object files with
2314 * overflown relocations. Hence the output to warn of potential
2317 COFF_reloc* rel = (COFF_reloc*)
2318 myindex ( sizeof_COFF_reloc, reltab, 0 );
2319 noRelocs = rel->VirtualAddress;
2321 /* 10/05: we now assume (and check for) a GNU ld that is capable
2322 * of handling object files with (>2^16) of relocs.
2325 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
2330 noRelocs = sectab_i->NumberOfRelocations;
2335 for (; j < noRelocs; j++) {
2337 COFF_reloc* reltab_j
2339 myindex ( sizeof_COFF_reloc, reltab, j );
2341 /* the location to patch */
2343 ((UChar*)(oc->image))
2344 + (sectab_i->PointerToRawData
2345 + reltab_j->VirtualAddress
2346 - sectab_i->VirtualAddress )
2348 /* the existing contents of pP */
2350 /* the symbol to connect to */
2351 sym = (COFF_symbol*)
2352 myindex ( sizeof_COFF_symbol,
2353 symtab, reltab_j->SymbolTableIndex );
2356 "reloc sec %2d num %3d: type 0x%-4x "
2357 "vaddr 0x%-8x name `",
2359 (UInt32)reltab_j->Type,
2360 reltab_j->VirtualAddress );
2361 printName ( sym->Name, strtab );
2362 debugBelch("'\n" ));
2364 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2365 COFF_section* section_sym
2366 = findPEi386SectionCalled ( oc, sym->Name );
2368 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
2371 S = ((UInt32)(oc->image))
2372 + (section_sym->PointerToRawData
2375 copyName ( sym->Name, strtab, symbol, 1000-1 );
2376 (void*)S = lookupLocalSymbol( oc, symbol );
2377 if ((void*)S != NULL) goto foundit;
2378 (void*)S = lookupSymbol( symbol );
2379 if ((void*)S != NULL) goto foundit;
2380 zapTrailingAtSign ( symbol );
2381 (void*)S = lookupLocalSymbol( oc, symbol );
2382 if ((void*)S != NULL) goto foundit;
2383 (void*)S = lookupSymbol( symbol );
2384 if ((void*)S != NULL) goto foundit;
2385 /* Newline first because the interactive linker has printed "linking..." */
2386 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2390 checkProddableBlock(oc, pP);
2391 switch (reltab_j->Type) {
2392 case MYIMAGE_REL_I386_DIR32:
2395 case MYIMAGE_REL_I386_REL32:
2396 /* Tricky. We have to insert a displacement at
2397 pP which, when added to the PC for the _next_
2398 insn, gives the address of the target (S).
2399 Problem is to know the address of the next insn
2400 when we only know pP. We assume that this
2401 literal field is always the last in the insn,
2402 so that the address of the next insn is pP+4
2403 -- hence the constant 4.
2404 Also I don't know if A should be added, but so
2405 far it has always been zero.
2407 SOF 05/2005: 'A' (old contents of *pP) have been observed
2408 to contain values other than zero (the 'wx' object file
2409 that came with wxhaskell-0.9.4; dunno how it was compiled..).
2410 So, add displacement to old value instead of asserting
2411 A to be zero. Fixes wxhaskell-related crashes, and no other
2412 ill effects have been observed.
2414 Update: the reason why we're seeing these more elaborate
2415 relocations is due to a switch in how the NCG compiles SRTs
2416 and offsets to them from info tables. SRTs live in .(ro)data,
2417 while info tables live in .text, causing GAS to emit REL32/DISP32
2418 relocations with non-zero values. Adding the displacement is
2419 the right thing to do.
2421 *pP = S - ((UInt32)pP) - 4 + A;
2424 debugBelch("%s: unhandled PEi386 relocation type %d",
2425 oc->fileName, reltab_j->Type);
2432 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
2436 #endif /* defined(OBJFORMAT_PEi386) */
2439 /* --------------------------------------------------------------------------
2441 * ------------------------------------------------------------------------*/
2443 #if defined(OBJFORMAT_ELF)
2448 #if defined(sparc_HOST_ARCH)
2449 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2450 #elif defined(i386_HOST_ARCH)
2451 # define ELF_TARGET_386 /* Used inside <elf.h> */
2452 #elif defined(x86_64_HOST_ARCH)
2453 # define ELF_TARGET_X64_64
2455 #elif defined (ia64_HOST_ARCH)
2456 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2458 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2459 # define ELF_NEED_GOT /* needs Global Offset Table */
2460 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2463 #if !defined(openbsd_HOST_OS)
2466 /* openbsd elf has things in different places, with diff names */
2467 #include <elf_abi.h>
2468 #include <machine/reloc.h>
2469 #define R_386_32 RELOC_32
2470 #define R_386_PC32 RELOC_PC32
2474 * Define a set of types which can be used for both ELF32 and ELF64
2478 #define ELFCLASS ELFCLASS64
2479 #define Elf_Addr Elf64_Addr
2480 #define Elf_Word Elf64_Word
2481 #define Elf_Sword Elf64_Sword
2482 #define Elf_Ehdr Elf64_Ehdr
2483 #define Elf_Phdr Elf64_Phdr
2484 #define Elf_Shdr Elf64_Shdr
2485 #define Elf_Sym Elf64_Sym
2486 #define Elf_Rel Elf64_Rel
2487 #define Elf_Rela Elf64_Rela
2488 #define ELF_ST_TYPE ELF64_ST_TYPE
2489 #define ELF_ST_BIND ELF64_ST_BIND
2490 #define ELF_R_TYPE ELF64_R_TYPE
2491 #define ELF_R_SYM ELF64_R_SYM
2493 #define ELFCLASS ELFCLASS32
2494 #define Elf_Addr Elf32_Addr
2495 #define Elf_Word Elf32_Word
2496 #define Elf_Sword Elf32_Sword
2497 #define Elf_Ehdr Elf32_Ehdr
2498 #define Elf_Phdr Elf32_Phdr
2499 #define Elf_Shdr Elf32_Shdr
2500 #define Elf_Sym Elf32_Sym
2501 #define Elf_Rel Elf32_Rel
2502 #define Elf_Rela Elf32_Rela
2504 #define ELF_ST_TYPE ELF32_ST_TYPE
2507 #define ELF_ST_BIND ELF32_ST_BIND
2510 #define ELF_R_TYPE ELF32_R_TYPE
2513 #define ELF_R_SYM ELF32_R_SYM
2519 * Functions to allocate entries in dynamic sections. Currently we simply
2520 * preallocate a large number, and we don't check if a entry for the given
2521 * target already exists (a linear search is too slow). Ideally these
2522 * entries would be associated with symbols.
2525 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2526 #define GOT_SIZE 0x20000
2527 #define FUNCTION_TABLE_SIZE 0x10000
2528 #define PLT_SIZE 0x08000
2531 static Elf_Addr got[GOT_SIZE];
2532 static unsigned int gotIndex;
2533 static Elf_Addr gp_val = (Elf_Addr)got;
2536 allocateGOTEntry(Elf_Addr target)
2540 if (gotIndex >= GOT_SIZE)
2541 barf("Global offset table overflow");
2543 entry = &got[gotIndex++];
2545 return (Elf_Addr)entry;
2549 #ifdef ELF_FUNCTION_DESC
2555 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2556 static unsigned int functionTableIndex;
2559 allocateFunctionDesc(Elf_Addr target)
2561 FunctionDesc *entry;
2563 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2564 barf("Function table overflow");
2566 entry = &functionTable[functionTableIndex++];
2568 entry->gp = (Elf_Addr)gp_val;
2569 return (Elf_Addr)entry;
2573 copyFunctionDesc(Elf_Addr target)
2575 FunctionDesc *olddesc = (FunctionDesc *)target;
2576 FunctionDesc *newdesc;
2578 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2579 newdesc->gp = olddesc->gp;
2580 return (Elf_Addr)newdesc;
2585 #ifdef ia64_HOST_ARCH
2586 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2587 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2589 static unsigned char plt_code[] =
2591 /* taken from binutils bfd/elfxx-ia64.c */
2592 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2593 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2594 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2595 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2596 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2597 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2600 /* If we can't get to the function descriptor via gp, take a local copy of it */
2601 #define PLT_RELOC(code, target) { \
2602 Elf64_Sxword rel_value = target - gp_val; \
2603 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2604 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2606 ia64_reloc_gprel22((Elf_Addr)code, target); \
2611 unsigned char code[sizeof(plt_code)];
2615 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2617 PLTEntry *plt = (PLTEntry *)oc->plt;
2620 if (oc->pltIndex >= PLT_SIZE)
2621 barf("Procedure table overflow");
2623 entry = &plt[oc->pltIndex++];
2624 memcpy(entry->code, plt_code, sizeof(entry->code));
2625 PLT_RELOC(entry->code, target);
2626 return (Elf_Addr)entry;
2632 return (PLT_SIZE * sizeof(PLTEntry));
2637 #if x86_64_HOST_ARCH
2638 // On x86_64, 32-bit relocations are often used, which requires that
2639 // we can resolve a symbol to a 32-bit offset. However, shared
2640 // libraries are placed outside the 2Gb area, which leaves us with a
2641 // problem when we need to give a 32-bit offset to a symbol in a
2644 // For a function symbol, we can allocate a bounce sequence inside the
2645 // 2Gb area and resolve the symbol to this. The bounce sequence is
2646 // simply a long jump instruction to the real location of the symbol.
2648 // For data references, we're screwed.
2651 unsigned char jmp[8]; /* 6 byte instruction: jmpq *0x00000002(%rip) */
2655 #define X86_64_BB_SIZE 1024
2657 static x86_64_bounce *x86_64_bounce_buffer = NULL;
2658 static nat x86_64_bb_next_off;
2661 x86_64_high_symbol( char *lbl, void *addr )
2663 x86_64_bounce *bounce;
2665 if ( x86_64_bounce_buffer == NULL ||
2666 x86_64_bb_next_off >= X86_64_BB_SIZE ) {
2667 x86_64_bounce_buffer =
2668 mmap(NULL, X86_64_BB_SIZE * sizeof(x86_64_bounce),
2669 PROT_EXEC|PROT_READ|PROT_WRITE,
2670 MAP_PRIVATE|MAP_32BIT|MAP_ANONYMOUS, -1, 0);
2671 if (x86_64_bounce_buffer == MAP_FAILED) {
2672 barf("x86_64_high_symbol: mmap failed");
2674 x86_64_bb_next_off = 0;
2676 bounce = &x86_64_bounce_buffer[x86_64_bb_next_off];
2677 bounce->jmp[0] = 0xff;
2678 bounce->jmp[1] = 0x25;
2679 bounce->jmp[2] = 0x02;
2680 bounce->jmp[3] = 0x00;
2681 bounce->jmp[4] = 0x00;
2682 bounce->jmp[5] = 0x00;
2683 bounce->addr = addr;
2684 x86_64_bb_next_off++;
2686 IF_DEBUG(linker, debugBelch("x86_64: allocated bounce entry for %s->%p at %p\n",
2687 lbl, addr, bounce));
2689 insertStrHashTable(symhash, lbl, bounce);
2696 * Generic ELF functions
2700 findElfSection ( void* objImage, Elf_Word sh_type )
2702 char* ehdrC = (char*)objImage;
2703 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2704 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2705 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2709 for (i = 0; i < ehdr->e_shnum; i++) {
2710 if (shdr[i].sh_type == sh_type
2711 /* Ignore the section header's string table. */
2712 && i != ehdr->e_shstrndx
2713 /* Ignore string tables named .stabstr, as they contain
2715 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2717 ptr = ehdrC + shdr[i].sh_offset;
2724 #if defined(ia64_HOST_ARCH)
2726 findElfSegment ( void* objImage, Elf_Addr vaddr )
2728 char* ehdrC = (char*)objImage;
2729 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2730 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2731 Elf_Addr segaddr = 0;
2734 for (i = 0; i < ehdr->e_phnum; i++) {
2735 segaddr = phdr[i].p_vaddr;
2736 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2744 ocVerifyImage_ELF ( ObjectCode* oc )
2748 int i, j, nent, nstrtab, nsymtabs;
2752 char* ehdrC = (char*)(oc->image);
2753 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2755 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2756 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2757 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2758 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2759 errorBelch("%s: not an ELF object", oc->fileName);
2763 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2764 errorBelch("%s: unsupported ELF format", oc->fileName);
2768 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2769 IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
2771 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2772 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
2774 errorBelch("%s: unknown endiannness", oc->fileName);
2778 if (ehdr->e_type != ET_REL) {
2779 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
2782 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
2784 IF_DEBUG(linker,debugBelch( "Architecture is " ));
2785 switch (ehdr->e_machine) {
2786 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
2787 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
2789 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
2791 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
2793 case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
2795 default: IF_DEBUG(linker,debugBelch( "unknown" ));
2796 errorBelch("%s: unknown architecture", oc->fileName);
2800 IF_DEBUG(linker,debugBelch(
2801 "\nSection header table: start %ld, n_entries %d, ent_size %d\n",
2802 (long)ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2804 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2806 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2808 if (ehdr->e_shstrndx == SHN_UNDEF) {
2809 errorBelch("%s: no section header string table", oc->fileName);
2812 IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
2814 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2817 for (i = 0; i < ehdr->e_shnum; i++) {
2818 IF_DEBUG(linker,debugBelch("%2d: ", i ));
2819 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
2820 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
2821 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
2822 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
2823 ehdrC + shdr[i].sh_offset,
2824 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2826 if (shdr[i].sh_type == SHT_REL) {
2827 IF_DEBUG(linker,debugBelch("Rel " ));
2828 } else if (shdr[i].sh_type == SHT_RELA) {
2829 IF_DEBUG(linker,debugBelch("RelA " ));
2831 IF_DEBUG(linker,debugBelch(" "));
2834 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
2838 IF_DEBUG(linker,debugBelch( "\nString tables" ));
2841 for (i = 0; i < ehdr->e_shnum; i++) {
2842 if (shdr[i].sh_type == SHT_STRTAB
2843 /* Ignore the section header's string table. */
2844 && i != ehdr->e_shstrndx
2845 /* Ignore string tables named .stabstr, as they contain
2847 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2849 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
2850 strtab = ehdrC + shdr[i].sh_offset;
2855 errorBelch("%s: no string tables, or too many", oc->fileName);
2860 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
2861 for (i = 0; i < ehdr->e_shnum; i++) {
2862 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2863 IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
2865 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2866 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2867 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%ld rem)\n",
2869 (long)shdr[i].sh_size % sizeof(Elf_Sym)
2871 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2872 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
2875 for (j = 0; j < nent; j++) {
2876 IF_DEBUG(linker,debugBelch(" %2d ", j ));
2877 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
2878 (int)stab[j].st_shndx,
2879 (int)stab[j].st_size,
2880 (char*)stab[j].st_value ));
2882 IF_DEBUG(linker,debugBelch("type=" ));
2883 switch (ELF_ST_TYPE(stab[j].st_info)) {
2884 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
2885 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
2886 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
2887 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
2888 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
2889 default: IF_DEBUG(linker,debugBelch("? " )); break;
2891 IF_DEBUG(linker,debugBelch(" " ));
2893 IF_DEBUG(linker,debugBelch("bind=" ));
2894 switch (ELF_ST_BIND(stab[j].st_info)) {
2895 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
2896 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
2897 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
2898 default: IF_DEBUG(linker,debugBelch("? " )); break;
2900 IF_DEBUG(linker,debugBelch(" " ));
2902 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
2906 if (nsymtabs == 0) {
2907 errorBelch("%s: didn't find any symbol tables", oc->fileName);
2914 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
2918 if (hdr->sh_type == SHT_PROGBITS
2919 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
2920 /* .text-style section */
2921 return SECTIONKIND_CODE_OR_RODATA;
2924 if (hdr->sh_type == SHT_PROGBITS
2925 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2926 /* .data-style section */
2927 return SECTIONKIND_RWDATA;
2930 if (hdr->sh_type == SHT_PROGBITS
2931 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
2932 /* .rodata-style section */
2933 return SECTIONKIND_CODE_OR_RODATA;
2936 if (hdr->sh_type == SHT_NOBITS
2937 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2938 /* .bss-style section */
2940 return SECTIONKIND_RWDATA;
2943 return SECTIONKIND_OTHER;
2948 ocGetNames_ELF ( ObjectCode* oc )
2953 char* ehdrC = (char*)(oc->image);
2954 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2955 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2956 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2958 ASSERT(symhash != NULL);
2961 errorBelch("%s: no strtab", oc->fileName);
2966 for (i = 0; i < ehdr->e_shnum; i++) {
2967 /* Figure out what kind of section it is. Logic derived from
2968 Figure 1.14 ("Special Sections") of the ELF document
2969 ("Portable Formats Specification, Version 1.1"). */
2971 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
2973 if (is_bss && shdr[i].sh_size > 0) {
2974 /* This is a non-empty .bss section. Allocate zeroed space for
2975 it, and set its .sh_offset field such that
2976 ehdrC + .sh_offset == addr_of_zeroed_space. */
2977 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2978 "ocGetNames_ELF(BSS)");
2979 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2981 debugBelch("BSS section at 0x%x, size %d\n",
2982 zspace, shdr[i].sh_size);
2986 /* fill in the section info */
2987 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2988 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2989 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2990 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2993 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2995 /* copy stuff into this module's object symbol table */
2996 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2997 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2999 oc->n_symbols = nent;
3000 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3001 "ocGetNames_ELF(oc->symbols)");
3003 for (j = 0; j < nent; j++) {
3005 char isLocal = FALSE; /* avoids uninit-var warning */
3007 char* nm = strtab + stab[j].st_name;
3008 int secno = stab[j].st_shndx;
3010 /* Figure out if we want to add it; if so, set ad to its
3011 address. Otherwise leave ad == NULL. */
3013 if (secno == SHN_COMMON) {
3015 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
3017 debugBelch("COMMON symbol, size %d name %s\n",
3018 stab[j].st_size, nm);
3020 /* Pointless to do addProddableBlock() for this area,
3021 since the linker should never poke around in it. */
3024 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
3025 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
3027 /* and not an undefined symbol */
3028 && stab[j].st_shndx != SHN_UNDEF
3029 /* and not in a "special section" */
3030 && stab[j].st_shndx < SHN_LORESERVE
3032 /* and it's a not a section or string table or anything silly */
3033 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
3034 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
3035 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
3038 /* Section 0 is the undefined section, hence > and not >=. */
3039 ASSERT(secno > 0 && secno < ehdr->e_shnum);
3041 if (shdr[secno].sh_type == SHT_NOBITS) {
3042 debugBelch(" BSS symbol, size %d off %d name %s\n",
3043 stab[j].st_size, stab[j].st_value, nm);
3046 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
3047 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
3050 #ifdef ELF_FUNCTION_DESC
3051 /* dlsym() and the initialisation table both give us function
3052 * descriptors, so to be consistent we store function descriptors
3053 * in the symbol table */
3054 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
3055 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
3057 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s",
3058 ad, oc->fileName, nm ));
3063 /* And the decision is ... */
3067 oc->symbols[j] = nm;
3070 /* Ignore entirely. */
3072 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
3076 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
3077 strtab + stab[j].st_name ));
3080 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
3081 (int)ELF_ST_BIND(stab[j].st_info),
3082 (int)ELF_ST_TYPE(stab[j].st_info),
3083 (int)stab[j].st_shndx,
3084 strtab + stab[j].st_name
3087 oc->symbols[j] = NULL;
3096 /* Do ELF relocations which lack an explicit addend. All x86-linux
3097 relocations appear to be of this form. */
3099 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
3100 Elf_Shdr* shdr, int shnum,
3101 Elf_Sym* stab, char* strtab )
3106 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
3107 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
3108 int target_shndx = shdr[shnum].sh_info;
3109 int symtab_shndx = shdr[shnum].sh_link;
3111 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3112 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
3113 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3114 target_shndx, symtab_shndx ));
3116 /* Skip sections that we're not interested in. */
3119 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
3120 if (kind == SECTIONKIND_OTHER) {
3121 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
3126 for (j = 0; j < nent; j++) {
3127 Elf_Addr offset = rtab[j].r_offset;
3128 Elf_Addr info = rtab[j].r_info;
3130 Elf_Addr P = ((Elf_Addr)targ) + offset;
3131 Elf_Word* pP = (Elf_Word*)P;
3137 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
3138 j, (void*)offset, (void*)info ));
3140 IF_DEBUG(linker,debugBelch( " ZERO" ));
3143 Elf_Sym sym = stab[ELF_R_SYM(info)];
3144 /* First see if it is a local symbol. */
3145 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3146 /* Yes, so we can get the address directly from the ELF symbol
3148 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3150 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3151 + stab[ELF_R_SYM(info)].st_value);
3154 /* No, so look up the name in our global table. */
3155 symbol = strtab + sym.st_name;
3156 S_tmp = lookupSymbol( symbol );
3157 S = (Elf_Addr)S_tmp;
3160 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3163 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
3166 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
3167 (void*)P, (void*)S, (void*)A ));
3168 checkProddableBlock ( oc, pP );
3172 switch (ELF_R_TYPE(info)) {
3173 # ifdef i386_HOST_ARCH
3174 case R_386_32: *pP = value; break;
3175 case R_386_PC32: *pP = value - P; break;
3178 errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n",
3179 oc->fileName, (lnat)ELF_R_TYPE(info));
3187 /* Do ELF relocations for which explicit addends are supplied.
3188 sparc-solaris relocations appear to be of this form. */
3190 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
3191 Elf_Shdr* shdr, int shnum,
3192 Elf_Sym* stab, char* strtab )
3195 char *symbol = NULL;
3197 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
3198 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
3199 int target_shndx = shdr[shnum].sh_info;
3200 int symtab_shndx = shdr[shnum].sh_link;
3202 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3203 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
3204 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3205 target_shndx, symtab_shndx ));
3207 for (j = 0; j < nent; j++) {
3208 #if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3209 /* This #ifdef only serves to avoid unused-var warnings. */
3210 Elf_Addr offset = rtab[j].r_offset;
3211 Elf_Addr P = targ + offset;
3213 Elf_Addr info = rtab[j].r_info;
3214 Elf_Addr A = rtab[j].r_addend;
3218 # if defined(sparc_HOST_ARCH)
3219 Elf_Word* pP = (Elf_Word*)P;
3221 # elif defined(ia64_HOST_ARCH)
3222 Elf64_Xword *pP = (Elf64_Xword *)P;
3224 # elif defined(powerpc_HOST_ARCH)
3228 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
3229 j, (void*)offset, (void*)info,
3232 IF_DEBUG(linker,debugBelch( " ZERO" ));
3235 Elf_Sym sym = stab[ELF_R_SYM(info)];
3236 /* First see if it is a local symbol. */
3237 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3238 /* Yes, so we can get the address directly from the ELF symbol
3240 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3242 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3243 + stab[ELF_R_SYM(info)].st_value);
3244 #ifdef ELF_FUNCTION_DESC
3245 /* Make a function descriptor for this function */
3246 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
3247 S = allocateFunctionDesc(S + A);
3252 /* No, so look up the name in our global table. */
3253 symbol = strtab + sym.st_name;
3254 S_tmp = lookupSymbol( symbol );
3255 S = (Elf_Addr)S_tmp;
3257 #ifdef ELF_FUNCTION_DESC
3258 /* If a function, already a function descriptor - we would
3259 have to copy it to add an offset. */
3260 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
3261 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
3265 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3268 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
3271 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
3272 (void*)P, (void*)S, (void*)A ));
3273 /* checkProddableBlock ( oc, (void*)P ); */
3277 switch (ELF_R_TYPE(info)) {
3278 # if defined(sparc_HOST_ARCH)
3279 case R_SPARC_WDISP30:
3280 w1 = *pP & 0xC0000000;
3281 w2 = (Elf_Word)((value - P) >> 2);
3282 ASSERT((w2 & 0xC0000000) == 0);
3287 w1 = *pP & 0xFFC00000;
3288 w2 = (Elf_Word)(value >> 10);
3289 ASSERT((w2 & 0xFFC00000) == 0);
3295 w2 = (Elf_Word)(value & 0x3FF);
3296 ASSERT((w2 & ~0x3FF) == 0);
3300 /* According to the Sun documentation:
3302 This relocation type resembles R_SPARC_32, except it refers to an
3303 unaligned word. That is, the word to be relocated must be treated
3304 as four separate bytes with arbitrary alignment, not as a word
3305 aligned according to the architecture requirements.
3307 (JRS: which means that freeloading on the R_SPARC_32 case
3308 is probably wrong, but hey ...)
3312 w2 = (Elf_Word)value;
3315 # elif defined(ia64_HOST_ARCH)
3316 case R_IA64_DIR64LSB:
3317 case R_IA64_FPTR64LSB:
3320 case R_IA64_PCREL64LSB:
3323 case R_IA64_SEGREL64LSB:
3324 addr = findElfSegment(ehdrC, value);
3327 case R_IA64_GPREL22:
3328 ia64_reloc_gprel22(P, value);
3330 case R_IA64_LTOFF22:
3331 case R_IA64_LTOFF22X:
3332 case R_IA64_LTOFF_FPTR22:
3333 addr = allocateGOTEntry(value);
3334 ia64_reloc_gprel22(P, addr);
3336 case R_IA64_PCREL21B:
3337 ia64_reloc_pcrel21(P, S, oc);
3340 /* This goes with R_IA64_LTOFF22X and points to the load to
3341 * convert into a move. We don't implement relaxation. */
3343 # elif defined(powerpc_HOST_ARCH)
3344 case R_PPC_ADDR16_LO:
3345 *(Elf32_Half*) P = value;
3348 case R_PPC_ADDR16_HI:
3349 *(Elf32_Half*) P = value >> 16;
3352 case R_PPC_ADDR16_HA:
3353 *(Elf32_Half*) P = (value + 0x8000) >> 16;
3357 *(Elf32_Word *) P = value;
3361 *(Elf32_Word *) P = value - P;
3367 if( delta << 6 >> 6 != delta )
3369 value = makeJumpIsland( oc, ELF_R_SYM(info), value );
3372 if( value == 0 || delta << 6 >> 6 != delta )
3374 barf( "Unable to make ppcJumpIsland for #%d",
3380 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3381 | (delta & 0x3fffffc);
3385 #if x86_64_HOST_ARCH
3387 *(Elf64_Xword *)P = value;
3392 StgInt64 off = value - P;
3393 if (off >= 0x7fffffffL || off < -0x80000000L) {
3394 barf("R_X86_64_PC32 relocation out of range: %s = %p",
3397 *(Elf64_Word *)P = (Elf64_Word)off;
3402 if (value >= 0x7fffffffL) {
3403 barf("R_X86_64_32 relocation out of range: %s = %p\n",
3406 *(Elf64_Word *)P = (Elf64_Word)value;
3410 if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
3411 barf("R_X86_64_32S relocation out of range: %s = %p\n",
3414 *(Elf64_Sword *)P = (Elf64_Sword)value;
3419 errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n",
3420 oc->fileName, (lnat)ELF_R_TYPE(info));
3429 ocResolve_ELF ( ObjectCode* oc )
3433 Elf_Sym* stab = NULL;
3434 char* ehdrC = (char*)(oc->image);
3435 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
3436 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3438 /* first find "the" symbol table */
3439 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
3441 /* also go find the string table */
3442 strtab = findElfSection ( ehdrC, SHT_STRTAB );
3444 if (stab == NULL || strtab == NULL) {
3445 errorBelch("%s: can't find string or symbol table", oc->fileName);
3449 /* Process the relocation sections. */
3450 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
3451 if (shdr[shnum].sh_type == SHT_REL) {
3452 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
3453 shnum, stab, strtab );
3457 if (shdr[shnum].sh_type == SHT_RELA) {
3458 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
3459 shnum, stab, strtab );
3464 /* Free the local symbol table; we won't need it again. */
3465 freeHashTable(oc->lochash, NULL);
3468 #if defined(powerpc_HOST_ARCH)
3469 ocFlushInstructionCache( oc );
3477 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
3478 * at the front. The following utility functions pack and unpack instructions, and
3479 * take care of the most common relocations.
3482 #ifdef ia64_HOST_ARCH
3485 ia64_extract_instruction(Elf64_Xword *target)
3488 int slot = (Elf_Addr)target & 3;
3489 target = (Elf_Addr)target & ~3;
3497 return ((w1 >> 5) & 0x1ffffffffff);
3499 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
3503 barf("ia64_extract_instruction: invalid slot %p", target);
3508 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
3510 int slot = (Elf_Addr)target & 3;
3511 target = (Elf_Addr)target & ~3;
3516 *target |= value << 5;
3519 *target |= value << 46;
3520 *(target+1) |= value >> 18;
3523 *(target+1) |= value << 23;
3529 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3531 Elf64_Xword instruction;
3532 Elf64_Sxword rel_value;
3534 rel_value = value - gp_val;
3535 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3536 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3538 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3539 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3540 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3541 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3542 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3543 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3547 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3549 Elf64_Xword instruction;
3550 Elf64_Sxword rel_value;
3553 entry = allocatePLTEntry(value, oc);
3555 rel_value = (entry >> 4) - (target >> 4);
3556 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3557 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3559 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3560 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3561 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3562 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3568 * PowerPC ELF specifics
3571 #ifdef powerpc_HOST_ARCH
3573 static int ocAllocateJumpIslands_ELF( ObjectCode *oc )
3579 ehdr = (Elf_Ehdr *) oc->image;
3580 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
3582 for( i = 0; i < ehdr->e_shnum; i++ )
3583 if( shdr[i].sh_type == SHT_SYMTAB )
3586 if( i == ehdr->e_shnum )
3588 errorBelch( "This ELF file contains no symtab" );
3592 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
3594 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
3595 shdr[i].sh_entsize, sizeof( Elf_Sym ) );
3600 return ocAllocateJumpIslands( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
3603 #endif /* powerpc */
3607 /* --------------------------------------------------------------------------
3609 * ------------------------------------------------------------------------*/
3611 #if defined(OBJFORMAT_MACHO)
3614 Support for MachO linking on Darwin/MacOS X
3615 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3617 I hereby formally apologize for the hackish nature of this code.
3618 Things that need to be done:
3619 *) implement ocVerifyImage_MachO
3620 *) add still more sanity checks.
3623 #ifdef powerpc_HOST_ARCH
3624 static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
3626 struct mach_header *header = (struct mach_header *) oc->image;
3627 struct load_command *lc = (struct load_command *) (header + 1);
3630 for( i = 0; i < header->ncmds; i++ )
3632 if( lc->cmd == LC_SYMTAB )
3634 // Find out the first and last undefined external
3635 // symbol, so we don't have to allocate too many
3637 struct symtab_command *symLC = (struct symtab_command *) lc;
3638 unsigned min = symLC->nsyms, max = 0;
3639 struct nlist *nlist =
3640 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
3642 for(i=0;i<symLC->nsyms;i++)
3644 if(nlist[i].n_type & N_STAB)
3646 else if(nlist[i].n_type & N_EXT)
3648 if((nlist[i].n_type & N_TYPE) == N_UNDF
3649 && (nlist[i].n_value == 0))
3659 return ocAllocateJumpIslands(oc, max - min + 1, min);
3664 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3666 return ocAllocateJumpIslands(oc,0,0);
3670 static int ocVerifyImage_MachO(ObjectCode* oc STG_UNUSED)
3672 // FIXME: do some verifying here
3676 static int resolveImports(
3679 struct symtab_command *symLC,
3680 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3681 unsigned long *indirectSyms,
3682 struct nlist *nlist)
3685 size_t itemSize = 4;
3688 int isJumpTable = 0;
3689 if(!strcmp(sect->sectname,"__jump_table"))
3693 ASSERT(sect->reserved2 == itemSize);
3697 for(i=0; i*itemSize < sect->size;i++)
3699 // according to otool, reserved1 contains the first index into the indirect symbol table
3700 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3701 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3704 if((symbol->n_type & N_TYPE) == N_UNDF
3705 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3706 addr = (void*) (symbol->n_value);
3707 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3710 addr = lookupSymbol(nm);
3713 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3721 checkProddableBlock(oc,image + sect->offset + i*itemSize);
3722 *(image + sect->offset + i*itemSize) = 0xe9; // jmp
3723 *(unsigned*)(image + sect->offset + i*itemSize + 1)
3724 = (char*)addr - (image + sect->offset + i*itemSize + 5);
3729 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3730 ((void**)(image + sect->offset))[i] = addr;
3737 static unsigned long relocateAddress(
3740 struct section* sections,
3741 unsigned long address)
3744 for(i = 0; i < nSections; i++)
3746 if(sections[i].addr <= address
3747 && address < sections[i].addr + sections[i].size)
3749 return (unsigned long)oc->image
3750 + sections[i].offset + address - sections[i].addr;
3753 barf("Invalid Mach-O file:"
3754 "Address out of bounds while relocating object file");
3758 static int relocateSection(
3761 struct symtab_command *symLC, struct nlist *nlist,
3762 int nSections, struct section* sections, struct section *sect)
3764 struct relocation_info *relocs;
3767 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3769 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3771 else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
3773 else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
3777 relocs = (struct relocation_info*) (image + sect->reloff);
3781 if(relocs[i].r_address & R_SCATTERED)
3783 struct scattered_relocation_info *scat =
3784 (struct scattered_relocation_info*) &relocs[i];
3788 if(scat->r_length == 2)
3790 unsigned long word = 0;
3791 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
3792 checkProddableBlock(oc,wordPtr);
3794 // Note on relocation types:
3795 // i386 uses the GENERIC_RELOC_* types,
3796 // while ppc uses special PPC_RELOC_* types.
3797 // *_RELOC_VANILLA and *_RELOC_PAIR have the same value
3798 // in both cases, all others are different.
3799 // Therefore, we use GENERIC_RELOC_VANILLA
3800 // and GENERIC_RELOC_PAIR instead of the PPC variants,
3801 // and use #ifdefs for the other types.
3803 // Step 1: Figure out what the relocated value should be
3804 if(scat->r_type == GENERIC_RELOC_VANILLA)
3806 word = *wordPtr + (unsigned long) relocateAddress(
3813 #ifdef powerpc_HOST_ARCH
3814 else if(scat->r_type == PPC_RELOC_SECTDIFF
3815 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
3816 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
3817 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3819 else if(scat->r_type == GENERIC_RELOC_SECTDIFF)
3822 struct scattered_relocation_info *pair =
3823 (struct scattered_relocation_info*) &relocs[i+1];
3825 if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR)
3826 barf("Invalid Mach-O file: "
3827 "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
3829 word = (unsigned long)
3830 (relocateAddress(oc, nSections, sections, scat->r_value)
3831 - relocateAddress(oc, nSections, sections, pair->r_value));
3834 #ifdef powerpc_HOST_ARCH
3835 else if(scat->r_type == PPC_RELOC_HI16
3836 || scat->r_type == PPC_RELOC_LO16
3837 || scat->r_type == PPC_RELOC_HA16
3838 || scat->r_type == PPC_RELOC_LO14)
3839 { // these are generated by label+offset things
3840 struct relocation_info *pair = &relocs[i+1];
3841 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
3842 barf("Invalid Mach-O file: "
3843 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
3845 if(scat->r_type == PPC_RELOC_LO16)
3847 word = ((unsigned short*) wordPtr)[1];
3848 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3850 else if(scat->r_type == PPC_RELOC_LO14)
3852 barf("Unsupported Relocation: PPC_RELOC_LO14");
3853 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
3854 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3856 else if(scat->r_type == PPC_RELOC_HI16)
3858 word = ((unsigned short*) wordPtr)[1] << 16;
3859 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3861 else if(scat->r_type == PPC_RELOC_HA16)
3863 word = ((unsigned short*) wordPtr)[1] << 16;
3864 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3868 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
3875 continue; // ignore the others
3877 #ifdef powerpc_HOST_ARCH
3878 if(scat->r_type == GENERIC_RELOC_VANILLA
3879 || scat->r_type == PPC_RELOC_SECTDIFF)
3881 if(scat->r_type == GENERIC_RELOC_VANILLA
3882 || scat->r_type == GENERIC_RELOC_SECTDIFF)
3887 #ifdef powerpc_HOST_ARCH
3888 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
3890 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3892 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
3894 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3896 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
3898 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3899 + ((word & (1<<15)) ? 1 : 0);
3905 continue; // FIXME: I hope it's OK to ignore all the others.
3909 struct relocation_info *reloc = &relocs[i];
3910 if(reloc->r_pcrel && !reloc->r_extern)
3913 if(reloc->r_length == 2)
3915 unsigned long word = 0;
3916 #ifdef powerpc_HOST_ARCH
3917 unsigned long jumpIsland = 0;
3918 long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
3919 // to avoid warning and to catch
3923 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3924 checkProddableBlock(oc,wordPtr);
3926 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3930 #ifdef powerpc_HOST_ARCH
3931 else if(reloc->r_type == PPC_RELOC_LO16)
3933 word = ((unsigned short*) wordPtr)[1];
3934 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3936 else if(reloc->r_type == PPC_RELOC_HI16)
3938 word = ((unsigned short*) wordPtr)[1] << 16;
3939 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3941 else if(reloc->r_type == PPC_RELOC_HA16)
3943 word = ((unsigned short*) wordPtr)[1] << 16;
3944 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3946 else if(reloc->r_type == PPC_RELOC_BR24)
3949 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
3953 if(!reloc->r_extern)
3956 sections[reloc->r_symbolnum-1].offset
3957 - sections[reloc->r_symbolnum-1].addr
3964 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3965 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3966 void *symbolAddress = lookupSymbol(nm);
3969 errorBelch("\nunknown symbol `%s'", nm);
3975 #ifdef powerpc_HOST_ARCH
3976 // In the .o file, this should be a relative jump to NULL
3977 // and we'll change it to a relative jump to the symbol
3978 ASSERT(-word == reloc->r_address);
3979 jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,(unsigned long) symbolAddress);
3982 offsetToJumpIsland = word + jumpIsland
3983 - (((long)image) + sect->offset - sect->addr);
3986 word += (unsigned long) symbolAddress
3987 - (((long)image) + sect->offset - sect->addr);
3991 word += (unsigned long) symbolAddress;
3995 if(reloc->r_type == GENERIC_RELOC_VANILLA)
4000 #ifdef powerpc_HOST_ARCH
4001 else if(reloc->r_type == PPC_RELOC_LO16)
4003 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4006 else if(reloc->r_type == PPC_RELOC_HI16)
4008 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4011 else if(reloc->r_type == PPC_RELOC_HA16)
4013 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4014 + ((word & (1<<15)) ? 1 : 0);
4017 else if(reloc->r_type == PPC_RELOC_BR24)
4019 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4021 // The branch offset is too large.
4022 // Therefore, we try to use a jump island.
4025 barf("unconditional relative branch out of range: "
4026 "no jump island available");
4029 word = offsetToJumpIsland;
4030 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4031 barf("unconditional relative branch out of range: "
4032 "jump island out of range");
4034 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
4039 barf("\nunknown relocation %d",reloc->r_type);
4046 static int ocGetNames_MachO(ObjectCode* oc)
4048 char *image = (char*) oc->image;
4049 struct mach_header *header = (struct mach_header*) image;
4050 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4051 unsigned i,curSymbol = 0;
4052 struct segment_command *segLC = NULL;
4053 struct section *sections;
4054 struct symtab_command *symLC = NULL;
4055 struct nlist *nlist;
4056 unsigned long commonSize = 0;
4057 char *commonStorage = NULL;
4058 unsigned long commonCounter;
4060 for(i=0;i<header->ncmds;i++)
4062 if(lc->cmd == LC_SEGMENT)
4063 segLC = (struct segment_command*) lc;
4064 else if(lc->cmd == LC_SYMTAB)
4065 symLC = (struct symtab_command*) lc;
4066 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4069 sections = (struct section*) (segLC+1);
4070 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4073 for(i=0;i<segLC->nsects;i++)
4075 if(sections[i].size == 0)
4078 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
4080 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
4081 "ocGetNames_MachO(common symbols)");
4082 sections[i].offset = zeroFillArea - image;
4085 if(!strcmp(sections[i].sectname,"__text"))
4086 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
4087 (void*) (image + sections[i].offset),
4088 (void*) (image + sections[i].offset + sections[i].size));
4089 else if(!strcmp(sections[i].sectname,"__const"))
4090 addSection(oc, SECTIONKIND_RWDATA,
4091 (void*) (image + sections[i].offset),
4092 (void*) (image + sections[i].offset + sections[i].size));
4093 else if(!strcmp(sections[i].sectname,"__data"))
4094 addSection(oc, SECTIONKIND_RWDATA,
4095 (void*) (image + sections[i].offset),
4096 (void*) (image + sections[i].offset + sections[i].size));
4097 else if(!strcmp(sections[i].sectname,"__bss")
4098 || !strcmp(sections[i].sectname,"__common"))
4099 addSection(oc, SECTIONKIND_RWDATA,
4100 (void*) (image + sections[i].offset),
4101 (void*) (image + sections[i].offset + sections[i].size));
4103 addProddableBlock(oc, (void*) (image + sections[i].offset),
4107 // count external symbols defined here
4111 for(i=0;i<symLC->nsyms;i++)
4113 if(nlist[i].n_type & N_STAB)
4115 else if(nlist[i].n_type & N_EXT)
4117 if((nlist[i].n_type & N_TYPE) == N_UNDF
4118 && (nlist[i].n_value != 0))
4120 commonSize += nlist[i].n_value;
4123 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4128 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
4129 "ocGetNames_MachO(oc->symbols)");
4133 for(i=0;i<symLC->nsyms;i++)
4135 if(nlist[i].n_type & N_STAB)
4137 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4139 if(nlist[i].n_type & N_EXT)
4141 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4142 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4144 + sections[nlist[i].n_sect-1].offset
4145 - sections[nlist[i].n_sect-1].addr
4146 + nlist[i].n_value);
4147 oc->symbols[curSymbol++] = nm;
4151 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4152 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm,
4154 + sections[nlist[i].n_sect-1].offset
4155 - sections[nlist[i].n_sect-1].addr
4156 + nlist[i].n_value);
4162 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
4163 commonCounter = (unsigned long)commonStorage;
4166 for(i=0;i<symLC->nsyms;i++)
4168 if((nlist[i].n_type & N_TYPE) == N_UNDF
4169 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
4171 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4172 unsigned long sz = nlist[i].n_value;
4174 nlist[i].n_value = commonCounter;
4176 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4177 (void*)commonCounter);
4178 oc->symbols[curSymbol++] = nm;
4180 commonCounter += sz;
4187 static int ocResolve_MachO(ObjectCode* oc)
4189 char *image = (char*) oc->image;
4190 struct mach_header *header = (struct mach_header*) image;
4191 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4193 struct segment_command *segLC = NULL;
4194 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL, *jump_table = NULL;
4195 struct symtab_command *symLC = NULL;
4196 struct dysymtab_command *dsymLC = NULL;
4197 struct nlist *nlist;
4199 for(i=0;i<header->ncmds;i++)
4201 if(lc->cmd == LC_SEGMENT)
4202 segLC = (struct segment_command*) lc;
4203 else if(lc->cmd == LC_SYMTAB)
4204 symLC = (struct symtab_command*) lc;
4205 else if(lc->cmd == LC_DYSYMTAB)
4206 dsymLC = (struct dysymtab_command*) lc;
4207 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4210 sections = (struct section*) (segLC+1);
4211 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4214 for(i=0;i<segLC->nsects;i++)
4216 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
4217 la_ptrs = §ions[i];
4218 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
4219 nl_ptrs = §ions[i];
4220 else if(!strcmp(sections[i].sectname,"__la_sym_ptr2"))
4221 la_ptrs = §ions[i];
4222 else if(!strcmp(sections[i].sectname,"__la_sym_ptr3"))
4223 la_ptrs = §ions[i];
4224 else if(!strcmp(sections[i].sectname,"__pointers"))
4225 nl_ptrs = §ions[i];
4226 else if(!strcmp(sections[i].sectname,"__jump_table"))
4227 jump_table = §ions[i];
4232 unsigned long *indirectSyms
4233 = (unsigned long*) (image + dsymLC->indirectsymoff);
4236 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
4239 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
4242 if(!resolveImports(oc,image,symLC,jump_table,indirectSyms,nlist))
4246 for(i=0;i<segLC->nsects;i++)
4248 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
4252 /* Free the local symbol table; we won't need it again. */
4253 freeHashTable(oc->lochash, NULL);
4256 #if defined (powerpc_HOST_ARCH)
4257 ocFlushInstructionCache( oc );
4263 #ifdef powerpc_HOST_ARCH
4265 * The Mach-O object format uses leading underscores. But not everywhere.
4266 * There is a small number of runtime support functions defined in
4267 * libcc_dynamic.a whose name does not have a leading underscore.
4268 * As a consequence, we can't get their address from C code.
4269 * We have to use inline assembler just to take the address of a function.
4273 static void machoInitSymbolsWithoutUnderscore()
4275 extern void* symbolsWithoutUnderscore[];
4276 void **p = symbolsWithoutUnderscore;
4277 __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
4281 __asm__ volatile(".long " # x);
4283 RTS_MACHO_NOUNDERLINE_SYMBOLS
4285 __asm__ volatile(".text");
4289 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
4291 RTS_MACHO_NOUNDERLINE_SYMBOLS
4298 * Figure out by how much to shift the entire Mach-O file in memory
4299 * when loading so that its single segment ends up 16-byte-aligned
4301 static int machoGetMisalignment( FILE * f )
4303 struct mach_header header;
4306 fread(&header, sizeof(header), 1, f);
4309 if(header.magic != MH_MAGIC)
4312 misalignment = (header.sizeofcmds + sizeof(header))
4315 return misalignment ? (16 - misalignment) : 0;